Revision f30b6f52
Von Sven Schöling vor mehr als 15 Jahren hinzugefügt
SL/MoreCommon.pm | ||
---|---|---|
3 | 3 |
require Exporter; |
4 | 4 |
@ISA = qw(Exporter); |
5 | 5 |
|
6 |
@EXPORT = qw(save_form restore_form compare_numbers any); |
|
6 |
@EXPORT = qw(save_form restore_form compare_numbers any cross);
|
|
7 | 7 |
|
8 | 8 |
use YAML; |
9 | 9 |
|
... | ... | |
85 | 85 |
return 0; |
86 | 86 |
} |
87 | 87 |
|
88 |
=item cross BLOCK ARRAY ARRAY |
|
89 |
|
|
90 |
Evaluates BLOCK for each combination of elements in ARRAY1 and ARRAY2 |
|
91 |
and returns a new list consisting of BLOCK's return values. |
|
92 |
The two elements are set to $a and $b. |
|
93 |
Note that those two are aliases to the original value so changing them |
|
94 |
will modify the input arrays. |
|
95 |
|
|
96 |
# append each to each |
|
97 |
@a = qw/a b c/; |
|
98 |
@b = qw/1 2 3/; |
|
99 |
@x = pairwise { "$a$b" } @a, @b; |
|
100 |
# returns a1, a2, a3, b1, b2, b3, c1, c2, c3 |
|
101 |
|
|
102 |
As cross expects an array but returns a list it is not directly chainable |
|
103 |
at the moment. This will be corrected in the future. |
|
104 |
|
|
105 |
=cut |
|
106 |
sub cross(&\@\@) { |
|
107 |
my $op = shift; |
|
108 |
use vars qw/@A @B/; |
|
109 |
local (*A, *B) = @_; # syms for caller's input arrays |
|
110 |
|
|
111 |
# Localise $a, $b |
|
112 |
my ($caller_a, $caller_b) = do { |
|
113 |
my $pkg = caller(); |
|
114 |
no strict 'refs'; |
|
115 |
\*{$pkg.'::a'}, \*{$pkg.'::b'}; |
|
116 |
}; |
|
117 |
|
|
118 |
local(*$caller_a, *$caller_b); |
|
119 |
|
|
120 |
# This map expression is also the return value. |
|
121 |
map { my $a_index = $_; |
|
122 |
map { my $b_index = $_; |
|
123 |
# assign to $a, $b as refs to caller's array elements |
|
124 |
(*$caller_a, *$caller_b) = \($A[$a_index], $B[$b_index]); |
|
125 |
$op->(); # perform the transformation |
|
126 |
} 0 .. $#B; |
|
127 |
} 0 .. $#A; |
|
128 |
} |
|
129 |
|
|
88 | 130 |
1; |
Auch abrufbar als: Unified diff
cross von common.pl nach MoreCommon verschoben.