Skip Menu |
 

This queue is for tickets about the HTML-TagCloud CPAN distribution.

Report information
The Basics
Id: 49549
Status: open
Priority: 0/
Queue: HTML-TagCloud

People
Owner: Nobody in particular
Requestors: dland [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: Normal
Broken in: (no value)
Fixed in: 0.34



Subject: Patch to add a callback in order to generate custom <a> attributes
Download (untitled) / with headers
text/plain 605b
Hello Léon, I love this module, but I wanted to add a title attribute to each <a> element, so that a nice little popup would appear when you hover the mouse over a link. The following patch does just that. The diff for TagCloud.pm is against 0.34. The diff for t/simple.t is against 0.32. Sorry, I didn't have the latest source around, this is what was lying in my CPAN build dir. But it should be pretty simple to apply, it's just a single slab. A word of warning: I transferred this from a Unix box to a Windows box in order to upload the diffs, so they may have crappy line-endings. Enjoy! David
Subject: simple.t.diff
Download simple.t.diff
text/x-diff 1.3k
--- t/simple.t Mon Aug 22 17:34:31 2005 +++ /home/david/perl/devel/t/simple.t Wed Sep 9 12:56:25 2009 @@ -1,6 +1,6 @@ #!perl use strict; -use Test::More tests => 12; +use Test::More tests => 13; use_ok('HTML::TagCloud'); my $cloud = HTML::TagCloud->new; @@ -59,6 +59,32 @@ <span class="tagcloud3"><a href="b.html">b</a></span> <span class="tagcloud3"><a href="c.html">c</a></span> </div>}); + +my %tag2 = ( + foo => {n => 2, url => 'urlfoo'}, + bar => {n => 5, url => 'urlbar'}, + rat => {n => 7, url => 'urlrat'}, + one => {n => 1, url => 'urlonce'}, +); +$cloud = HTML::TagCloud->new( + levels => 4, + anchor_callback => sub { + my $t = shift; + my $count = $tag2{$t->{name}}{n}; + my $usage = $count == 1 ? 'used once' : "used $count times"; + return qq{<a href="$t->{url}" title="$usage">$t->{name}</a>}; + }, +); +for my $t (keys %tag2) { + $cloud->add( $t, $tag2{$t}{url}, $tag2{$t}{n} ); +} +$html = $cloud->html; +is($html, q{<div id="htmltagcloud"> +<span class="tagcloud3"><a href="urlbar" title="used 5 times">bar</a></span> +<span class="tagcloud1"><a href="urlfoo" title="used 2 times">foo</a></span> +<span class="tagcloud0"><a href="urlonce" title="used once">one</a></span> +<span class="tagcloud4"><a href="urlrat" title="used 7 times">rat</a></span> +</div>}, 'with anchor_callback'); sub tags { return {
Subject: TagCloud.pm.diff
Download TagCloud.pm.diff
text/x-diff 2.4k
--- HTML/TagCloud.pm Tue Nov 7 22:05:17 2006 +++ /home/david/perl/devel/lib/HTML/TagCloud.pm Wed Sep 9 13:00:41 2009 @@ -1,7 +1,7 @@ package HTML::TagCloud; use strict; use warnings; -our $VERSION = '0.34'; +our $VERSION = '0.35'; sub new { my $class = shift; @@ -82,8 +82,13 @@ return ""; } elsif ($ntags == 1) { my $tag = $tags[0]; - return qq{<div id="htmltagcloud"><span class="tagcloud1"><a href="}. - $tag->{url}.qq{">}.$tag->{name}.qq{</a></span></div>\n}; + return qq{<div id="htmltagcloud"><span class="tagcloud1">} + . ( + (exists $self->{anchor_callback} && ref($self->{anchor_callback}) eq 'CODE') + ? $self->{anchor_callback}({url => $tag->{url}, name=> $tag->{name}}) + : qq{<a href="$tag->{url}">$tag->{name}</a>} + ) + . qq{</span></div>\n}; } # warn "min $min - max $max ($factor)"; @@ -92,8 +97,13 @@ my $html = ""; foreach my $tag (@tags) { - $html .= qq{<span class="tagcloud}.$tag->{level}.qq{"><a href="}.$tag->{url}. - qq{">}.$tag->{name}.qq{</a></span>\n}; + $html .= qq{<span class="tagcloud$tag->{level}">} + . ( + (exists $self->{anchor_callback} && ref($self->{anchor_callback}) eq 'CODE') + ? $self->{anchor_callback}({url => $tag->{url}, name=> $tag->{name}}) + : qq{<a href="$tag->{url}">$tag->{name}</a>} + ) + . qq{</span>\n}; } $html = qq{<div id="htmltagcloud"> $html</div>}; @@ -143,11 +153,37 @@ =head2 new -The constructor takes one optional argument: +The constructor takes two optional arguments: + +B<C<levels>> my $cloud = HTML::TagCloud->new(levels=>10); -if not provided, levels defaults to 24 +if not provided, levels defaults to 24. + +B<C<anchor_callback>> + +The second optional argument is a callback that may be used to +construct the C<< <a> >> element, for instance, to add a C<title> +attribute. The callback routine is passed a reference to a hash +containing two keys, C<name>, the name of the tag, and C<count>, +the count of this particular tag. + + # assume the following variable is defined + my %tag = ( + foo => {n => 37, url => 'urlfoo'}, + bar => {n => 1, url => 'urlbar'}, + ); + + my $cloud = HTML::TagCloud->new( + levels => 2, + anchor_callback => sub { + my $t = shift; + my $count = $tag{$t->{name}}{n}; + my $usage = $count == 1 ? 'used once' : "used $count times"; + return qq{<a href="$t->{url}" title="$usage">$t->{name}</a>}; + }, + ); =head1 METHODS
Download (untitled) / with headers
text/plain 442b
+1 to this technique of a callback! I attach a patch to David's code, where a default anchor_callback, based on the existing anchor output, is used. I've also set some extra attributes that can be passed through to the tags hash, which makes extending this much easier than David's method of having an external hash data. This is still backwards compatible with David's code though (his tests still pass!), so I've left his tests as is.
Subject: HTML_TagCloud_anchor_callback.patch
diff -ur HTML-TagCloud-0.34.original/CHANGES HTML-TagCloud-0.34/CHANGES --- HTML-TagCloud-0.34.original/CHANGES 2006-11-07 21:05:17.000000000 +0000 +++ HTML-TagCloud-0.34/CHANGES 2010-07-15 14:54:39.000000000 +0000 @@ -1,5 +1,9 @@ CHANGES file for HTML::TagCloud: +0.35 ??? + - Added ability to define own anchor_callback and add additional data for each tag + to reference in anchor_callback (David Landgren and Ton Voon - RT 49549) + 0.34 Tue Nov 7 21:00:33 GMT 2006 - Internet Explorer fix, which addresses issues with Japanese text (thanks to Tatsuhiko Miyagawa) diff -ur HTML-TagCloud-0.34.original/lib/HTML/TagCloud.pm HTML-TagCloud-0.34/lib/HTML/TagCloud.pm --- HTML-TagCloud-0.34.original/lib/HTML/TagCloud.pm 2006-11-07 21:05:17.000000000 +0000 +++ HTML-TagCloud-0.34/lib/HTML/TagCloud.pm 2010-07-15 14:52:49.000000000 +0000 @@ -1,7 +1,7 @@ package HTML::TagCloud; use strict; use warnings; -our $VERSION = '0.34'; +our $VERSION = '0.35'; sub new { my $class = shift; @@ -9,6 +9,7 @@ counts => {}, urls => {}, levels => 24, + anchor_callback => sub { my $tag = shift; qq{<a href="$tag->{url}">$tag->{name}</a>} }, @_ }; bless $self, $class; @@ -16,9 +17,10 @@ } sub add { - my($self, $tag, $url, $count) = @_; + my($self, $tag, $url, $count, $hash) = @_; $self->{counts}->{$tag} = $count; $self->{urls}->{$tag} = $url; + $self->{extras}->{$tag} = $hash || {}; } sub css { @@ -68,6 +70,7 @@ $tag_item->{count} = $counts->{$tag}; $tag_item->{url} = $urls->{$tag}; $tag_item->{level} = int((log($tag_item->{count}) - $min) * $factor); + $tag_item = { %$tag_item, %{$self->{extras}->{$tag}} }; push @tag_items,$tag_item; } return @tag_items; @@ -82,8 +85,9 @@ return ""; } elsif ($ntags == 1) { my $tag = $tags[0]; - return qq{<div id="htmltagcloud"><span class="tagcloud1"><a href="}. - $tag->{url}.qq{">}.$tag->{name}.qq{</a></span></div>\n}; + return qq{<div id="htmltagcloud"><span class="tagcloud1">} + . $self->{anchor_callback}( $tag ) + . qq{</span></div>\n}; } # warn "min $min - max $max ($factor)"; @@ -92,8 +96,9 @@ my $html = ""; foreach my $tag (@tags) { - $html .= qq{<span class="tagcloud}.$tag->{level}.qq{"><a href="}.$tag->{url}. - qq{">}.$tag->{name}.qq{</a></span>\n}; + $html .= qq{<span class="tagcloud$tag->{level}">} + . $self->{anchor_callback}( $tag ) + . qq{</span>\n}; } $html = qq{<div id="htmltagcloud"> $html</div>}; @@ -143,11 +148,33 @@ =head2 new -The constructor takes one optional argument: +The constructor takes two optional arguments: + +B<C<levels>> my $cloud = HTML::TagCloud->new(levels=>10); -if not provided, levels defaults to 24 +if not provided, levels defaults to 24. + +B<C<anchor_callback>> + +The second optional argument is a callback that may be used to +construct the C<< <a> >> element, for instance, to add a C<title> +attribute. The callback routine is passed a reference to the tag hash - +add any data you want to the tag via the 4th argument to the add() method + + my $cloud = HTML::TagCloud->new( + levels => 2, + anchor_callback => sub { + my $t = shift; + my $count = $t->{count}; + my $usage = $count == 1 ? 'used once' : "used $count times"; + return qq{<a href="$t->{url}" title="$usage" class="$t->{class}">$t->{name}</a>}; + }, + ); + + $cloud->add( "foo", "urlfoo", 37, { class => "red" } ); + $cloud->add( "bar", "urlbar", 1, { class => "black" } ); =head1 METHODS @@ -160,6 +187,11 @@ $cloud->add($tag2, $url2, $count2); $cloud->add($tag3, $url3, $count3); +You can pass in an optional 4th argument which is a hash ref of extra information. Eg: + + $cloud->add($tag1, $url1, $count1, { title => "Title", class => "green" }); + +This can be accessed from the anchor_callback to generate your own anchor tags. =head2 tags($limit) diff -ur HTML-TagCloud-0.34.original/t/simple.t HTML-TagCloud-0.34/t/simple.t --- HTML-TagCloud-0.34.original/t/simple.t 2006-11-07 21:05:17.000000000 +0000 +++ HTML-TagCloud-0.34/t/simple.t 2010-07-15 14:44:04.000000000 +0000 @@ -1,6 +1,6 @@ #!perl use strict; -use Test::More tests => 12; +use Test::More tests => 14; use_ok('HTML::TagCloud'); my $cloud = HTML::TagCloud->new; @@ -60,6 +60,51 @@ <span class="tagcloud3"><a href="c.html">c</a></span> </div>}); +my %tag2 = ( + foo => {n => 2, url => 'urlfoo'}, + bar => {n => 5, url => 'urlbar'}, + rat => {n => 7, url => 'urlrat'}, + one => {n => 1, url => 'urlonce'}, +); +$cloud = HTML::TagCloud->new( + levels => 4, + anchor_callback => sub { + my $t = shift; + my $count = $tag2{$t->{name}}{n}; + my $usage = $count == 1 ? 'used once' : "used $count times"; + return qq{<a href="$t->{url}" title="$usage">$t->{name}</a>}; + }, +); +for my $t (keys %tag2) { + $cloud->add( $t, $tag2{$t}{url}, $tag2{$t}{n} ); +} +$html = $cloud->html; +is($html, q{<div id="htmltagcloud"> +<span class="tagcloud3"><a href="urlbar" title="used 5 times">bar</a></span> +<span class="tagcloud1"><a href="urlfoo" title="used 2 times">foo</a></span> +<span class="tagcloud0"><a href="urlonce" title="used once">one</a></span> +<span class="tagcloud4"><a href="urlrat" title="used 7 times">rat</a></span> +</div>}, 'with anchor_callback'); + + +$cloud = HTML::TagCloud->new( + levels => 4, + anchor_callback => sub { + my $t = shift; + return qq{<a href="$t->{url}" title="$t->{title}" class="$t->{class}">$t->{name}</a>}; + }, +); +$cloud->add( "spiderman", "/url/spiderman", 12, { title => "Peter Parker", class => "red" } ); +$cloud->add( "batman", "/url/batman", 5, { title => "Caped Crusader", class => "black" } ); +$cloud->add( "wonderwoman", "/url/wonderwoman", 9, { title => "Princess Diana", class => "yellow" } ); +$html = $cloud->html; +is( $html, q{<div id="htmltagcloud"> +<span class="tagcloud0"><a href="/url/batman" title="Caped Crusader" class="black">batman</a></span> +<span class="tagcloud2"><a href="/url/spiderman" title="Peter Parker" class="red">spiderman</a></span> +<span class="tagcloud2"><a href="/url/wonderwoman" title="Princess Diana" class="yellow">wonderwoman</a></span> +</div>}, "with extra data anchor_callback" ); + + sub tags { return { 'laptop' => 11,
Download (untitled) / with headers
text/plain 394b
On Thu Jul 15 20:02:16 2010, TONVOON wrote: Show quoted text
> +1 to this technique of a callback! > > I attach a patch to David's code, where a default anchor_callback, > based on the existing anchor > output, is used. > > I've also set some extra attributes that can be passed through to the > tags hash, which makes > extending this much easier than David's method of having an external > hash data.
Nice!


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.