File Coverage

blib/lib/WWW/Kickstarter/Data/Categories.pm

Criterion	Covered	Total	%
statement	15	63	23.8
branch	0	18	0.0
condition			n/a
subroutine	5	12	41.6
pod	4	4	100.0
total	24	97	24.7

package WWW::Kickstarter::Data::Categories;

use strict;
use warnings;
no autovivification;


use WWW::Kickstarter::Data  qw( );
use WWW::Kickstarter::Error qw( my_croak );


our @ISA = 'WWW::Kickstarter::Data';


sub _new {
   my_croak(400, "Incorrect usage") if @_ < 3;
   my ($class, $ks, $categories, %opts) = @_;

   if (my @unrecognized = keys(%opts)) {
      my_croak(400, "Unrecognized parameters @unrecognized");
   }

   my @tree;
   for my $category (@$categories) {
      my $parent_info = $category->{parent};
      my $parent_id   = $parent_info ? $parent_info->{id} : 0;
      my $position    = $category->{position};
      $tree[$parent_id][$position] = $category;
   }

   for my $category (@$categories) {
      my $subcategories = $tree[ $category->{id} ];
      $category->_set_subcategories( $subcategories ? grep defined, @$subcategories : () );
   }

   my $data = {
      categories => $categories,
      top_level  => [ grep defined, @{ $tree[0] } ],
   };

   return $class->SUPER::_new($ks, $data);
}


sub categories           { @{ $_[0]{categories} } }
sub top_level_categories { @{ $_[0]{top_level} } }


sub refetch { my $self = shift;  return $self->ks->categories(@_); }


sub _visit {
   my $self     = shift;
   my $visitor  = shift;
   my $category = shift;
   my $depth    = shift;

   my @subcategories =
      sort { $a->name() cmp $b->name() }
         $category ? $category->subcategories() : @{ $self->{top_level} };

   my $visit_next = sub {
      return 0 if !@subcategories;
      $self->_visit($visitor, shift(@subcategories), $depth+1, @_);
      return 1;
   };

   $visitor->($category, $depth, $visit_next, 0+@subcategories, @_);
}


sub visit {
   my_croak(400, "Incorrect usage") if @_ < 2;
   my $self = shift;
   my $opts = shift;

   my $visitor;
   if (ref($opts) eq 'CODE') {
      $visitor = $opts;
      $opts = undef;
   } else {
      $visitor = $opts->{visitor};
   }

   if ($opts->{root}) {
      $self->_visit($visitor, undef, 0, @_);
   } else {
      for my $category (
         sort { $a->name() cmp $b->name() }
            @{ $self->{top_level} }
      ) {
         $self->_visit($visitor, $category, 0, @_);
      }
   }
}


1;


__END__