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