Commit | Line | Data |
78ba4051 |
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 | |
ba909048 |
9 | use constant REDUCE => ($] >= 5.008009 ? \&List::Util::reduce : \&_reduce); |
10 | |
c256a8c4 |
11 | our $VERSION = '0.003'; |
78ba4051 |
12 | |
78ba4051 |
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 { |
2d9f5165 |
49 | join +(defined($_[1]) ? $_[1] : ''), map {"$_"} @{$_[0]}; |
78ba4051 |
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); |
ba909048 |
62 | goto &{REDUCE()}; |
78ba4051 |
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 | |
ba909048 |
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 | |
aeae9512 |
119 | local(*{$caller."::a"}) = \my $x; |
120 | local(*{$caller."::b"}) = \my $y; |
ba909048 |
121 | |
aeae9512 |
122 | $x = shift; |
ba909048 |
123 | foreach (@_) { |
aeae9512 |
124 | $y = $_; |
125 | $x = $code->(); |
ba909048 |
126 | } |
127 | |
aeae9512 |
128 | $x; |
ba909048 |
129 | } |
130 | |
78ba4051 |
131 | sub _ref { ref $_[0] eq 'ARRAY' || blessed $_[0] && $_[0]->isa(__PACKAGE__) } |
132 | |
133 | 1; |
9a5f1e3f |
134 | |
135 | =for Pod::Coverage *EVERYTHING* |
136 | |
137 | =cut |