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