add maphash to the array wrapper
[bse.git] / site / cgi-bin / modules / Squirrel / Template / Expr / WrapArray.pm
1 package Squirrel::Template::Expr::WrapArray;
2 use strict;
3 use base qw(Squirrel::Template::Expr::WrapBase);
4 use Scalar::Util ();
5 use List::Util ();
6
7 our $VERSION = "1.011";
8
9 my $list_make_key = sub {
10   my ($item, $field) = @_;
11
12   if (Scalar::Util::blessed($item)) {
13     return $item->can($field) ? $item->$field() : "";
14   }
15   else {
16     return exists $item->{$field} ? $item->{$field} : "";
17   }
18 };
19
20 sub _do_size {
21   my ($self, $args) = @_;
22
23   @$args == 0
24     or die [ error => "list.size takes no parameters" ];
25
26   return scalar @{$self->[0]};
27 }
28
29 sub _do_sort {
30   my ($self, $args) = @_;
31
32   @{$self->[0]} <= 1
33     and return [ @{$self->[0]} ]; # nothing to sort
34
35   if (@$args == 0) {
36     return [ sort @{$self->[0]} ];
37   }
38   elsif (@$args == 1) {
39     if (ref $args->[0]) {
40       my $eval = $self->expreval;
41       return
42         [
43          sort {
44            $eval->call_function($args->[0], [ $a, $b ])
45          } @{$self->[0]}
46         ];
47     }
48     else {
49       my $key = $args->[0];
50       return 
51         [
52          sort {
53            $list_make_key->($a, $key) cmp $list_make_key->($b, $key)
54          } @{$self->[0]}
55         ];
56     }
57   }
58   else {
59     die [ error => "list.sort takes 0 or 1 parameters" ];
60   }
61 }
62
63 sub _do_reverse {
64   my ($self, $args) = @_;
65
66   @$args == 0
67     or die [ error => "list.reverse takes no parameters" ];
68
69   return [ reverse @{$self->[0]} ];
70 }
71
72 sub _do_shuffle {
73   my ($self, $args) = @_;
74
75   @$args == 0
76     or die [ error => "list.shuffle takes no parameters" ];
77
78   return [ List::Util::shuffle(@{$self->[0]}) ];
79 }
80
81 sub _do_join {
82   my ($self, $args) = @_;
83
84   my $join = @$args ? $args->[0] : "";
85
86   return join($join, @{$self->[0]});
87 }
88
89 sub _do_last {
90   my ($self, $args) = @_;
91
92   @$args == 0
93     or die [ error => "list.last takes no parameters" ];
94
95   return @{$self->[0]} ? $self->[0][-1] : ();
96 }
97
98 sub _do_first {
99   my ($self, $args) = @_;
100
101   @$args == 0
102     or die [ error => "list.first takes no parameters" ];
103
104   return @{$self->[0]} ? $self->[0][0] : ();
105 }
106
107 sub _do_shift {
108   my ($self, $args) = @_;
109
110   @$args == 0
111     or die [ error => "list.shift takes no parameters" ];
112
113   return shift @{$self->[0]};
114 }
115
116 sub _do_pop {
117   my ($self, $args) = @_;
118
119   @$args == 0
120     or die [ error => "list.pop takes no parameters" ];
121
122   return pop @{$self->[0]};
123 }
124
125 sub _do_push {
126   my ($self, $args) = @_;
127
128   push @{$self->[0]}, @$args;
129
130   return scalar(@{$self->[0]});
131 }
132
133 sub _do_unshift {
134   my ($self, $args) = @_;
135
136   unshift @{$self->[0]}, @$args;
137
138   return scalar(@{$self->[0]});
139 }
140
141 sub _do_expand {
142   my ($self, $args) = @_;
143
144   @$args == 0
145     or die [ error => "list.expand takes no parameters" ];
146
147   return 
148     [ map {
149       defined 
150         && ref
151           && !Scalar::Util::blessed($_)
152             && Scalar::Util::reftype($_) eq 'ARRAY'
153               ? @$_
154                 : $_
155     } @{$self->[0]} ];
156 }
157
158 sub _do_is_list {
159   return 1;
160 }
161
162 sub _do_is_hash {
163   return 0;
164 }
165
166 sub _do_is_code {
167   return 0;
168 }
169
170 sub _do_defined {
171   return 1;
172 }
173
174 sub _do_set {
175   my ($self, $args) = @_;
176
177   @$args == 2
178     or die [ error => "list.set takes two parameters" ];
179
180   $self->[0][$args->[0]] = $args->[1];
181
182   return $args->[1];
183 }
184
185 sub _do_as_hash {
186   my ($self, $args) = @_;
187
188   @$args == 0
189     or die [ error => "list.as_hash takes no parameters" ];
190
191   my @extra = @{$self->[0]} % 2 ? ( undef ) : ();
192
193   return +{ @{$self->[0]}, @extra };
194 }
195
196 sub _do_grep {
197   my ($self, $args) = @_;
198
199   my $eval = $self->expreval;
200   return
201     [
202      grep $eval->call_function($args->[0], [ $_ ]),
203      @{$self->[0]}
204     ];
205 }
206
207 sub _do_map {
208   my ($self, $args) = @_;
209
210   my $eval = $self->expreval;
211   return
212     [
213      map $eval->call_function($args->[0], [ $_ ]),
214      @{$self->[0]}
215     ];
216 }
217
218 sub _do_maphash {
219   my ($self, $args) = @_;
220
221    @$args <= 2
222      or die [ error => "list.maphash requires 0 to 2 parameters" ];
223
224   if (@$args) {
225     my $id = $args->[0];
226     my $value = @$args > 1 ? $args->[1] : undef;
227
228     my $eval = $self->expreval;
229     if (ref $id) {
230       if (defined $value) {
231         if (ref $value) {
232           return +{
233                    map {
234                      scalar($eval->call_function($id, [ $_ ])) =>
235                        scalar($eval->call_function($value, [ $_ ]))
236                      } @{$self->[0]}
237                   };
238         }
239         else {
240           return +{
241                    map {
242                      scalar($eval->call_function($id), [ $_ ]) =>
243                        scalar($list_make_key->($_, $value))
244                      } @{$self->[0]}
245                   };
246         }
247       }
248       else {
249         return +{
250                  map {
251                    scalar($eval->call_function($id), [ $_ ]) => $_
252                  } @{$self->[0]}
253                 };
254       }
255     }
256     else {
257       if (defined $value) {
258         if (ref $value) {
259           return +{
260                    map {
261                      scalar($list_make_key->($_, $id)) =>
262                        scalar($eval->call_function($value, [ $_ ]))
263                      } @{$self->[0]}
264                   };
265         }
266         else {
267           return +{
268                    map {
269                      scalar($list_make_key->($_, $id)) =>
270                        scalar($list_make_key->($_, $value))
271                      } @{$self->[0]}
272                   };
273         }
274       }
275       else {
276         return +{
277                  map {
278                    scalar($list_make_key->($_, $id)) => $_
279                  } @{$self->[0]}
280                 };
281       }
282     }
283   }
284   else {
285     return +{ map {$_ => 1} @{$self->[0]} };
286   }
287 }
288
289 sub _do_slice {
290   my ($self, $args) = @_;
291
292   my @result;
293   if (@$args == 1 && Scalar::Util::reftype($args->[0]) eq "ARRAY") {
294     @result = @{$self->[0]}[@{$args->[0]}];
295   }
296   else {
297     @result = @{$self->[0]}[@$args];
298   }
299
300   return \@result;
301 }
302
303 sub _do_splice {
304   my ($self, $args) = @_;
305
306   @$args >= 1 && @$args <= 3
307     or die [ error => "list.splice() requires 1 to 3 parameters" ];
308   my $offset = $args->[0];
309   $offset < 0 and $offset = @{$self->[0]} + $offset;
310   my $len = @$args >= 2 ? $args->[1] : @{$self->[0]} - $offset;
311   my $replace = [];
312   if (@$args >= 3) {
313     Scalar::Util::reftype($args->[2]) eq "ARRAY"
314       or die [ error => "list.splice() third argument must be a list" ];
315     $replace = $args->[2];
316   }
317
318   return [ splice(@{$self->[0]}, $offset, $len, @$replace) ];
319 }
320
321 sub call {
322   my ($self, $method, $args) = @_;
323
324   my $real_method = "_do_$method";
325   if ($self->can($real_method)) {
326     return $self->$real_method($args);
327   }
328   die [ error => "Unknown method $method for lists" ];
329 }
330
331 1;
332
333 __END__
334
335 =head1 NAME
336
337 Squirrel::Template::Expr::WrapArray - provide virtual methods for arrays
338
339 =head1 SYNOPSIS
340
341   somearray.size
342   sorted = somearray.sort()
343   sorted = somearray.sort(key)
344   reversed = somearray.reverse
345   joined = somearray.join()
346   joined = somearray.join(":")
347   last = somearray.last
348   first = somearray.first
349   first = somearray.shift # modifies somearray
350   somearray.push(avalue)
351   last = somearray.pop # modifies somearray
352   somearray.unshift(avalue)
353   somearray.is_list # always true
354   somearray.is_hash # always false
355   odd = somearray.grep(@{a: a mod 2 == 0 })
356   doubled = somearray.map(@{a: a * 2 })
357
358 =head1 DESCRIPTION
359
360 This class provides virtual methods for arrays (well, array
361 references) in L<Squirrel::Template>'s expression language.
362
363 =head1 METHODS
364
365 =over
366
367 =item size
368
369 The number of elements in the list.
370
371 =item sort()
372
373 The elements sorted by name.
374
375 =item sort(fieldname)
376
377 The elements sorted as objects calling C<fieldname>.
378
379 =item sort(block)
380
381 The elem
382
383 =item reversed
384
385 The elements in reverse order.
386
387 =item join()
388
389 A string with the elements concatenated together.
390
391 =item join(sep)
392
393 A string with the elements concatenated together, separated by C<sep>.
394
395 =item last
396
397 The last element in the array, or undef.
398
399 =item first
400
401 The first element in the array, or undef.
402
403 =item shift
404
405 Remove the first element from the list and return that.
406
407 =item push(element,...)
408
409 Add the given elements to the end of the array.  returns the new size
410 of the array.
411
412 =item pop
413
414 Remove the last element from the list and return that.
415
416 =item unshift(element,...)
417
418 Add the given elements to the start of the array.  returns the new
419 size of the array.
420
421 =item expand
422
423 Return a new array with any contained arrays expanded one level.
424
425   [ [ [ 1 ], 2 ], 3 ].expand => [ [ 1 ], 2, 3 ]
426
427 =item grep(block)
428
429 Return a new list containing only those elements that C<block> returns
430 true for.
431
432 =item map(block)
433
434 Return the list of return values from C<block> as applied to each
435 element.
436
437 =item set(index, value)
438
439 Set the specified I<index> in the array to I<value>.  Returns
440 I<value>.
441
442 =item splice(array_of_indexes)
443
444 =item splice(index1, index2, ...)
445
446 Return a selection of elements from the array as a new array specified
447 by index.  The indexes can be supplied either as an array:
448
449   [ "A" .. "Z" ].slice([ 0 .. 5 ]) # first 6 elements
450
451 or as separate arguments:
452
453   [ "A" .. "Z" ].slice(0, 1, -2, -1) # first 2 and last 2 elements
454
455 =item splice(start)
456
457 =item splice(start, count)
458
459 =item splice(start, count, replace)
460
461 Removes elements from an array, optionally inserting the elements in
462 the I<replace> aray in their place.
463
464 If I<count> is ommitted, all elements to the end of the array are
465 removed.
466
467 If I<replace> is omitted, the elements are simply removed.
468
469   <: .set foo = [ "A" .. "J" ] :>
470   <:= foo.splice(5).join("") :> # FGHIJ
471   <:= foo.join("") :>           # ABCDE since splice() modifies it's argument
472   <: .set bar = [ "A" .. "J" ] :>
473   <:= bar.splice(8, 2, [ "Y", "Z" ]).join("") :> # IJ
474   <:= bar.join("") :> # ABCDEFGHYZ
475
476 =item as_hash
477
478 Returns a hash formed as if the array was formed of key and value
479 pairs.  If the number of elements is odd, the value for the odd key is
480 C<undef>.
481
482  [ "a", 1, "b", 2 ].as_hash => { a:1, b:2 }
483
484 =item maphash
485
486 Returns a new hash with each item from the array as a key, and all values of 1.
487
488 This simiplifies turning a list of strings into an existence checking hash.
489
490   <:.set strs = [ "one", "two", "three" ] :>
491   <:.set strhash = strs.maphash :>
492   <:= strhash.exists["one"] :>   # 1
493   <:= strhash.exists["four"] :>  # (empty string)
494
495 =item maphash(key)
496
497 =item maphash(key, value)
498
499 Returns a new hash with the key and values derived from the elements
500 of the list.
501
502 Each I<key> and I<value> can be either an element name, treating the
503 array elements as hashes/objects, or a block.
504
505 If I<value> isn't supplied then the element from the array is used.
506
507   <:.set objs = [ { id: 1, firstn: "Tony", lastn: "Cook", note: "Programming Geek" },
508                   { id: 2, firstn: "Adrian", lastn: "Oldham", note: "Design Geek" } ] :>
509   <:.set byid = objs.maphash("id") :>
510   <:= byid[2]firstn :>   # Adrian
511   <:.set byname = objs.maphash(@{i: i.firstn _ " " _ i.lastn }) :>
512   <:= byname["Tony Cook"].note :>  # Programming Geek
513   <:=.set namebynote = objs.maphash(@{i: i.note.lower }, @{i: i.firstn _ " " _ i.lastn }) :>
514   <:= namebynote["design geek"] :>  # Adrian Oldham
515
516 =item is_list
517
518 Test if this object is a list.  Always true for a list.
519
520 =item is_hash
521
522 Test if this object is a hash.  Always false for a list.
523
524 =item is_code
525
526 Test if this object is a code object.  Always false for a list.
527
528 =item defined
529
530 Always true for arrays.
531
532 =back
533
534 =head1 SEE ALSO
535
536 L<Squirrel::Template::Expr>, L<Squirrel::Template>
537
538 =head1 AUTHOR
539
540 Tony Cook <tony@develop-help.com>
541
542 =cut