".
SUPPORT
The current repository for this project is maintained on GitHub:
https://github.com/dennisroberts71/HTML-TagCloud
Please feel free to report any problems in the issue tracker for this
repository.
COPYRIGHT
Copyright (C) 2005, Leon Brocard
This module is free software; you can redistribute it or modify it under
the same terms as Perl itself.
HTML-TagCloud-0.38/lib 000755 000765 000024 0 12134420755 14225 5 ustar 00dennis staff 000000 000000 HTML-TagCloud-0.38/lib/HTML 000755 000765 000024 0 12134420755 14771 5 ustar 00dennis staff 000000 000000 HTML-TagCloud-0.38/lib/HTML/TagCloud.pm 000444 000765 000024 25216 12134420755 17214 0 ustar 00dennis staff 000000 000000 package HTML::TagCloud;
use strict;
use warnings;
our $VERSION = '0.38';
use constant EMPTY_STRING => q{};
sub new {
my $class = shift;
my $self = {
counts => {},
urls => {},
category_for => {},
categories => [],
levels => 24,
distinguish_adjacent_tags => 0,
@_
};
bless $self, $class;
return $self;
}
sub add {
my ( $self, $tag, $url, $count, $category ) = @_;
$self->{counts}->{$tag} = $count;
$self->{urls}->{$tag} = $url;
if ( scalar @{ $self->{categories} } > 0 && defined $category ) {
$self->{category_for}->{$tag} = $category;
}
}
sub add_static {
my ( $self, $tag, $count, $category ) = @_;
$self->{counts}->{$tag} = $count;
if ( scalar @{ $self->{categories} } > 0 && defined $category ) {
$self->{category_for}->{$tag} = $category;
}
}
sub css {
my ($self) = @_;
my $css = q(
#htmltagcloud {
text-align: center;
line-height: 1;
}
);
foreach my $level ( 0 .. $self->{levels} ) {
if ( $self->{distinguish_adjacent_tags} ) {
$css .= $self->_css_for_tag( $level, 'even' );
$css .= $self->_css_for_tag( $level, 'odd' );
}
else {
$css .= $self->_css_for_tag( $level, q{} );
}
}
return $css;
}
sub _css_for_tag {
my ( $self, $level, $subclass ) = @_;
my $font = 12 + $level;
return <<"END_OF_TAG";
span.tagcloud${level}${subclass} {font-size: ${font}px;}
span.tagcloud${level}${subclass} a {text-decoration: none;}
END_OF_TAG
}
sub tags {
my ( $self, $limit ) = @_;
my $counts = $self->{counts};
my $urls = $self->{urls};
my $category_for = $self->{category_for};
my @tags = sort { $counts->{$b} <=> $counts->{$a} || $a cmp $b } keys %$counts;
@tags = splice( @tags, 0, $limit ) if defined $limit;
return unless scalar @tags;
my $min = log( $counts->{ $tags[-1] } );
my $max = log( $counts->{ $tags[0] } );
my $factor;
# special case all tags having the same count
if ( $max - $min == 0 ) {
$min = $min - $self->{levels};
$factor = 1;
}
else {
$factor = $self->{levels} / ( $max - $min );
}
if ( scalar @tags < $self->{levels} ) {
$factor *= ( scalar @tags / $self->{levels} );
}
my @tag_items;
foreach my $tag ( sort @tags ) {
my $tag_item;
$tag_item->{name} = $tag;
$tag_item->{count} = $counts->{$tag};
$tag_item->{url} = $urls->{$tag};
$tag_item->{level}
= int( ( log( $tag_item->{count} ) - $min ) * $factor );
$tag_item->{category} = $category_for->{$tag};
push @tag_items, $tag_item;
}
return @tag_items;
}
sub html {
my ( $self, $limit ) = @_;
my $html
= scalar @{ $self->{categories} } > 0
? $self->html_with_categories($limit)
: $self->html_without_categories($limit);
return $html;
}
sub html_without_categories {
my ( $self, $limit ) = @_;
my $html = $self->_html_for( [ $self->tags($limit) ] );
}
sub _html_for {
my ( $self, $tags_ref ) = @_;
my $ntags = scalar( @{$tags_ref} );
return EMPTY_STRING if $ntags == 0;
# Format the HTML division.
my $html
= $ntags == 1
? $self->_html_for_single_tag($tags_ref)
: $self->_html_for_multiple_tags($tags_ref);
return $html;
}
sub _html_for_single_tag {
my ( $self, $tags_ref ) = @_;
# Format the contents of the div.
my $tag_ref = $tags_ref->[0];
my $html = $self->_format_span( @{$tag_ref}{qw(name url)}, 1, 1 );
return qq{$html
\n};
}
sub _html_for_multiple_tags {
my ( $self, $tags_ref ) = @_;
# Format the contents of the div.
my $html = EMPTY_STRING;
my $is_even = 1;
foreach my $tag ( @{$tags_ref} ) {
my $span
= $self->_format_span( @{$tag}{qw(name url level)}, $is_even );
$html .= "$span\n";
$is_even = !$is_even;
}
$html = qq{
$html
};
return $html;
}
sub html_with_categories {
my ( $self, $limit ) = @_;
# Get the collection of tags, organized by category.
my $tags_by_category_ref = $self->_tags_by_category($limit);
return EMPTY_STRING if !defined $tags_by_category_ref;
# Format the HTML document.
my $html = EMPTY_STRING;
CATEGORY:
for my $category ( @{ $self->{categories} } ) {
my $tags_ref = $tags_by_category_ref->{$category};
$html .= $self->_html_for_category( $category, $tags_ref );
}
return $html;
}
sub _html_for_category {
my ( $self, $category, $tags_ref ) = @_;
# Format the HTML.
my $html
= qq{}
. $self->_html_for($tags_ref)
. qq{
};
return $html;
}
sub _tags_by_category {
my ( $self, $limit ) = @_;
# Get the tags.
my @tags = $self->tags($limit);
return if scalar @tags == 0;
# Build the categorized collection of tags.
my %tags_by_category;
for my $tag_ref (@tags) {
my $category
= defined $tag_ref->{category}
? $tag_ref->{category}
: '__unknown__';
push @{ $tags_by_category{$category} }, $tag_ref;
}
return \%tags_by_category;
}
sub html_and_css {
my ( $self, $limit ) = @_;
my $html = qq{";
$html .= $self->html($limit);
return $html;
}
sub _format_span {
my ( $self, $name, $url, $level, $is_even ) = @_;
my $subclass = q{};
if ( $self->{distinguish_adjacent_tags} ) {
$subclass = $is_even ? 'even' : 'odd';
}
my $span_class = qq{tagcloud$level$subclass};
my $span = qq{};
if ( defined $url ) {
$span .= qq{};
}
$span .= $name;
if ( defined $url ) {
$span .= qq{};
}
$span .= qq{};
}
1;
__END__
=head1 NAME
HTML::TagCloud - Generate An HTML Tag Cloud
=head1 SYNOPSIS
# A cloud with tags that link to other web pages.
my $cloud = HTML::TagCloud->new;
$cloud->add($tag1, $url1, $count1);
$cloud->add($tag2, $url2, $count2);
$cloud->add($tag3, $url3, $count3);
my $html = $cloud->html_and_css(50);
# A cloud with tags that do not link to other web pages.
my $cloud = HTML::TagCloud->new;
$cloud->add_static($tag1, $count1);
$cloud->add_static($tag2, $count2);
$cloud->add_static($tag3, $count3);
my $html = $cloud->html_and_css(50);
# A cloud that is comprised of tags in multiple categories.
my $cloud = HTML::TagCloud->new;
$cloud->add($tag1, $url1, $count1, $category1);
$cloud->add($tag2, $url2, $count2, $category2);
$cloud->add($tag3, $url3, $count3, $category3);
my $html = $cloud->html_and_css(50);
# The same cloud without tags that link to other web pages.
my $cloud = HTML::TagCloud->new;
$cloud->add_static($tag1, $count1, $category1);
$cloud->add_static($tag2, $count2, $category2);
$cloud->add_static($tag3, $count3, $category3);
my $html = $cloud->html_and_css(50);
# Obtaining uncategorized HTML for a categorized tag cloud.
my $html = $cloud->html_without_categories();
# Explicitly requesting categorized HTML.
my $html = $cloud->html_with_categories();
=head1 DESCRIPTION
The L module enables you to generate "tag clouds" in
HTML. Tag clouds serve as a textual way to visualize terms and topics
that are used most frequently. The tags are sorted alphabetically and a
larger font is used to indicate more frequent term usage.
Example sites with tag clouds: L,
L and
L.
This module provides a simple interface to generating a CSS-based HTML
tag cloud. You simply pass in a set of tags, their URL and their count.
This module outputs stylesheet-based HTML. You may use the included CSS
or use your own.
=head1 CONSTRUCTOR
=head2 new
The constructor takes a few optional arguments:
my $cloud = HTML::TagCloud->new(levels=>10);
if not provided, levels defaults to 24
my $cloud = HTML::TagCloud->new(distinguish_adjacent_tags=>1);
If distinguish_adjacent_tags is true HTML::TagCloud will use different CSS
classes for adjacent tags in order to be able to make it easier to
distinguish adjacent multi-word tags. If not specified, this parameter
defaults to a false value.
my $cloud = HTML::TagCloud->new(categories=>\@categories);
If categories are provided then tags are grouped in separate divisions by
category when the HTML fragment is generated.
=head1 METHODS
=head2 add
This module adds a tag into the cloud. You pass in the tag name, its URL
and its count:
$cloud->add($tag1, $url1, $count1);
$cloud->add($tag2, $url2, $count2);
$cloud->add($tag3, $url3, $count3);
=head2 add_static
This module adds a tag that does not link to another web page into the
cloud. You pass in the tag name and its count:
$cloud->add_static($tag1, $count1);
$cloud->add_static($tag2, $count2);
=head2 tags($limit)
Returns a list of hashrefs representing each tag in the cloud, sorted by
alphabet. Each tag has the following keys: name, count, url and level.
=head2 css
This returns the CSS that will format the HTML returned by the html()
method with tags which have a high count as larger:
my $css = $cloud->css;
=head2 html($limit)
This returns the tag cloud as HTML without the embedded CSS (you should
use both css() and html() or simply the html_and_css() method). If any
categories were specified when items were being placed in the cloud then
the tags will be organized into divisions by category name. If a limit
is provided, only the top $limit tags are in the cloud, otherwise all the
tags are in the cloud:
my $html = $cloud->html(200);
=head2 html_with_categories($limit)
This returns the tag cloud as HTML without the embedded CSS. The tags will
be arranged into divisions by category. If a limit is provided, only the top
$limit tags are in the cloud. Otherwise, all tags are in the cloud.
=head2 html_without_categories($limit)
This returns the tag cloud as HTML without the embedded CSS. The tags will
not be grouped by category if this method is used to generate the HTML.
=head2 html_and_css($limit)
This returns the tag cloud as HTML with embedded CSS. If a limit is
provided, only the top $limit tags are in the cloud, otherwise all the
tags are in the cloud:
my $html_and_css = $cloud->html_and_css(50);
=head1 AUTHOR
Leon Brocard, C<< >>.
=head1 COPYRIGHT
Copyright (C) 2005-6, Leon Brocard
This module is free software; you can redistribute it or modify it
under the same terms as Perl itself.
HTML-TagCloud-0.38/t 000755 000765 000024 0 12134420755 13722 5 ustar 00dennis staff 000000 000000 HTML-TagCloud-0.38/t/pod.t 000444 000765 000024 220 12134420755 15000 0 ustar 00dennis staff 000000 000000 #!perl -T
use Test::More;
eval "use Test::Pod 1.14";
plan skip_all => "Test::Pod 1.14 required for testing POD: $@" if $@;
all_pod_files_ok();
HTML-TagCloud-0.38/t/pod_coverage.t 000444 000765 000024 254 12134420755 16662 0 ustar 00dennis staff 000000 000000 #!perl -T
use Test::More;
eval "use Test::Pod::Coverage 1.04";
plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
all_pod_coverage_ok();
HTML-TagCloud-0.38/t/simple.t 000444 000765 000024 37574 12134420755 15575 0 ustar 00dennis staff 000000 000000 #!perl
use strict;
use Test::More tests => 20;
use_ok('HTML::TagCloud');
my $cloud = HTML::TagCloud->new;
isa_ok($cloud, 'HTML::TagCloud');
my $tags = tags();
foreach my $tag (keys %$tags) {
my $count = $tags->{$tag};
my $url = "/show/$tag";
$cloud->add($tag, $url, $count);
}
my $css = $cloud->css;
is(lines($css), 55);
my $html = $cloud->html(0);
is($html, "");
$html = $cloud->html(1);
is($html, q{
});
$html = $cloud->html(2);
is($html, q{});
$html = $cloud->html(5);
is(lines($html), 7);
is($html, q{});
$html = $cloud->html_and_css(5);
is(lines($html), 63);
$html = $cloud->html(20);
is(lines($html), 22);
$html = $cloud->html;
is(lines($html), 351);
$cloud = HTML::TagCloud->new;
$cloud->add("a", "a.html", 10);
$cloud->add("b", "b.html", 10);
$cloud->add("c", "c.html", 10);
$html = $cloud->html();
is($html, q{});
$cloud = HTML::TagCloud->new( distinguish_adjacent_tags => 1 );
$cloud->add("a", "a.html", 10);
$cloud->add("b", "b.html", 10);
$cloud->add("c", "c.html", 10);
$css = $cloud->css;
is(lines($css), 105);
$html = $cloud->html();
is($html, q{});
$cloud = HTML::TagCloud->new;
$cloud->add_static("a", 10);
$html = $cloud->html();
is ($html, q{a
});
$cloud = HTML::TagCloud->new( distinguish_adjacent_tags => 1 );
$cloud->add_static("a", 10);
$html = $cloud->html();
is ($html, q{a
});
$cloud = HTML::TagCloud->new;
$cloud->add_static("a", 10);
$cloud->add_static("b", 10);
$cloud->add_static("c", 10);
$html = $cloud->html();
is($html, q{
a
b
c
});
$cloud = HTML::TagCloud->new( distinguish_adjacent_tags => 1 );
$cloud->add_static("a", 10);
$cloud->add_static("b", 10);
$cloud->add_static("c", 10);
$html = $cloud->html();
is($html, q{
a
b
c
});
$cloud = HTML::TagCloud->new;
$cloud->add("a", "a.html", 10);
$cloud->add_static("b", 10);
$cloud->add("c", "c.html", 10);
$html = $cloud->html();
is($html, q{});
$cloud = HTML::TagCloud->new( distinguish_adjacent_tags => 1 );
$cloud->add("a", "a.html", 10);
$cloud->add_static("b", 10);
$cloud->add("c", "c.html", 10);
$html = $cloud->html();
is($html, q{});
sub tags {
return {
'laptop' => 11,
'diane' => 10,
'grand central station' => 2,
'fog' => 4,
'amsterdam' => 10,
'floor' => 1,
'mai kai' => 3,
'glow stick' => 2,
'london' => 197,
'albert hall' => 4,
'night' => 17,
'victoria peak tram' => 3,
'squirrel' => 6,
'teddy bear' => 3,
'orange' => 30,
'hyde park' => 4,
'fort' => 165,
'ray' => 8,
'light' => 23,
'disney world' => 10,
'tanja orme' => 51,
'pool table' => 4,
'wedding dress' => 7,
'frasier' => 2,
'village' => 6,
'alex' => 11,
'soup' => 1,
'tom insam' => 2,
'dock' => 2,
'church' => 4,
'natural history museum' => 4,
'lucy' => 1,
'dimsum' => 2,
'sea horse' => 2,
'ice skating' => 1,
'lauderdale' => 165,
'andrews' => 53,
'tate' => 13,
'lan tau' => 16,
'dummy' => 3,
'clotilde lafont' => 2,
'waffle' => 1,
'harbour' => 23,
'micra' => 2,
'fondue' => 1,
'cecile lafont' => 1,
'kitten' => 4,
'na' => 34,
'river thames' => 15,
'rain' => 2,
'mustang' => 2,
'chair' => 1,
'verbier' => 139,
'nick' => 5,
'plate' => 1,
'tank' => 5,
'cable car' => 4,
'chinese' => 1,
'red rose' => 2,
'red' => 18,
'kathy' => 1,
'hualien' => 9,
'salt' => 1,
'elephant' => 1,
'jessica sergeant' => 2,
'swimming pool' => 20,
'pond' => 1,
'malin bergman' => 2,
'palm tree' => 9,
'moon' => 8,
'agathe lafont' => 3,
'chelsea' => 21,
'fotango' => 31,
'escalator' => 3,
'ron' => 1,
'tea cup' => 1,
'james duncan' => 6,
'pyramid' => 5,
'whiteg' => 3,
'sky' => 51,
'goose' => 7,
'louvre' => 6,
'car' => 5,
'candle' => 3,
'water' => 4,
'bridge' => 11,
'goddaughter' => 11,
'fisherman' => 3,
'clock' => 1,
'eye' => 48,
'bamboo' => 4,
'moorhen' => 2,
'stairs' => 3,
'wedding cake' => 5,
'swan' => 21,
'melissa' => 4,
'mitre' => 1,
'tree' => 89,
'miyagawa' => 2,
'zendo' => 2,
'erena' => 35,
'polo' => 29,
'poker' => 1,
'piano sheet' => 2,
'waterloo' => 4,
'sign' => 25,
'eggs' => 3,
'arm' => 1,
'stars' => 10,
'corridor' => 1,
'jesse' => 3,
'donnie' => 7,
'shrimp' => 4,
'terry' => 2,
'kennedy space center' => 7,
'black' => 1,
'crow' => 2,
'eurostar' => 4,
'anton' => 1,
'bottle' => 3,
'wood' => 1,
'autrijus' => 4,
'sleeping bag' => 6,
'jenny mather' => 2,
'cheese' => 2,
'blurry' => 11,
'sunset' => 46,
'lobster' => 1,
'birthday' => 4,
'smoke' => 1,
'wedding' => 35,
'jamie freeman' => 2,
'limousine' => 2,
'pottery' => 3,
'fish' => 21,
'red carpet' => 2,
'arthur bergman' => 7,
'bubbles' => 1,
'eiffel tower' => 10,
'kerry lapworth' => 2,
'mud' => 2,
'pete berlin' => 3,
'penguin' => 5,
'simon wistow' => 2,
'new' => 23,
'flower' => 58,
'balloon' => 1,
'drink' => 21,
'sand' => 6,
'centre pompidou' => 2,
'john' => 2,
'jane' => 9,
'show' => 21,
'helmet' => 1,
'restaurant' => 2,
'ring' => 1,
'stag' => 32,
'greg' => 3,
'york' => 23,
'thorpe park' => 15,
'bike' => 1,
'pauline brocard' => 106,
'shoes' => 3,
'cute' => 1,
'canal' => 1,
'wheel' => 1,
'modern' => 13,
'hot spring' => 2,
'band' => 1,
'ingy' => 7,
'bungalow' => 14,
'gun' => 1,
'oxygen' => 1,
'gold' => 1,
'rollercoaster' => 13,
'maude lafont' => 1,
'gary' => 5,
'charlie' => 2,
'portuguese man of war' => 1,
'mountain' => 33,
'elf' => 1,
'mark fowler' => 11,
'tram' => 1,
'skiing' => 31,
'plane' => 4,
'menu' => 3,
'scuba' => 18,
'albert memorial' => 11,
'big buddha' => 16,
'van' => 1,
'george' => 1,
'ripples' => 4,
'spider' => 1,
'rose' => 4,
'river' => 11,
'rocking chair' => 1,
'mtr' => 3,
'lighthouse' => 6,
'foot' => 1,
'chris robertson' => 2,
'round pond' => 21,
'queen' => 9,
'hot pot' => 1,
'pen' => 1,
'chick' => 5,
'garlic' => 4,
'greg jameson' => 18,
'sun' => 20,
'door' => 1,
'james lewis' => 4,
'portugal' => 9,
'crab' => 5,
'box' => 1,
'helicopter' => 2,
'parliament' => 8,
'purple' => 11,
'bath' => 35,
'scott' => 2,
'pub' => 8,
'yapc' => 57,
'pole' => 1,
'painter' => 2,
'perl' => 1,
'food' => 13,
'dog' => 4,
'carp' => 3,
'splash' => 2,
'hcchien' => 2,
'taiwan' => 92,
'flag' => 1,
'horse' => 2,
'fowler' => 35,
'manatee' => 1,
'weir' => 2,
'firework' => 8,
'alligator' => 10,
'st john' => 13,
'sunrise' => 1,
'clkao' => 3,
'chicken' => 6,
'head' => 1,
'hilary' => 2,
'trampoline' => 8,
'shane' => 7,
'picnic' => 3,
'aquarium' => 28,
'sushi' => 20,
'pam' => 7,
'building' => 14,
'clouds' => 6,
'pink' => 18,
'bus' => 4,
'oliver' => 2,
'tom' => 1,
'fire' => 15,
'boat' => 41,
'clown fish' => 4,
'killer whale' => 8,
'danielle' => 4,
'paul mison' => 1,
'bbq' => 3,
'cash' => 1,
'bluebells' => 5,
'richard clamp' => 1,
'turtle' => 7,
'paul' => 4,
'chips' => 1,
'lizard' => 8,
'leon brocard' => 70,
'table' => 4,
'victoria peak' => 10,
'bird' => 6,
'green' => 5,
'mark' => 36,
'baobab tree' => 12,
'ball' => 3,
'statue' => 11,
'yellow' => 13,
'francois brocard' => 32,
'grass' => 19,
'leo lapworth' => 2,
'farm' => 53,
'madagascar' => 224,
'lake' => 14,
'hot chocolate' => 2,
'wine' => 6,
'train' => 7,
'andrea hummer' => 8,
'catherine' => 2,
'tanja' => 248,
'star ferry' => 5,
'hong' => 79,
'beach' => 88,
'notre dame' => 3,
'books' => 1,
'underground' => 1,
'reflection' => 36,
'pony' => 5,
'steve' => 6,
'pool' => 1,
'jason' => 4,
'hair' => 1,
'house' => 7,
'karen' => 2,
'sea' => 123,
'noodles' => 1,
'rainbow' => 4,
'florida' => 282,
'fountain' => 4,
'croissant' => 1,
'fresnel lens' => 3,
'glass' => 2,
'bahamas' => 55,
'bed' => 3,
'post box' => 3,
'island' => 13,
'agi' => 1,
'roast suckling pig' => 7,
'windsor' => 10,
'kiss' => 1,
'rock' => 8,
'paris' => 70,
'erena fowler' => 8,
'shadow' => 13,
'ceiling' => 1,
'kong' => 79,
'duck' => 10,
'sam' => 11,
'port' => 1,
'river seine' => 12,
'class' => 1,
'croquet' => 3,
'katrien janin' => 6,
'roof' => 1,
'billingsgate' => 6,
'blue' => 29,
'cake' => 4,
'psp' => 2,
'grandmother' => 2,
'alex monney' => 4,
'kensington gardens' => 85,
'hammock' => 14,
'snow' => 84,
'taipei' => 36,
'mike robertson' => 1,
'book' => 1,
'martine brocard' => 38,
'road' => 3,
'ribbon' => 1
};
}
sub lines {
my $text = shift;
my @lines = split "\n", $text;
return scalar(@lines);
}