File Coverage

blib/lib/HTML/TagCloud/Simple.pm

Criterion	Covered	Total	%
statement	58	62	93.5
branch	15	18	83.3
condition	5	8	62.5
subroutine	4	4	100.0
pod	0	1	0.0
total	82	93	88.1

package HTML::TagCloud::Simple;
use strict;
use warnings;

use 5.010; # sorry, need smart matching

require Exporter;
our @ISA = qw(Exporter);
our @EXPORT    = qw();
our @EXPORT_OK = qw(build_cloud);

our $VERSION = '0.03';

## TODO
# need to add the reverse sorting mechanisms
# come up with good way to test this output

$HTML::Tag::Font_Family = 'monospace';
@HTML::Tag::Font_Sizes = ('70%', '85%', '100%', '115%', '130%'); # hmm..

## generalized routines for generating HTML tag clouds

sub build_cloud {
    # build_cloud(\%hash, $base_url, $height, $width, [$sort_method], [$min_count]) -- returns an HTML string for a tag 'cloud'
    my $href        = shift;
    my %tags        = %{$href};
    my $base_url    = shift;
    my $height      = shift // 50;
    my $width       = shift // 50;
    my $sort_method = shift // 'ascii'; # allows sorting by 'ascii' or 'value' (can also prefix either with 'reverse-')
    my $min_count   = shift // 0;
    my $html;

    ## need to cull entries with less than $min_count
	my @keepers = grep { $tags{$_}{count} > $min_count; } keys %tags;
	foreach (keys %tags) {
		delete $tags{$_} unless @keepers ~~ /$_/;
	}

	my @ordered = sort { $tags{$a}{count} <=> $tags{$b}{count} } keys %tags;
	my $high = $tags{$ordered[-1]}{count};
	my $range = ($high / $#HTML::Tag::Font_Sizes);

	foreach my $tag (keys %tags) {
		my $count = $tags{$tag}{count};

		my $size = ($count < ($range)) ? $HTML::Tag::Font_Sizes[0] :
				   ($count < ($range * 2)) ? $HTML::Tag::Font_Sizes[1] :
				   ($count < ($range * 3)) ? $HTML::Tag::Font_Sizes[2] :
				   ($count < ($range * 4)) ? $HTML::Tag::Font_Sizes[3] :
																	$HTML::Tag::Font_Sizes[-1]; # default
		$tags{$tag}{size} = $size;

	}

    ## build the initial HTML
    my $id = 'tag_cloud_1';
    $html = "";

    ## iterate keys according to sort
    my @keys;
    if ($sort_method =~ /value/i) {
		@keys = sort { $tags{$a}{count} <=> $tags{$b}{count} } keys %tags;
    } else {
		@keys = sort { $a cmp $b } keys %tags;
    }

    for (my $i = 0; $i <= $#keys; $i++) {
		my $lhtml;
		my $key = $keys[$i];
		my %tag = %{$tags{$key}}; # need to have some error checking here
		my $size = $tag{size};
		my $count = $tag{count};

		my $link;
		if (defined $tag{link_rel}) {
			my $link = $tag{link_rel};
			my $alt  = $count;

			warn "WARN:: '' specified in '$key', but no 'base' spec in build_cloud() call" unless $base_url;
			$link =~ s//$base_url/;
			$link =~ s//$count/g;
			$link =~ s//$key/g;


			$lhtml = "$key";

		} elsif (defined $tag{link_abs}) {
			my $link = $tag{link_abs};
			my $alt  = $count;

			$lhtml = "$key";

		} else  {
			warn "WARN:: no 'link_abs' or 'link_rel' specified for '$key'";
			next;
		}

		$html .= " " . $lhtml;

    }

    ## build the closing HTML
    $html .= "";

    return $html;
}


1;

__END__