1package HTML::TagCloud; 2use strict; 3use warnings; 4our $VERSION = '0.38'; 5 6use constant EMPTY_STRING => q{}; 7 8sub new { 9 my $class = shift; 10 my $self = { 11 counts => {}, 12 urls => {}, 13 category_for => {}, 14 categories => [], 15 levels => 24, 16 distinguish_adjacent_tags => 0, 17 @_ 18 }; 19 bless $self, $class; 20 return $self; 21} 22 23sub add { 24 my ( $self, $tag, $url, $count, $category ) = @_; 25 $self->{counts}->{$tag} = $count; 26 $self->{urls}->{$tag} = $url; 27 if ( scalar @{ $self->{categories} } > 0 && defined $category ) { 28 $self->{category_for}->{$tag} = $category; 29 } 30} 31 32sub add_static { 33 my ( $self, $tag, $count, $category ) = @_; 34 $self->{counts}->{$tag} = $count; 35 36 if ( scalar @{ $self->{categories} } > 0 && defined $category ) { 37 $self->{category_for}->{$tag} = $category; 38 } 39} 40 41sub css { 42 my ($self) = @_; 43 my $css = q( 44#htmltagcloud { 45 text-align: center; 46 line-height: 1; 47} 48); 49 foreach my $level ( 0 .. $self->{levels} ) { 50 if ( $self->{distinguish_adjacent_tags} ) { 51 $css .= $self->_css_for_tag( $level, 'even' ); 52 $css .= $self->_css_for_tag( $level, 'odd' ); 53 } 54 else { 55 $css .= $self->_css_for_tag( $level, q{} ); 56 } 57 } 58 return $css; 59} 60 61sub _css_for_tag { 62 my ( $self, $level, $subclass ) = @_; 63 my $font = 12 + $level; 64 return <<"END_OF_TAG"; 65span.tagcloud${level}${subclass} {font-size: ${font}px;} 66span.tagcloud${level}${subclass} a {text-decoration: none;} 67END_OF_TAG 68} 69 70sub tags { 71 my ( $self, $limit ) = @_; 72 my $counts = $self->{counts}; 73 my $urls = $self->{urls}; 74 my $category_for = $self->{category_for}; 75 my @tags = sort { $counts->{$b} <=> $counts->{$a} || $a cmp $b } keys %$counts; 76 @tags = splice( @tags, 0, $limit ) if defined $limit; 77 78 return unless scalar @tags; 79 80 my $min = log( $counts->{ $tags[-1] } ); 81 my $max = log( $counts->{ $tags[0] } ); 82 my $factor; 83 84 # special case all tags having the same count 85 if ( $max - $min == 0 ) { 86 $min = $min - $self->{levels}; 87 $factor = 1; 88 } 89 else { 90 $factor = $self->{levels} / ( $max - $min ); 91 } 92 93 if ( scalar @tags < $self->{levels} ) { 94 $factor *= ( scalar @tags / $self->{levels} ); 95 } 96 my @tag_items; 97 foreach my $tag ( sort @tags ) { 98 my $tag_item; 99 $tag_item->{name} = $tag; 100 $tag_item->{count} = $counts->{$tag}; 101 $tag_item->{url} = $urls->{$tag}; 102 $tag_item->{level} 103 = int( ( log( $tag_item->{count} ) - $min ) * $factor ); 104 $tag_item->{category} = $category_for->{$tag}; 105 push @tag_items, $tag_item; 106 } 107 return @tag_items; 108} 109 110sub html { 111 my ( $self, $limit ) = @_; 112 my $html 113 = scalar @{ $self->{categories} } > 0 114 ? $self->html_with_categories($limit) 115 : $self->html_without_categories($limit); 116 return $html; 117} 118 119sub html_without_categories { 120 my ( $self, $limit ) = @_; 121 my $html = $self->_html_for( [ $self->tags($limit) ] ); 122} 123 124sub _html_for { 125 my ( $self, $tags_ref ) = @_; 126 my $ntags = scalar( @{$tags_ref} ); 127 return EMPTY_STRING if $ntags == 0; 128 129 # Format the HTML division. 130 my $html 131 = $ntags == 1 132 ? $self->_html_for_single_tag($tags_ref) 133 : $self->_html_for_multiple_tags($tags_ref); 134 135 return $html; 136} 137 138sub _html_for_single_tag { 139 my ( $self, $tags_ref ) = @_; 140 141 # Format the contents of the div. 142 my $tag_ref = $tags_ref->[0]; 143 my $html = $self->_format_span( @{$tag_ref}{qw(name url)}, 1, 1 ); 144 145 return qq{<div id="htmltagcloud">$html</div>\n}; 146} 147 148sub _html_for_multiple_tags { 149 my ( $self, $tags_ref ) = @_; 150 151 # Format the contents of the div. 152 my $html = EMPTY_STRING; 153 my $is_even = 1; 154 foreach my $tag ( @{$tags_ref} ) { 155 my $span 156 = $self->_format_span( @{$tag}{qw(name url level)}, $is_even ); 157 $html .= "$span\n"; 158 $is_even = !$is_even; 159 } 160 $html = qq{<div id="htmltagcloud"> 161$html</div>}; 162 return $html; 163} 164 165sub html_with_categories { 166 my ( $self, $limit ) = @_; 167 168 # Get the collection of tags, organized by category. 169 my $tags_by_category_ref = $self->_tags_by_category($limit); 170 return EMPTY_STRING if !defined $tags_by_category_ref; 171 172 # Format the HTML document. 173 my $html = EMPTY_STRING; 174 CATEGORY: 175 for my $category ( @{ $self->{categories} } ) { 176 my $tags_ref = $tags_by_category_ref->{$category}; 177 $html .= $self->_html_for_category( $category, $tags_ref ); 178 } 179 180 return $html; 181} 182 183sub _html_for_category { 184 my ( $self, $category, $tags_ref ) = @_; 185 186 # Format the HTML. 187 my $html 188 = qq{<div class='$category'>} 189 . $self->_html_for($tags_ref) 190 . qq{</div>}; 191 192 return $html; 193} 194 195sub _tags_by_category { 196 my ( $self, $limit ) = @_; 197 198 # Get the tags. 199 my @tags = $self->tags($limit); 200 return if scalar @tags == 0; 201 202 # Build the categorized collection of tags. 203 my %tags_by_category; 204 for my $tag_ref (@tags) { 205 my $category 206 = defined $tag_ref->{category} 207 ? $tag_ref->{category} 208 : '__unknown__'; 209 push @{ $tags_by_category{$category} }, $tag_ref; 210 } 211 212 return \%tags_by_category; 213} 214 215sub html_and_css { 216 my ( $self, $limit ) = @_; 217 my $html = qq{<style type="text/css">\n} . $self->css . "</style>"; 218 $html .= $self->html($limit); 219 return $html; 220} 221 222sub _format_span { 223 my ( $self, $name, $url, $level, $is_even ) = @_; 224 my $subclass = q{}; 225 if ( $self->{distinguish_adjacent_tags} ) { 226 $subclass = $is_even ? 'even' : 'odd'; 227 } 228 my $span_class = qq{tagcloud$level$subclass}; 229 my $span = qq{<span class="$span_class">}; 230 if ( defined $url ) { 231 $span .= qq{<a href="$url">}; 232 } 233 $span .= $name; 234 if ( defined $url ) { 235 $span .= qq{</a>}; 236 } 237 $span .= qq{</span>}; 238} 239 2401; 241 242__END__ 243 244=head1 NAME 245 246HTML::TagCloud - Generate An HTML Tag Cloud 247 248=head1 SYNOPSIS 249 250 # A cloud with tags that link to other web pages. 251 my $cloud = HTML::TagCloud->new; 252 $cloud->add($tag1, $url1, $count1); 253 $cloud->add($tag2, $url2, $count2); 254 $cloud->add($tag3, $url3, $count3); 255 my $html = $cloud->html_and_css(50); 256 257 # A cloud with tags that do not link to other web pages. 258 my $cloud = HTML::TagCloud->new; 259 $cloud->add_static($tag1, $count1); 260 $cloud->add_static($tag2, $count2); 261 $cloud->add_static($tag3, $count3); 262 my $html = $cloud->html_and_css(50); 263 264 # A cloud that is comprised of tags in multiple categories. 265 my $cloud = HTML::TagCloud->new; 266 $cloud->add($tag1, $url1, $count1, $category1); 267 $cloud->add($tag2, $url2, $count2, $category2); 268 $cloud->add($tag3, $url3, $count3, $category3); 269 my $html = $cloud->html_and_css(50); 270 271 # The same cloud without tags that link to other web pages. 272 my $cloud = HTML::TagCloud->new; 273 $cloud->add_static($tag1, $count1, $category1); 274 $cloud->add_static($tag2, $count2, $category2); 275 $cloud->add_static($tag3, $count3, $category3); 276 my $html = $cloud->html_and_css(50); 277 278 # Obtaining uncategorized HTML for a categorized tag cloud. 279 my $html = $cloud->html_without_categories(); 280 281 # Explicitly requesting categorized HTML. 282 my $html = $cloud->html_with_categories(); 283 284=head1 DESCRIPTION 285 286The L<HTML::TagCloud> module enables you to generate "tag clouds" in 287HTML. Tag clouds serve as a textual way to visualize terms and topics 288that are used most frequently. The tags are sorted alphabetically and a 289larger font is used to indicate more frequent term usage. 290 291Example sites with tag clouds: L<http://www.43things.com/>, 292L<http://www.astray.com/recipes/> and 293L<http://www.flickr.com/photos/tags/>. 294 295This module provides a simple interface to generating a CSS-based HTML 296tag cloud. You simply pass in a set of tags, their URL and their count. 297This module outputs stylesheet-based HTML. You may use the included CSS 298or use your own. 299 300=head1 CONSTRUCTOR 301 302=head2 new 303 304The constructor takes a few optional arguments: 305 306 my $cloud = HTML::TagCloud->new(levels=>10); 307 308if not provided, levels defaults to 24 309 310 my $cloud = HTML::TagCloud->new(distinguish_adjacent_tags=>1); 311 312If distinguish_adjacent_tags is true HTML::TagCloud will use different CSS 313classes for adjacent tags in order to be able to make it easier to 314distinguish adjacent multi-word tags. If not specified, this parameter 315defaults to a false value. 316 317 my $cloud = HTML::TagCloud->new(categories=>\@categories); 318 319If categories are provided then tags are grouped in separate divisions by 320category when the HTML fragment is generated. 321 322=head1 METHODS 323 324=head2 add 325 326This module adds a tag into the cloud. You pass in the tag name, its URL 327and its count: 328 329 $cloud->add($tag1, $url1, $count1); 330 $cloud->add($tag2, $url2, $count2); 331 $cloud->add($tag3, $url3, $count3); 332 333=head2 add_static 334 335This module adds a tag that does not link to another web page into the 336cloud. You pass in the tag name and its count: 337 338 $cloud->add_static($tag1, $count1); 339 $cloud->add_static($tag2, $count2); 340 341=head2 tags($limit) 342 343Returns a list of hashrefs representing each tag in the cloud, sorted by 344alphabet. Each tag has the following keys: name, count, url and level. 345 346=head2 css 347 348This returns the CSS that will format the HTML returned by the html() 349method with tags which have a high count as larger: 350 351 my $css = $cloud->css; 352 353=head2 html($limit) 354 355This returns the tag cloud as HTML without the embedded CSS (you should 356use both css() and html() or simply the html_and_css() method). If any 357categories were specified when items were being placed in the cloud then 358the tags will be organized into divisions by category name. If a limit 359is provided, only the top $limit tags are in the cloud, otherwise all the 360tags are in the cloud: 361 362 my $html = $cloud->html(200); 363 364=head2 html_with_categories($limit) 365 366This returns the tag cloud as HTML without the embedded CSS. The tags will 367be arranged into divisions by category. If a limit is provided, only the top 368$limit tags are in the cloud. Otherwise, all tags are in the cloud. 369 370=head2 html_without_categories($limit) 371 372This returns the tag cloud as HTML without the embedded CSS. The tags will 373not be grouped by category if this method is used to generate the HTML. 374 375=head2 html_and_css($limit) 376 377This returns the tag cloud as HTML with embedded CSS. If a limit is 378provided, only the top $limit tags are in the cloud, otherwise all the 379tags are in the cloud: 380 381 my $html_and_css = $cloud->html_and_css(50); 382 383=head1 AUTHOR 384 385Leon Brocard, C<< <acme@astray.com> >>. 386 387=head1 COPYRIGHT 388 389Copyright (C) 2005-6, Leon Brocard 390 391This module is free software; you can redistribute it or modify it 392under the same terms as Perl itself. 393