lib/DOM/Tiny/_Collection.pm

   1 package DOM::Tiny::_Collection;
   2
   3 use strict;
   4 use warnings;
   5 use Carp 'croak';
   6 use List::Util;
   7 use Scalar::Util 'blessed';
   8
   9 use constant REDUCE => ($] >= 5.008009 ? \&List::Util::reduce : \&_reduce);
  10
  11 our $VERSION = '0.004';
  12
  13 sub new {
  14   my $class = shift;
  15   return bless [@_], ref $class || $class;
  16 }
  17
  18 sub TO_JSON { [@{shift()}] }
  19
  20 sub compact {
  21   my $self = shift;
  22   return $self->new(grep { defined && (ref || length) } @$self);
  23 }
  24
  25 sub each {
  26   my ($self, $cb) = @_;
  27   return @$self unless $cb;
  28   my $i = 1;
  29   $_->$cb($i++) for @$self;
  30   return $self;
  31 }
  32
  33 sub first {
  34   my ($self, $cb) = (shift, shift);
  35   return $self->[0] unless $cb;
  36   return List::Util::first { $_ =~ $cb } @$self if ref $cb eq 'Regexp';
  37   return List::Util::first { $_->$cb(@_) } @$self;
  38 }
  39
  40 sub flatten { $_[0]->new(_flatten(@{$_[0]})) }
  41
  42 sub grep {
  43   my ($self, $cb) = (shift, shift);
  44   return $self->new(grep { $_ =~ $cb } @$self) if ref $cb eq 'Regexp';
  45   return $self->new(grep { $_->$cb(@_) } @$self);
  46 }
  47
  48 sub join {
  49   join +(defined($_[1]) ? $_[1] : ''), map {"$_"} @{$_[0]};
  50 }
  51
  52 sub last { shift->[-1] }
  53
  54 sub map {
  55   my ($self, $cb) = (shift, shift);
  56   return $self->new(map { $_->$cb(@_) } @$self);
  57 }
  58
  59 sub reduce {
  60   my $self = shift;
  61   @_ = (@_, @$self);
  62   goto &{REDUCE()};
  63 }
  64
  65 sub reverse { $_[0]->new(reverse @{$_[0]}) }
  66
  67 sub shuffle { $_[0]->new(List::Util::shuffle @{$_[0]}) }
  68
  69 sub size { scalar @{$_[0]} }
  70
  71 sub slice {
  72   my $self = shift;
  73   return $self->new(@$self[@_]);
  74 }
  75
  76 sub sort {
  77   my ($self, $cb) = @_;
  78
  79   return $self->new(sort @$self) unless $cb;
  80
  81   my $caller = caller;
  82   no strict 'refs';
  83   my @sorted = sort {
  84     local (*{"${caller}::a"}, *{"${caller}::b"}) = (\$a, \$b);
  85     $a->$cb($b);
  86   } @$self;
  87   return $self->new(@sorted);
  88 }
  89
  90 sub tap {
  91   my ($self, $cb) = (shift, shift);
  92   $_->$cb(@_) for $self;
  93   return $self;
  94 }
  95
  96 sub to_array { [@{shift()}] }
  97
  98 sub uniq {
  99   my ($self, $cb) = (shift, shift);
 100   my %seen;
 101   return $self->new(grep { !$seen{$_->$cb(@_)}++ } @$self) if $cb;
 102   return $self->new(grep { !$seen{$_}++ } @$self);
 103 }
 104
 105 sub _flatten {
 106   map { _ref($_) ? _flatten(@$_) : $_ } @_;
 107 }
 108
 109 # For perl < 5.8.9
 110 sub _reduce (&@) {
 111   my $code = shift;
 112
 113   return shift unless @_ > 1;
 114
 115   my $caller = caller;
 116
 117   no strict 'refs';
 118
 119   local (*{"${caller}::a"}, *{"${caller}::b"}) = (\my $x, \my $y);
 120
 121   $x = shift;
 122   foreach my $e (@_) {
 123     $y = $e;
 124     $x = $code->();
 125   }
 126
 127   $x;
 128 }
 129
 130 sub _ref { ref $_[0] eq 'ARRAY' || blessed $_[0] && $_[0]->isa(__PACKAGE__) }
 131
 132 1;
 133
 134 =for Pod::Coverage *EVERYTHING*
 135
 136 =cut