lib/Blog/Helper/Tag.pm

   1 package Blog::Helper::Tag;
   2
   3 use strict;
   4
   5 use base 'Blog::Helper';
   6
   7 sub new {
   8     my $self = shift;
   9
  10     $self = $self->next::method( @_ );
  11
  12     $self->{ empty_tags } = [];
  13     $self->{ levels } = 24;
  14
  15     return $self;
  16 }
  17
  18 sub cloud_list {
  19     my ( $self ) = @_;
  20
  21     my $c = Blog->context;
  22     my $tags = $c->model( 'Tag' )->search(
  23         select   => [ 'id', 'name', \'COUNT(t2.tag_id) AS map_count' ],
  24         sort_by  => 'name ASC',
  25         group_by => 'id',
  26         with_objects => 'post_tag_map'
  27     );
  28
  29     return unless @$tags;
  30
  31     my $ar = [];
  32     foreach my $tag ( @$tags ) {
  33         my $hash = {};
  34         foreach my $method ( qw/ id name / ) {
  35             $hash->{ $method } = $tag->$method;
  36         }
  37         $hash->{ count } = $tag->map_count;
  38         if ( $hash->{ count } > 0 ) {
  39             push @$ar, $hash;
  40         } else {
  41             push @{ $self->{ empty_tags } }, $hash;
  42         }
  43     }
  44
  45     return unless @$ar;
  46
  47     # from HTML::TagCloud
  48     my @sorted_by_count = sort { $b->{ count } <=> $a->{ count } } @$ar;
  49
  50     my $min = log( $sorted_by_count[ -1 ]->{ count } );
  51     my $max = log( $sorted_by_count[ 0 ]->{ count } );
  52     my $factor;
  53
  54     # special case all tags having the same count
  55     if ( $max - $min == 0 ) {
  56         $min    = $min - $self->{ levels };
  57         $factor = 1;
  58     } else {
  59         $factor = $self->{ levels } / ( $max - $min );
  60     }
  61
  62     #warn $factor;
  63
  64     if ( scalar @$ar < $self->{ levels } ) {
  65         $factor *= ( scalar @$ar / $self->{ levels } );
  66     }
  67
  68     #warn $min;
  69     #warn $max;
  70
  71     foreach my $tag ( @$ar ) {
  72         $tag->{ level } = int( ( log( $tag->{ count } ) - $min ) * $factor );
  73     }
  74
  75     return $ar;
  76 }
  77
  78 =head1 AUTHOR
  79
  80 vti
  81
  82 =head1 LICENSE
  83
  84 This library is free software, you can redistribute it and/or modify
  85 it under the same terms as Perl itself.
  86
  87 =cut
  88
  89 1;