lib/DOM/Tiny/Collection.pm

   1 package DOM::Tiny::Collection;
   2
   3 use strict;
   4 use warnings;
   5 use Carp 'croak';
   6 use Exporter 'import';
   7 use List::Util;
   8 use Scalar::Util 'blessed';
   9
  10 our @EXPORT_OK = ('c');
  11
  12 sub TO_JSON { [@{shift()}] }
  13
  14 sub c { __PACKAGE__->new(@_) }
  15
  16 sub compact {
  17   my $self = shift;
  18   return $self->new(grep { defined && (ref || length) } @$self);
  19 }
  20
  21 sub each {
  22   my ($self, $cb) = @_;
  23   return @$self unless $cb;
  24   my $i = 1;
  25   $_->$cb($i++) for @$self;
  26   return $self;
  27 }
  28
  29 sub first {
  30   my ($self, $cb) = (shift, shift);
  31   return $self->[0] unless $cb;
  32   return List::Util::first { $_ =~ $cb } @$self if ref $cb eq 'Regexp';
  33   return List::Util::first { $_->$cb(@_) } @$self;
  34 }
  35
  36 sub flatten { $_[0]->new(_flatten(@{$_[0]})) }
  37
  38 sub grep {
  39   my ($self, $cb) = (shift, shift);
  40   return $self->new(grep { $_ =~ $cb } @$self) if ref $cb eq 'Regexp';
  41   return $self->new(grep { $_->$cb(@_) } @$self);
  42 }
  43
  44 sub join {
  45   join $_[1] // '', map {"$_"} @{$_[0]};
  46 }
  47
  48 sub last { shift->[-1] }
  49
  50 sub map {
  51   my ($self, $cb) = (shift, shift);
  52   return $self->new(map { $_->$cb(@_) } @$self);
  53 }
  54
  55 sub new {
  56   my $class = shift;
  57   return bless [@_], ref $class || $class;
  58 }
  59
  60 sub reduce {
  61   my $self = shift;
  62   @_ = (@_, @$self);
  63   goto &List::Util::reduce;
  64 }
  65
  66 sub reverse { $_[0]->new(reverse @{$_[0]}) }
  67
  68 sub shuffle { $_[0]->new(List::Util::shuffle @{$_[0]}) }
  69
  70 sub size { scalar @{$_[0]} }
  71
  72 sub slice {
  73   my $self = shift;
  74   return $self->new(@$self[@_]);
  75 }
  76
  77 sub sort {
  78   my ($self, $cb) = @_;
  79
  80   return $self->new(sort @$self) unless $cb;
  81
  82   my $caller = caller;
  83   no strict 'refs';
  84   my @sorted = sort {
  85     local (*{"${caller}::a"}, *{"${caller}::b"}) = (\$a, \$b);
  86     $a->$cb($b);
  87   } @$self;
  88   return $self->new(@sorted);
  89 }
  90
  91 sub tap {
  92   my ($self, $cb) = (shift, shift);
  93   $_->$cb(@_) for $self;
  94   return $self;
  95 }
  96
  97 sub to_array { [@{shift()}] }
  98
  99 sub uniq {
 100   my ($self, $cb) = (shift, shift);
 101   my %seen;
 102   return $self->new(grep { !$seen{$_->$cb(@_)}++ } @$self) if $cb;
 103   return $self->new(grep { !$seen{$_}++ } @$self);
 104 }
 105
 106 sub _flatten {
 107   map { _ref($_) ? _flatten(@$_) : $_ } @_;
 108 }
 109
 110 sub _ref { ref $_[0] eq 'ARRAY' || blessed $_[0] && $_[0]->isa(__PACKAGE__) }
 111
 112 1;
 113
 114 =encoding utf8
 115
 116 =head1 NAME
 117
 118 DOM::Tiny::Collection - Collection
 119
 120 =head1 SYNOPSIS
 121
 122   use Mojo::Collection;
 123
 124   # Manipulate collection
 125   my $collection = Mojo::Collection->new(qw(just works));
 126   unshift @$collection, 'it';
 127   say $collection->join("\n");
 128
 129   # Chain methods
 130   $collection->map(sub { ucfirst })->shuffle->each(sub {
 131     my ($word, $num) = @_;
 132     say "$num: $word";
 133   });
 134
 135   # Use the alternative constructor
 136   use Mojo::Collection 'c';
 137   c(qw(a b c))->join('/')->url_escape->say;
 138
 139 =head1 DESCRIPTION
 140
 141 L<Mojo::Collection> is an array-based container for collections.
 142
 143   # Access array directly to manipulate collection
 144   my $collection = Mojo::Collection->new(1 .. 25);
 145   $collection->[23] += 100;
 146   say for @$collection;
 147
 148 =head1 FUNCTIONS
 149
 150 L<Mojo::Collection> implements the following functions, which can be imported
 151 individually.
 152
 153 =head2 c
 154
 155   my $collection = c(1, 2, 3);
 156
 157 Construct a new array-based L<Mojo::Collection> object.
 158
 159 =head1 METHODS
 160
 161 L<Mojo::Collection> implements the following methods.
 162
 163 =head2 TO_JSON
 164
 165   my $array = $collection->TO_JSON;
 166
 167 Alias for L</"to_array">.
 168
 169 =head2 compact
 170
 171   my $new = $collection->compact;
 172
 173 Create a new collection with all elements that are defined and not an empty
 174 string.
 175
 176   # "0, 1, 2, 3"
 177   Mojo::Collection->new(0, 1, undef, 2, '', 3)->compact->join(', ');
 178
 179 =head2 each
 180
 181   my @elements = $collection->each;
 182   $collection  = $collection->each(sub {...});
 183
 184 Evaluate callback for each element in collection or return all elements as a
 185 list if none has been provided. The element will be the first argument passed
 186 to the callback and is also available as C<$_>.
 187
 188   # Make a numbered list
 189   $collection->each(sub {
 190     my ($e, $num) = @_;
 191     say "$num: $e";
 192   });
 193
 194 =head2 first
 195
 196   my $first = $collection->first;
 197   my $first = $collection->first(qr/foo/);
 198   my $first = $collection->first(sub {...});
 199   my $first = $collection->first($method);
 200   my $first = $collection->first($method, @args);
 201
 202 Evaluate regular expression/callback for, or call method on, each element in
 203 collection and return the first one that matched the regular expression, or for
 204 which the callback/method returned true. The element will be the first argument
 205 passed to the callback and is also available as C<$_>.
 206
 207   # Longer version
 208   my $first = $collection->first(sub { $_->$method(@args) });
 209
 210   # Find first value that contains the word "mojo"
 211   my $interesting = $collection->first(qr/mojo/i);
 212
 213   # Find first value that is greater than 5
 214   my $greater = $collection->first(sub { $_ > 5 });
 215
 216 =head2 flatten
 217
 218   my $new = $collection->flatten;
 219
 220 Flatten nested collections/arrays recursively and create a new collection with
 221 all elements.
 222
 223   # "1, 2, 3, 4, 5, 6, 7"
 224   Mojo::Collection->new(1, [2, [3, 4], 5, [6]], 7)->flatten->join(', ');
 225
 226 =head2 grep
 227
 228   my $new = $collection->grep(qr/foo/);
 229   my $new = $collection->grep(sub {...});
 230   my $new = $collection->grep($method);
 231   my $new = $collection->grep($method, @args);
 232
 233 Evaluate regular expression/callback for, or call method on, each element in
 234 collection and create a new collection with all elements that matched the
 235 regular expression, or for which the callback/method returned true. The element
 236 will be the first argument passed to the callback and is also available as
 237 C<$_>.
 238
 239   # Longer version
 240   my $new = $collection->grep(sub { $_->$method(@args) });
 241
 242   # Find all values that contain the word "mojo"
 243   my $interesting = $collection->grep(qr/mojo/i);
 244
 245   # Find all values that are greater than 5
 246   my $greater = $collection->grep(sub { $_ > 5 });
 247
 248 =head2 join
 249
 250   my $stream = $collection->join;
 251   my $stream = $collection->join("\n");
 252
 253 Turn collection into string.
 254
 255   # Join all values with commas
 256   $collection->join(', ')->say;
 257
 258 =head2 last
 259
 260   my $last = $collection->last;
 261
 262 Return the last element in collection.
 263
 264 =head2 map
 265
 266   my $new = $collection->map(sub {...});
 267   my $new = $collection->map($method);
 268   my $new = $collection->map($method, @args);
 269
 270 Evaluate callback for, or call method on, each element in collection and create
 271 a new collection from the results. The element will be the first argument
 272 passed to the callback and is also available as C<$_>.
 273
 274   # Longer version
 275   my $new = $collection->map(sub { $_->$method(@args) });
 276
 277   # Append the word "mojo" to all values
 278   my $mojoified = $collection->map(sub { $_ . 'mojo' });
 279
 280 =head2 new
 281
 282   my $collection = Mojo::Collection->new(1, 2, 3);
 283
 284 Construct a new array-based L<Mojo::Collection> object.
 285
 286 =head2 reduce
 287
 288   my $result = $collection->reduce(sub {...});
 289   my $result = $collection->reduce(sub {...}, $initial);
 290
 291 Reduce elements in collection with callback, the first element will be used as
 292 initial value if none has been provided.
 293
 294   # Calculate the sum of all values
 295   my $sum = $collection->reduce(sub { $a + $b });
 296
 297   # Count how often each value occurs in collection
 298   my $hash = $collection->reduce(sub { $a->{$b}++; $a }, {});
 299
 300 =head2 reverse
 301
 302   my $new = $collection->reverse;
 303
 304 Create a new collection with all elements in reverse order.
 305
 306 =head2 slice
 307
 308   my $new = $collection->slice(4 .. 7);
 309
 310 Create a new collection with all selected elements.
 311
 312   # "B C E"
 313   Mojo::Collection->new('A', 'B', 'C', 'D', 'E')->slice(1, 2, 4)->join(' ');
 314
 315 =head2 shuffle
 316
 317   my $new = $collection->shuffle;
 318
 319 Create a new collection with all elements in random order.
 320
 321 =head2 size
 322
 323   my $size = $collection->size;
 324
 325 Number of elements in collection.
 326
 327 =head2 sort
 328
 329   my $new = $collection->sort;
 330   my $new = $collection->sort(sub {...});
 331
 332 Sort elements based on return value of callback and create a new collection
 333 from the results.
 334
 335   # Sort values case-insensitive
 336   my $case_insensitive = $collection->sort(sub { uc($a) cmp uc($b) });
 337
 338 =head2 tap
 339
 340   $collection = $collection->tap(sub {...});
 341
 342 Alias for L<Mojo::Base/"tap">.
 343
 344 =head2 to_array
 345
 346   my $array = $collection->to_array;
 347
 348 Turn collection into array reference.
 349
 350 =head2 uniq
 351
 352   my $new = $collection->uniq;
 353   my $new = $collection->uniq(sub {...});
 354   my $new = $collection->uniq($method);
 355   my $new = $collection->uniq($method, @args);
 356
 357 Create a new collection without duplicate elements, using the string
 358 representation of either the elements or the return value of the
 359 callback/method.
 360
 361   # Longer version
 362   my $new = $collection->uniq(sub { $_->$method(@args) });
 363
 364   # "foo bar baz"
 365   Mojo::Collection->new('foo', 'bar', 'bar', 'baz')->uniq->join(' ');
 366
 367   # "[[1, 2], [2, 1]]"
 368   Mojo::Collection->new([1, 2], [2, 1], [3, 2])->uniq(sub{ $_->[1] })->to_array;
 369
 370 =head1 BUGS
 371
 372 Report any issues on the public bugtracker.
 373
 374 =head1 AUTHOR
 375
 376 Dan Book <dbook@cpan.org>
 377
 378 =head1 COPYRIGHT AND LICENSE
 379
 380 This software is Copyright (c) 2015 by Dan Book.
 381
 382 This is free software, licensed under:
 383
 384   The Artistic License 2.0 (GPL Compatible)
 385
 386 =head1 SEE ALSO
 387
 388 L<Mojo::Collection>