view release on metacpan or  search on metacpan

lib/Data/CloudWeights.pm  view on Meta::CPAN

   return wantarray() ? @murtceps : \@murtceps;
};

# Attribute constructors
my $_build_colour_pallet = sub {
   my $self = shift;
   # Unsetting hot or cold colour strings in the constructor will cause
   # the default pallet to be used instead
   $self->cold_colour and $self->hot_colour
      and return [ $_generate->( 12, $self->cold_colour, $self->hot_colour ) ];

   return [ '#CC33FF', '#663399', '#3300CC', '#99CCFF',
            '#00FFFF', '#66FFCC', '#66CC99', '#006600',
            '#CCFF66', '#FFFF33', '#FF6600', '#FF0000' ];
};

# Public attributes
has 'cold_colour'    => is => 'ro',   isa => Maybe[$COLOUR],
   documentation     => 'Blue', default => '#0000FF';

has 'hot_colour'     => is => 'ro',   isa => Maybe[$COLOUR],
   documentation     => 'Red', default => '#FF0000';

has 'colour_pallet'  => is => 'lazy', isa => ArrayRef[$COLOUR],
   documentation     => 'Alternative to colour calculation',
   builder           => $_build_colour_pallet;

has 'decimal_places' => is => 'ro',   isa => Int, default => 3,
   documentation     => 'Defaults for ems';

has 'limit'          => is => 'rw',   isa => Int, default => 0,
   documentation     => 'Max size of returned list. Zero no limit';

has 'max_count'      => is => 'rwp',  isa => Int, default => 0,
   documentation     => 'Current max value across all tags cloud';

has 'max_size'       => is => 'rwp',  isa => Num, default => 3.0,
   documentation     => 'Output size no more than';

has 'min_count'      => is => 'rwp',  isa => Int, default => -1,
   documentation     => 'Current min';

has 'min_size'       => is => 'rwp',  isa => Num, default => 1.0,
   documentation     => 'Output size no less than';

has 'sort_field'     => is => 'rw',   isa => Maybe[Str], default => 'tag',
   documentation     => 'Output sorted by this field';

has 'sort_order'     => is => 'rw',   isa => $SORT_ORDER,
   documentation     => 'Sort order - asc or desc', default => 'asc';

has 'sort_type'      => is => 'rw',   isa => $SORT_TYPE,
   documentation     => 'Sort type - alpha or numeric',
   default           => 'alpha';

has 'total_count'    => is => 'rwp',  isa => Int, default => 0,
   documentation     => 'Current total for all tags in the cloud';

# Private attributes
has '_index' => is => 'ro', isa => HashRef, default => sub { {} };
has '_sorts' => is => 'ro', isa => HashRef, default => sub { {
   alpha   => {
      asc  => sub { my $x = shift; sub { $_[ 0 ]->{ $x } cmp $_[ 1 ]->{ $x } }
      },
      desc => sub { my $x = shift; sub { $_[ 1 ]->{ $x } cmp $_[ 0 ]->{ $x } }
      },
   },
   numeric => {
      asc  => sub { my $x = shift; sub { $_[ 0 ]->{ $x } <=> $_[ 1 ]->{ $x } }
      },
      desc => sub { my $x = shift; sub { $_[ 1 ]->{ $x } <=> $_[ 0 ]->{ $x } }
      },
   } } };
has '_tags'  => is => 'ro', isa => ArrayRef, default => sub { [] };

# Private methods
my $_get_sort_method = sub {
   my $self  = shift; # Add called multiple times, determine the sorting method
   # No sorting if sort field is false
   my $field = $self->sort_field or return sub { return 0 };

   ref $field and return $field; # User supplied subroutine

   my $orderby = $self->_sorts->{ lc $self->sort_type  }
                              ->{ lc $self->sort_order }->( $field );
   # Protect against wrong sort type for the data
   return $field ne 'tag'
        ? sub { return $orderby->( @_ ) || $_[ 0 ]->{tag} cmp $_[ 1 ]->{tag} }
        : $orderby;
};

# Public methods
sub add { # Include the passed args in this cloud's formation
   my ($self, $tag, $count, $value) = @_;

   $tag or return; # Mandatory arg used as a key in tag ref index

   # Mask out null strings and negative numbers from the passed count value
   $count = defined $count ? abs $count : 0;

   # Add this count to the total for this cloud
   $self->_set_total_count( $self->total_count + $count );

   if (not exists $self->_index->{ $tag }) {
      # Create a new tag reference and add to both list and index
      my $tag_ref = { count => $count, tag => $tag, value => $value };

      push @{ $self->_tags }, $self->_index->{ $tag } = $tag_ref;
   }
   else {
      my $index = $self->_index->{ $tag };

      # Calls with the same tag are cumulative
      $count += $index->{count}; $index->{count} = $count;

      if (defined $value) {
         my $tag_value = $index->{value};

         # Make an array if there are two or more calls to add the same tag
         $tag_value and ref $tag_value ne 'ARRAY'
            and $index->{value} = [ $tag_value ];

         # Push passed value in each call onto the values array.
         if ($tag_value) { push @{ $index->{value} }, $value }
         else { $index->{value} = $value }
      }
   }

   # Update this cloud's max and min values
   $count > $self->max_count and $self->_set_max_count( $count );
   $self->min_count == -1    and $self->_set_min_count( $count );
   $count < $self->min_count and $self->_set_min_count( $count );

   # Return the current cumulative count for this tag