Skip Menu |
 

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

Report information
The Basics
Id: 41257
Status: open
Worked: 1 hour (60 min)
Priority: 0/
Queue: HTML-TagCloud

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

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



Subject: Add support for (optional) title
Download (untitled) / with headers
text/plain 275b
In particular, I'd find it useful for links to have titles that show the use count of the tag. Others might want to provide long descriptions of tags, etc. You may want to accept tuples, instead of ordinal parameters then. And also to allow a default base on instantiation.
Subject: [patch] Add support for (optional) title & base
Download (untitled) / with headers
text/plain 6.4k
#The note about base was actually from me misreading my use; #saw the period as a comma; but it seemed a useful feature anyways diff -ur HTML-TagCloud-0.34/lib/HTML/TagCloud.pm HTML-TagCloud-1.00/lib/HTML/TagCloud.pm --- HTML-TagCloud-0.34/lib/HTML/TagCloud.pm 2006-11-07 16:05:17.000000000 -0500 +++ HTML-TagCloud-1.00/lib/HTML/TagCloud.pm 2008-11-27 13:52:45.000000000 -0500 @@ -1,24 +1,28 @@ package HTML::TagCloud; use strict; use warnings; -our $VERSION = '0.34'; +our $VERSION = '1.00'; sub new { my $class = shift; my $self = { - counts => {}, - urls => {}, - levels => 24, - @_ - }; + base => undef, + levels => 24, + @_, + _counts => {}, + _title => {}, + _urls => {}, + }; bless $self, $class; return $self; } sub add { - my($self, $tag, $url, $count) = @_; - $self->{counts}->{$tag} = $count; - $self->{urls}->{$tag} = $url; + my($self, %args) = @_; + $self->{_count}->{$args{tag}} = $args{count}; + $self->{_title}->{$args{tag}} = $args{title} if defined($args{title}); + $self->{_urls}->{$args{tag}} = defined($self->{base}) ? + $self->{base} . $args{url} : $args{url}; } sub css { @@ -39,8 +43,7 @@ sub tags { my($self, $limit) = @_; - my $counts = $self->{counts}; - my $urls = $self->{urls}; + my $counts = $self->{_count}; my @tags = sort { $counts->{$b} <=> $counts->{$a} } keys %$counts; @tags = splice(@tags, 0, $limit) if defined $limit; @@ -66,9 +69,11 @@ my $tag_item; $tag_item->{name} = $tag; $tag_item->{count} = $counts->{$tag}; - $tag_item->{url} = $urls->{$tag}; + $tag_item->{url} = $self->{_urls}->{$tag}; + #XXX + $tag_item->{title} = $self->{_title}->{$tag}; $tag_item->{level} = int((log($tag_item->{count}) - $min) * $factor); - push @tag_items,$tag_item; + push @tag_items, $tag_item; } return @tag_items; } @@ -77,23 +82,18 @@ my($self, $limit) = @_; my @tags=$self->tags($limit); - my $ntags = scalar(@tags); - if ($ntags == 0) { - 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('') unless scalar(@tags); # warn "min $min - max $max ($factor)"; # warn(($min - $min) * $factor); # warn(($max - $min) * $factor); - my $html = ""; + 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 .= sprintf qq(<span class="tagcloud%i"><a href="%s"%s>%s</a></span>\n), + $tag->{level}, $tag->{url}, + (defined($tag->{title}) ? qq( title="$tag->{title}") : ''), + $tag->{name}; } $html = qq{<div id="htmltagcloud"> $html</div>}; @@ -143,11 +143,13 @@ =head2 new -The constructor takes one optional argument: +The constructor accepts two optional arguments: + + my $cloud = HTML::TagCloud->new(levels=>10, base=>http://example.com/); - my $cloud = HTML::TagCloud->new(levels=>10); +If not provided, levels defaults to 24. -if not provided, levels defaults to 24 +If provided, base is prepended to all added URLs. =head1 METHODS @@ -156,10 +158,13 @@ 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); - + $cloud->add(tag=>$tag1, url=>$url1, count=>$count1); + $cloud->add(tag=>$tag2, url=>$url2, count=>$count2); + $cloud->add(tag=>$tag3, url=>$url3, count=>$count3); + +You can optionally supply a title parameter, which some user agents may +show as a tooltip. Possible uses included number of occurences, title of +linked page, etc. =head2 tags($limit) @@ -192,7 +197,8 @@ =head1 AUTHOR -Leon Brocard, C<< <acme@astray.com> >>. +Leon Brocard, L<acme@astray.com>, +with contributions from Jerrad Pierce L<jpierce@cpan.org>. =head1 COPYRIGHT @@ -200,4 +206,3 @@ This module is free software; you can redistribute it or modify it under the same terms as Perl itself. - Only in HTML-TagCloud-1.00/: Makefile diff -ur HTML-TagCloud-0.34/MANIFEST HTML-TagCloud-1.00/MANIFEST --- HTML-TagCloud-0.34/MANIFEST 2006-11-07 16:05:17.000000000 -0500 +++ HTML-TagCloud-1.00/MANIFEST 2008-11-27 13:53:02.000000000 -0500 @@ -7,4 +7,5 @@ t/pod.t t/pod_coverage.t t/simple.t +t/extend.t META.yml diff -ur HTML-TagCloud-0.34/META.yml HTML-TagCloud-1.00/META.yml --- HTML-TagCloud-0.34/META.yml 2006-11-07 16:05:17.000000000 -0500 +++ HTML-TagCloud-1.00/META.yml 2008-11-27 13:54:57.000000000 -0500 @@ -1,8 +1,11 @@ ---- #YAML:1.0 -name: HTML-TagCloud -version: 0.34 -author: - - Leon Brocard, C<< <acme@astray.com> >>. -abstract: Generate An HTML Tag Cloud -license: perl -generated_by: Module::Build version 0.2612, without YAML.pm +# http://module-build.sourceforge.net/META-spec.html +#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# +name: HTML-TagCloud +version: 1.00 +version_from: lib/HTML/TagCloud.pm +installdirs: site +requires: + Test::More: 0 + +distribution_type: module +generated_by: ExtUtils::MakeMaker version 6.17 Only in HTML-TagCloud-1.00/: pm_to_blib Only in HTML-TagCloud-1.00/t: extend.t diff -ur HTML-TagCloud-0.34/t/simple.t HTML-TagCloud-1.00/t/simple.t --- HTML-TagCloud-0.34/t/simple.t 2006-11-07 16:05:17.000000000 -0500 +++ HTML-TagCloud-1.00/t/simple.t 2008-11-27 13:29:08.000000000 -0500 @@ -10,7 +10,7 @@ foreach my $tag (keys %$tags) { my $count = $tags->{$tag}; my $url = "/show/$tag"; - $cloud->add($tag, $url, $count); + $cloud->add(tag=>$tag, url=>$url, count=>$count); } my $css = $cloud->css; @@ -20,8 +20,9 @@ is($html, ""); $html = $cloud->html(1); -is($html, q{<div id="htmltagcloud"><span class="tagcloud1"><a href="/show/florida">florida</a></span></div> -}); +is($html, q{<div id="htmltagcloud"> +<span class="tagcloud1"><a href="/show/florida">florida</a></span> +</div>}); $html = $cloud->html(2); is($html, q{<div id="htmltagcloud"> @@ -49,9 +50,9 @@ 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); +$cloud->add(tag=>"a", url=>"a.html", count=>10); +$cloud->add(tag=>"b", url=>"b.html", count=>10); +$cloud->add(tag=>"c", url=>"c.html", count=>10); $html = $cloud->html(); is($html, q{<div id="htmltagcloud">
Subject: Add support for (optional) title... forgot t/extend.t
Download (untitled) / with headers
text/plain 847b
#!perl use strict; use Test::More tests => 2; use_ok('HTML::TagCloud'); my $cloud = HTML::TagCloud->new(base=>'http://localhost/show/'); my $tags = tags(); foreach my $tag (keys %$tags) { my $count = $tags->{$tag}; $cloud->add(tag=>$tag, url=>$tag, count=>$count, title=>$count); } my $html = $cloud->html(5); is($html, q{<div id="htmltagcloud"> <span class="tagcloud5"><a href="http://localhost/show/florida" title="282">florida</a></span> <span class="tagcloud0"><a href="http://localhost/show/fort" title="165">fort</a></span> <span class="tagcloud1"><a href="http://localhost/show/london" title="197">london</a></span> <span class="tagcloud2"><a href="http://localhost/show/madagascar" title="224">madagascar</a></span> <span class="tagcloud3"><a href="http://localhost/show/tanja" title="248">tanja</a></span> </div>}); sub tags { ...
Download (untitled) / with headers
text/plain 434b
On Thu Nov 27 01:39:37 2008, JPIERCE wrote: Show quoted text
> In particular, I'd find it useful for links to have titles that show the > use count of the tag. Others might want to provide long descriptions of > tags, etc. > > You may want to accept tuples, instead of ordinal parameters then. > And also to allow a default base on instantiation.
You might want to look at the patch I just filed (cpan #49549), which is Another Way To Do it. David
Download (untitled) / with headers
text/plain 330b
Show quoted text
> > You may want to accept tuples, instead of ordinal parameters then. > > And also to allow a default base on instantiation.
Thanks, but this ticket's been open for so long I simply pulled the relevant chunks of TagCloud into RTx::Tags and modified as necessary. In so doing I also added support for the use of a common URL base.


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.