| Subject: | Patch to add a callback in order to generate custom <a> attributes |
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 |
--- 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 |
--- 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