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 | |
9 | our $VERSION = '0.001'; |
10 | |
11 | =for Pod::Coverage *EVERYTHING* |
12 | |
13 | =cut |
14 | |
15 | sub new { |
16 | my $class = shift; |
17 | return bless [@_], ref $class || $class; |
18 | } |
19 | |
20 | sub TO_JSON { [@{shift()}] } |
21 | |
22 | sub compact { |
23 | my $self = shift; |
24 | return $self->new(grep { defined && (ref || length) } @$self); |
25 | } |
26 | |
27 | sub each { |
28 | my ($self, $cb) = @_; |
29 | return @$self unless $cb; |
30 | my $i = 1; |
31 | $_->$cb($i++) for @$self; |
32 | return $self; |
33 | } |
34 | |
35 | sub first { |
36 | my ($self, $cb) = (shift, shift); |
37 | return $self->[0] unless $cb; |
38 | return List::Util::first { $_ =~ $cb } @$self if ref $cb eq 'Regexp'; |
39 | return List::Util::first { $_->$cb(@_) } @$self; |
40 | } |
41 | |
42 | sub flatten { $_[0]->new(_flatten(@{$_[0]})) } |
43 | |
44 | sub grep { |
45 | my ($self, $cb) = (shift, shift); |
46 | return $self->new(grep { $_ =~ $cb } @$self) if ref $cb eq 'Regexp'; |
47 | return $self->new(grep { $_->$cb(@_) } @$self); |
48 | } |
49 | |
50 | sub join { |
51 | join $_[1] // '', map {"$_"} @{$_[0]}; |
52 | } |
53 | |
54 | sub last { shift->[-1] } |
55 | |
56 | sub map { |
57 | my ($self, $cb) = (shift, shift); |
58 | return $self->new(map { $_->$cb(@_) } @$self); |
59 | } |
60 | |
61 | sub reduce { |
62 | my $self = shift; |
63 | @_ = (@_, @$self); |
64 | goto &List::Util::reduce; |
65 | } |
66 | |
67 | sub reverse { $_[0]->new(reverse @{$_[0]}) } |
68 | |
69 | sub shuffle { $_[0]->new(List::Util::shuffle @{$_[0]}) } |
70 | |
71 | sub size { scalar @{$_[0]} } |
72 | |
73 | sub slice { |
74 | my $self = shift; |
75 | return $self->new(@$self[@_]); |
76 | } |
77 | |
78 | sub sort { |
79 | my ($self, $cb) = @_; |
80 | |
81 | return $self->new(sort @$self) unless $cb; |
82 | |
83 | my $caller = caller; |
84 | no strict 'refs'; |
85 | my @sorted = sort { |
86 | local (*{"${caller}::a"}, *{"${caller}::b"}) = (\$a, \$b); |
87 | $a->$cb($b); |
88 | } @$self; |
89 | return $self->new(@sorted); |
90 | } |
91 | |
92 | sub tap { |
93 | my ($self, $cb) = (shift, shift); |
94 | $_->$cb(@_) for $self; |
95 | return $self; |
96 | } |
97 | |
98 | sub to_array { [@{shift()}] } |
99 | |
100 | sub uniq { |
101 | my ($self, $cb) = (shift, shift); |
102 | my %seen; |
103 | return $self->new(grep { !$seen{$_->$cb(@_)}++ } @$self) if $cb; |
104 | return $self->new(grep { !$seen{$_}++ } @$self); |
105 | } |
106 | |
107 | sub _flatten { |
108 | map { _ref($_) ? _flatten(@$_) : $_ } @_; |
109 | } |
110 | |
111 | sub _ref { ref $_[0] eq 'ARRAY' || blessed $_[0] && $_[0]->isa(__PACKAGE__) } |
112 | |
113 | 1; |