HTML::TagCloud::Sortable - A sortable HTML tag cloud

    my $cloud = HTML::TagCloud::Sortable->new;

    # old HTML::TagCloud style
    $cloud->add( 'foo', $url, 10 );

    # new HTML::TagCloud::Sortable style
    $cloud->add( { name => 'foo', url => $url, count => 10, bar => 'baz' } );

    # old style
    print $cloud->html( 4 );

    # new style
    print $cloud->html( { limit => 4, sort_field => 'count', sort_type => 'numeric' } );

    $cloud->html( { sort_field =>
        sub { $_[ 1 ]->{ count } <=> $_[ 0 ]->{ count }; }
    } );

package HTML::TagCloud::Sortable;

use strict;
use warnings;

use base qw( HTML::TagCloud );

our $VERSION = '0.04';

sub new {
    my $self = shift->SUPER::new( @_ );
    $self->{ tags } = [];
    delete $self->{ urls };
    return $self;
}

sub add {
    my ( $self, @args ) = @_;

    my ( $tag, $count );
    if ( ref $args[ 0 ] ) {
        push @{ $self->{ tags } }, $args[ 0 ];
        $tag   = $args[ 0 ]->{ name };
        $count = $args[ 0 ]->{ count };
    }
    else {
        my $url;
        ( $tag, $url, $count ) = @args;
        push @{ $self->{ tags } },
            { name => $tag, count => $count, url => $url };
    }

    $self->{ counts }->{ $tag } = $count;
}

my %sorts = (
    alpha => {
        asc => sub {
            my $f = shift;
            return sub { $_[ 0 ]->{ $f } cmp $_[ 1 ]->{ $f } }
        },
        desc => sub {
            my $f = shift;
            return sub { $_[ 1 ]->{ $f } cmp $_[ 0 ]->{ $f } }
        },
    },
    numeric => {
        asc => sub {
            my $f = shift;
            return sub { $_[ 0 ]->{ $f } <=> $_[ 1 ]->{ $f } }
        },
        desc => sub {
            my $f = shift;
            return sub { $_[ 1 ]->{ $f } <=> $_[ 0 ]->{ $f } }
        },
    },
);

sub tags {
    my ( $self, @args ) = @_;

    my %options;
    if ( defined $args[ 0 ] ) {
        if ( !ref $args[ 0 ] ) {
            $options{ limit } = shift @args;
        }
        else {
            %options = %{ $args[ 0 ] };
        }
    }

    $options{ sort_field } = 'name'  if !exists $options{ sort_field };
    $options{ sort_type }  = 'alpha' if !$options{ sort_type };
    $options{ sort_order } = 'asc'   if !$options{ sort_order };

    my ( @tags, @counts );

    if ( defined( my $limit = $options{ limit } ) ) {
        my @sorted = ( sort { $b->{ count } <=> $a->{ count } }
                @{ $self->{ tags } } );
        my %top = map { $_->{ name } => $_->{ count } }
            splice( @sorted, 0, $limit );
        @counts = ( sort { $b <=> $a } values %top );
        @tags = grep { exists $top{ $_->{ name } } } @{ $self->{ tags } };
    }
    else {
        @tags = @{ $self->{ tags } };
        @counts = ( sort { $b->{ count } <=> $a->{ count } }
                @{ $self->{ tags } } );
    }

    return unless scalar @tags;

    my $min = log( $counts[ -1 ] );
    my $max = log( $counts[ 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 } );
    }

    if ( my $sort = $options{ sort_field } ) {

        if ( !ref $sort ) {
            my $newsort = $sorts{ lc $options{ sort_type } }
                { lc $options{ sort_order } }->( $sort );
            $sort = $sort ne 'name'
                ? sub {
                $newsort->( @_ ) || $_[ 0 ]->{ name } cmp $_[ 1 ]->{ name };
                }
                : $newsort;
        }

        my $oldsort = $sort;
        $sort = sub { $oldsort->( $a, $b ); };
        @tags = sort $sort @tags;
    }

    for my $tag ( @tags ) {
        $tag->{ level } = int( ( log( $tag->{ count } ) - $min ) * $factor );
    }

    return @tags;
}

1;