Projekt

Allgemein

Profil

« Zurück | Weiter » 

Revision 683f1b3d

Von Sven Schöling vor mehr als 13 Jahren hinzugefügt

  • ID 683f1b3d0873f9add78b3a383b48b48050cdb1ad
  • Vorgänger 914c56f4
  • Nachfolger 8a149188

Update auf List::MoreUtils v0.30

Unterschiede anzeigen:

modules/fallback/List/MoreUtils.pm
2 2

  
3 3
use 5.00503;
4 4
use strict;
5
use Exporter   ();
6
use DynaLoader ();
7

  
8
use vars qw{ $VERSION @ISA @EXPORT_OK %EXPORT_TAGS };
9
BEGIN {
10
    $VERSION   = '0.30';
11
    @ISA       = qw{ Exporter DynaLoader };
12
    @EXPORT_OK = qw{
13
        any all none notall true false
14
        firstidx first_index lastidx last_index
15
        insert_after insert_after_string
16
        apply indexes
17
        after after_incl before before_incl
18
        firstval first_value lastval last_value
19
        each_array each_arrayref
20
        pairwise natatime
21
        mesh zip uniq distinct
22
        minmax part
23
    };
24
    %EXPORT_TAGS = (
25
        all => \@EXPORT_OK,
26
    );
5 27

  
6
require Exporter;
7
require DynaLoader;
8

  
28
    # Load the XS at compile-time so that redefinition warnings will be
29
    # thrown correctly if the XS versions of part or indexes loaded
30
    eval {
31
        # PERL_DL_NONLAZY must be false, or any errors in loading will just
32
        # cause the perl code to be tested
33
        local $ENV{PERL_DL_NONLAZY} = 0 if $ENV{PERL_DL_NONLAZY};
9 34

  
10
use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS);
11
@ISA = qw(Exporter DynaLoader);
35
        bootstrap List::MoreUtils $VERSION;
36
        1;
12 37

  
13
%EXPORT_TAGS = ( 
14
    all => [ qw(any all none notall true false firstidx first_index lastidx
15
		last_index insert_after insert_after_string apply after after_incl before
16
		before_incl indexes firstval first_value lastval last_value each_array
17
		each_arrayref pairwise natatime mesh zip uniq minmax part bsearch) ],
18
);
38
    } unless $ENV{LIST_MOREUTILS_PP};
39
}
19 40

  
20
@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
41
# Always use Perl apply() until memory leaks are resolved.
42
sub apply (&@) {
43
    my $action = shift;
44
    &$action foreach my @values = @_;
45
    wantarray ? @values : $values[-1];
46
}
21 47

  
22
$VERSION = '0.25_02';
48
# Always use Perl part() until memory leaks are resolved.
49
sub part (&@) {
50
    my ($code, @list) = @_;
51
    my @parts;
52
    push @{ $parts[ $code->($_) ] }, $_  foreach @list;
53
    return @parts;
54
}
23 55

  
24
eval {
25
    local $ENV{PERL_DL_NONLAZY} = 0 if $ENV{PERL_DL_NONLAZY};
26
    bootstrap List::MoreUtils $VERSION;
27
    1;
28
} if not $ENV{LIST_MOREUTILS_PP};
56
# Always use Perl indexes() until memory leaks are resolved.
57
sub indexes (&@) {
58
    my $test = shift;
59
    grep {
60
        local *_ = \$_[$_];
61
        $test->()
62
    } 0 .. $#_;
63
}
29 64

  
30
eval <<'EOP' if not defined &any;
65
# Load the pure-Perl versions of the other functions if needed
66
eval <<'END_PERL' unless defined &any;
31 67

  
32
require POSIX;
68
# Use pure scalar boolean return values for compatibility with XS
69
use constant YES => ! 0;
70
use constant NO  => ! 1;
33 71

  
34 72
sub any (&@) {
35 73
    my $f = shift;
36
    return if ! @_;
37
    for (@_) {
38
	return 1 if $f->();
74
    foreach ( @_ ) {
75
        return YES if $f->();
39 76
    }
40
    return 0;
77
    return NO;
41 78
}
42
    
79

  
43 80
sub all (&@) {
44 81
    my $f = shift;
45
    return if ! @_;
46
    for (@_) {
47
	return 0 if ! $f->();
82
    foreach ( @_ ) {
83
        return NO unless $f->();
48 84
    }
49
    return 1;
85
    return YES;
50 86
}
51 87

  
52 88
sub none (&@) {
53 89
    my $f = shift;
54
    return 1 if ! @_;
55
    for (@_) {
56
	return 0 if $f->();
90
    foreach ( @_ ) {
91
        return NO if $f->();
57 92
    }
58
    return 1;
93
    return YES;
59 94
}
60 95

  
61 96
sub notall (&@) {
62 97
    my $f = shift;
63
    return if ! @_;
64
    for (@_) {
65
	return 1 if ! $f->();
98
    foreach ( @_ ) {
99
        return YES unless $f->();
66 100
    }
67
    return 0;
101
    return NO;
68 102
}
69 103

  
70 104
sub true (&@) {
71
    my $f = shift;
105
    my $f     = shift;
72 106
    my $count = 0;
73
    for (@_) {
74
	$count++ if $f->();
107
    foreach ( @_ ) {
108
        $count++ if $f->();
75 109
    }
76 110
    return $count;
77 111
}
78 112

  
79 113
sub false (&@) {
80
    my $f = shift;
114
    my $f     = shift;
81 115
    my $count = 0;
82
    for (@_) {
83
	$count++ if ! $f->();
116
    foreach ( @_ ) {
117
        $count++ unless $f->();
84 118
    }
85 119
    return $count;
86 120
}
87 121

  
88 122
sub firstidx (&@) {
89 123
    my $f = shift;
90
    for my $i (0 .. $#_) {
91
	local *_ = \$_[$i];	
92
	return $i if $f->();
124
    foreach my $i ( 0 .. $#_ ) {
125
        local *_ = \$_[$i];
126
        return $i if $f->();
93 127
    }
94 128
    return -1;
95 129
}
96 130

  
97 131
sub lastidx (&@) {
98 132
    my $f = shift;
99
    for my $i (reverse 0 .. $#_) {
100
	local *_ = \$_[$i];
101
	return $i if $f->();
133
    foreach my $i ( reverse 0 .. $#_ ) {
134
        local *_ = \$_[$i];
135
        return $i if $f->();
102 136
    }
103 137
    return -1;
104 138
}
105 139

  
106 140
sub insert_after (&$\@) {
107
    my ($code, $val, $list) = @_;
141
    my ($f, $val, $list) = @_;
108 142
    my $c = -1;
109 143
    local *_;
110
    for my $i (0 .. $#$list) {
111
	$_ = $list->[$i];
112
	$c = $i, last if $code->();
144
    foreach my $i ( 0 .. $#$list ) {
145
        $_ = $list->[$i];
146
        $c = $i, last if $f->();
113 147
    }
114
    @$list = (@{$list}[0..$c], $val, @{$list}[$c+1..$#$list]) and return 1 if $c != -1;
148
    @$list = (
149
        @{$list}[ 0 .. $c ],
150
        $val,
151
        @{$list}[ $c + 1 .. $#$list ],
152
    ) and return 1 if $c != -1;
115 153
    return 0;
116 154
}
117 155

  
118 156
sub insert_after_string ($$\@) {
119 157
    my ($string, $val, $list) = @_;
120 158
    my $c = -1;
121
    for my $i (0 .. $#$list) {
122
	local $^W = 0;
123
	$c = $i, last if $string eq $list->[$i];
159
    foreach my $i ( 0 .. $#$list ) {
160
        local $^W = 0;
161
        $c = $i, last if $string eq $list->[$i];
124 162
    }
125
    @$list = (@{$list}[0..$c], $val, @{$list}[$c+1..$#$list]) and return 1 if $c != -1;
163
    @$list = (
164
        @{$list}[ 0 .. $c ],
165
        $val,
166
        @{$list}[ $c + 1 .. $#$list ],
167
    ) and return 1 if $c != -1;
126 168
    return 0;
127 169
}
128 170

  
129
sub apply (&@) {
130
    my $action = shift;
131
    &$action for my @values = @_;
132
    wantarray ? @values : $values[-1];
133
}
134

  
135
sub after (&@)
136
{
171
sub after (&@) {
137 172
    my $test = shift;
138 173
    my $started;
139 174
    my $lag;
140
    grep $started ||= do { my $x=$lag; $lag=$test->(); $x},  @_;
175
    grep $started ||= do {
176
        my $x = $lag;
177
        $lag = $test->();
178
        $x
179
    }, @_;
141 180
}
142 181

  
143
sub after_incl (&@)
144
{
182
sub after_incl (&@) {
145 183
    my $test = shift;
146 184
    my $started;
147 185
    grep $started ||= $test->(), @_;
148 186
}
149 187

  
150
sub before (&@)
151
{
188
sub before (&@) {
152 189
    my $test = shift;
153
    my $keepgoing=1;
154
    grep $keepgoing &&= !$test->(),  @_;
190
    my $more = 1;
191
    grep $more &&= ! $test->(), @_;
155 192
}
156 193

  
157
sub before_incl (&@)
158
{
194
sub before_incl (&@) {
159 195
    my $test = shift;
160
    my $keepgoing=1;
161
    my $lag=1;
162
    grep $keepgoing &&= do { my $x=$lag; $lag=!$test->(); $x},  @_;
196
    my $more = 1;
197
    my $lag  = 1;
198
    grep $more &&= do {
199
        my $x = $lag;
200
        $lag = ! $test->();
201
        $x
202
    }, @_;
163 203
}
164 204

  
165
sub indexes (&@)
166
{
167
    my $test = shift;
168
    grep {local *_=\$_[$_]; $test->()} 0..$#_;
169
}
170

  
171
sub lastval (&@)
172
{
205
sub lastval (&@) {
173 206
    my $test = shift;
174 207
    my $ix;
175
    for ($ix=$#_; $ix>=0; $ix--)
176
    {
208
    for ( $ix = $#_; $ix >= 0; $ix-- ) {
177 209
        local *_ = \$_[$ix];
178 210
        my $testval = $test->();
179
        $_[$ix] = $_;    # simulate $_ as alias
211

  
212
        # Simulate $_ as alias
213
        $_[$ix] = $_;
180 214
        return $_ if $testval;
181 215
    }
182 216
    return undef;
183 217
}
184 218

  
185
sub firstval (&@)
186
{
219
sub firstval (&@) {
187 220
    my $test = shift;
188
    foreach (@_)
189
    {
221
    foreach ( @_ ) {
190 222
        return $_ if $test->();
191 223
    }
192 224
    return undef;
193 225
}
194 226

  
195
sub pairwise(&\@\@)
196
{
227
sub pairwise (&\@\@) {
197 228
    my $op = shift;
198
    use vars qw/@A @B/;
199
    local (*A, *B) = @_;    # syms for caller's input arrays
229

  
230
    # Symbols for caller's input arrays
231
    use vars qw{ @A @B };
232
    local ( *A, *B ) = @_;
200 233

  
201 234
    # Localise $a, $b
202
    my ($caller_a, $caller_b) = do
203
    {
235
    my ( $caller_a, $caller_b ) = do {
204 236
        my $pkg = caller();
205 237
        no strict 'refs';
206 238
        \*{$pkg.'::a'}, \*{$pkg.'::b'};
207 239
    };
208 240

  
209
    my $limit = $#A > $#B? $#A : $#B;    # loop iteration limit
241
    # Loop iteration limit
242
    my $limit = $#A > $#B? $#A : $#B;
210 243

  
211
    local(*$caller_a, *$caller_b);
212
    map    # This map expression is also the return value.
213
    {
214
        # assign to $a, $b as refs to caller's array elements
215
        (*$caller_a, *$caller_b) = \($A[$_], $B[$_]);
216
        $op->();    # perform the transformation
244
    # This map expression is also the return value
245
    local( *$caller_a, *$caller_b );
246
    map {
247
        # Assign to $a, $b as refs to caller's array elements
248
        ( *$caller_a, *$caller_b ) = \( $A[$_], $B[$_] );
249

  
250
        # Perform the transformation
251
        $op->();
217 252
    }  0 .. $limit;
218 253
}
219 254

  
220
sub each_array (\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@)
221
{
255
sub each_array (\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@) {
222 256
    return each_arrayref(@_);
223 257
}
224 258

  
225
sub each_arrayref
226
{
227
    my @arr_list  = @_;     # The list of references to the arrays
228
    my $index     = 0;      # Which one the caller will get next
229
    my $max_num   = 0;      # Number of elements in longest array
259
sub each_arrayref {
260
    my @list  = @_; # The list of references to the arrays
261
    my $index = 0;  # Which one the caller will get next
262
    my $max   = 0;  # Number of elements in longest array
230 263

  
231 264
    # Get the length of the longest input array
232
    foreach (@arr_list)
233
    {
234
        unless (ref($_) eq 'ARRAY')
235
        {
265
    foreach ( @list ) {
266
        unless ( ref $_ eq 'ARRAY' ) {
236 267
            require Carp;
237
            Carp::croak "each_arrayref: argument is not an array reference\n";
268
            Carp::croak("each_arrayref: argument is not an array reference\n");
238 269
        }
239
        $max_num = @$_  if @$_ > $max_num;
270
        $max = @$_ if @$_ > $max;
240 271
    }
241 272

  
242 273
    # Return the iterator as a closure wrt the above variables.
243
    return sub
244
    {
245
        if (@_)
246
        {
274
    return sub {
275
        if ( @_ ) {
247 276
            my $method = shift;
248
            if ($method eq 'index')
249
            {
250
                # Return current (last fetched) index
251
                return undef if $index == 0  ||  $index > $max_num;
252
                return $index-1;
253
            }
254
            else
255
            {
277
            unless ( $method eq 'index' ) {
256 278
                require Carp;
257
                Carp::croak "each_array: unknown argument '$method' passed to iterator.";
279
                Carp::croak("each_array: unknown argument '$method' passed to iterator.");
258 280
            }
281

  
282
            # Return current (last fetched) index
283
            return undef if $index == 0  ||  $index > $max;
284
            return $index - 1;
259 285
        }
260 286

  
261
        return if $index >= $max_num;     # No more elements to return
287
        # No more elements to return
288
        return if $index >= $max;
262 289
        my $i = $index++;
263
        return map $_->[$i], @arr_list;   # Return ith elements
290

  
291
        # Return ith elements
292
        return map $_->[$i], @list; 
264 293
    }
265 294
}
266 295

  
267
sub natatime ($@)
268
{
269
    my $n = shift;
296
sub natatime ($@) {
297
    my $n    = shift;
270 298
    my @list = @_;
271

  
272
    return sub
273
    {
299
    return sub {
274 300
        return splice @list, 0, $n;
275 301
    }
276 302
}
277 303

  
278 304
sub mesh (\@\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@) {
279 305
    my $max = -1;
280
    $max < $#$_  &&  ($max = $#$_)  for @_;
281

  
282
    map { my $ix = $_; map $_->[$ix], @_; } 0..$max; 
306
    $max < $#$_ && ( $max = $#$_ ) foreach @_;
307
    map {
308
        my $ix = $_;
309
        map $_->[$ix], @_;
310
    } 0 .. $max; 
283 311
}
284 312

  
285 313
sub uniq (@) {
286
    my %h;
287
    my $ref = \1;
288
    map { $h{defined $_ ? $_ : $ref}++ == 0 ? $_ : () } @_;
314
    my %seen = ();
315
    grep { not $seen{$_}++ } @_;
289 316
}
290 317

  
291 318
sub minmax (@) {
292
    return if ! @_;
319
    return unless @_;
293 320
    my $min = my $max = $_[0];
294 321

  
295
    for (my $i = 1; $i < @_; $i += 2) {
296
	if ($_[$i-1] <= $_[$i]) {
297
	    $min = $_[$i-1] if $min > $_[$i-1];
298
	    $max = $_[$i]   if $max < $_[$i];
299
	} else {
300
	    $min = $_[$i]   if $min > $_[$i];
301
	    $max = $_[$i-1] if $max < $_[$i-1];
302
	}
303
    }
304

  
305
    if (@_ & 1) {
306
	my $i = $#_;
307
	if ($_[$i-1] <= $_[$i]) {
308
	    $min = $_[$i-1] if $min > $_[$i-1];
309
	    $max = $_[$i]   if $max < $_[$i];
310
	} else {
311
	    $min = $_[$i]   if $min > $_[$i];
312
	    $max = $_[$i-1] if $max < $_[$i-1];
313
	}
322
    for ( my $i = 1; $i < @_; $i += 2 ) {
323
        if ( $_[$i-1] <= $_[$i] ) {
324
            $min = $_[$i-1] if $min > $_[$i-1];
325
            $max = $_[$i]   if $max < $_[$i];
326
        } else {
327
            $min = $_[$i]   if $min > $_[$i];
328
            $max = $_[$i-1] if $max < $_[$i-1];
329
        }
314 330
    }
315 331

  
316
    return ($min, $max);
317
}
318

  
319
sub part(&@) {
320
    my ($code, @list) = @_;
321
    my @parts;
322
    push @{ $parts[$code->($_)] }, $_  for @list;
323
    return @parts;
324
}
325

  
326
sub bsearch(&@) {
327
    my $code = shift;
328

  
329
    my $rc;
330
    my $i = 0;
331
    my $j = @_;
332
    do {
333
        my $k = int(($i + $j) / 2);
334

  
335
        return if $k >= @_;
336

  
337
        local *_ = \$_[$k];
338
        $rc = $code->();
339

  
340
        $rc == 0 and
341
            return wantarray ? $_ : 1;
342

  
343
        if ($rc < 0) {
344
            $i = $k + 1;
332
    if ( @_ & 1 ) {
333
        my $i = $#_;
334
        if ($_[$i-1] <= $_[$i]) {
335
            $min = $_[$i-1] if $min > $_[$i-1];
336
            $max = $_[$i]   if $max < $_[$i];
345 337
        } else {
346
            $j = $k - 1;
338
            $min = $_[$i]   if $min > $_[$i];
339
            $max = $_[$i-1] if $max < $_[$i-1];
347 340
        }
348
    } until $i > $j;
341
    }
349 342

  
350
    return;
343
    return ($min, $max);
351 344
}
352 345

  
353 346
sub _XScompiled {
354 347
    return 0;
355 348
}
356 349

  
357
EOP
350
END_PERL
358 351
die $@ if $@;
359 352

  
353
# Function aliases
360 354
*first_index = \&firstidx;
361
*last_index = \&lastidx;
355
*last_index  = \&lastidx;
362 356
*first_value = \&firstval;
363
*last_value = \&lastval;
364
*zip = \&mesh;
357
*last_value  = \&lastval;
358
*zip         = \&mesh;
359
*distinct    = \&uniq;
365 360

  
366 361
1;
362

  
367 363
__END__
368 364

  
365
=pod
366

  
369 367
=head1 NAME
370 368

  
371 369
List::MoreUtils - Provide the stuff missing in List::Util
372 370

  
373 371
=head1 SYNOPSIS
374 372

  
375
    use List::MoreUtils qw(any all none notall true false firstidx first_index 
376
                           lastidx last_index insert_after insert_after_string 
377
                           apply after after_incl before before_incl indexes 
378
                           firstval first_value lastval last_value each_array
379
                           each_arrayref pairwise natatime mesh zip uniq minmax);
373
    use List::MoreUtils qw{
374
        any all none notall true false
375
        firstidx first_index lastidx last_index
376
        insert_after insert_after_string
377
        apply indexes
378
        after after_incl before before_incl
379
        firstval first_value lastval last_value
380
        each_array each_arrayref
381
        pairwise natatime
382
        mesh zip uniq distinct minmax part
383
    };
380 384

  
381 385
=head1 DESCRIPTION
382 386

  
383
C<List::MoreUtils> provides some trivial but commonly needed functionality on lists
384
which is not going to go into C<List::Util>.
387
B<List::MoreUtils> provides some trivial but commonly needed functionality on
388
lists which is not going to go into L<List::Util>.
385 389

  
386 390
All of the below functions are implementable in only a couple of lines of Perl
387 391
code. Using the functions from this module however should give slightly better
......
397 401
BLOCK. Sets C<$_> for each item in LIST in turn:
398 402

  
399 403
    print "At least one value undefined"
400
        if any { !defined($_) } @list;
404
        if any { ! defined($_) } @list;
401 405

  
402
Returns false otherwise, or C<undef> if LIST is empty.
406
Returns false otherwise, or if LIST is empty.
403 407

  
404 408
=item all BLOCK LIST
405 409

  
......
409 413
    print "All items defined"
410 414
        if all { defined($_) } @list;
411 415

  
412
Returns false otherwise, or C<undef> if LIST is empty.
416
Returns false otherwise, or if LIST is empty.
413 417

  
414 418
=item none BLOCK LIST
415 419

  
416
Logically the negation of C<any>. Returns a true value if no item in LIST meets the
417
criterion given through BLOCK. Sets C<$_> for each item in LIST in turn:
420
Logically the negation of C<any>. Returns a true value if no item in LIST meets
421
the criterion given through BLOCK. Sets C<$_> for each item in LIST in turn:
418 422

  
419 423
    print "No value defined"
420 424
        if none { defined($_) } @list;
421 425

  
422
Returns false otherwise, or C<undef> if LIST is empty.
426
Returns false otherwise, or if LIST is empty.
423 427

  
424 428
=item notall BLOCK LIST
425 429

  
426
Logically the negation of C<all>. Returns a true value if not all items in LIST meet
427
the criterion given through BLOCK. Sets C<$_> for each item in LIST in turn:
430
Logically the negation of C<all>. Returns a true value if not all items in LIST
431
meet the criterion given through BLOCK. Sets C<$_> for each item in LIST in
432
turn:
428 433

  
429 434
    print "Not all values defined"
430 435
        if notall { defined($_) } @list;
431 436

  
432
Returns false otherwise, or C<undef> if LIST is empty.
437
Returns false otherwise, or if LIST is empty.
433 438

  
434 439
=item true BLOCK LIST
435 440

  
436
Counts the number of elements in LIST for which the criterion in BLOCK is true. Sets C<$_> for 
437
each item in LIST in turn:
441
Counts the number of elements in LIST for which the criterion in BLOCK is true.
442
Sets C<$_> for  each item in LIST in turn:
438 443

  
439 444
    printf "%i item(s) are defined", true { defined($_) } @list;
440 445

  
441 446
=item false BLOCK LIST
442 447

  
443
Counts the number of elements in LIST for which the criterion in BLOCK is false. Sets C<$_> for
444
each item in LIST in turn:
448
Counts the number of elements in LIST for which the criterion in BLOCK is false.
449
Sets C<$_> for each item in LIST in turn:
445 450

  
446 451
    printf "%i item(s) are not defined", false { defined($_) } @list;
447 452

  
......
449 454

  
450 455
=item first_index BLOCK LIST
451 456

  
452
Returns the index of the first element in LIST for which the criterion in BLOCK is true. Sets C<$_>
453
for each item in LIST in turn:
457
Returns the index of the first element in LIST for which the criterion in BLOCK
458
is true. Sets C<$_> for each item in LIST in turn:
454 459

  
455 460
    my @list = (1, 4, 3, 2, 4, 6);
456 461
    printf "item with index %i in list is 4", firstidx { $_ == 4 } @list;
......
465 470

  
466 471
=item last_index BLOCK LIST
467 472

  
468
Returns the index of the last element in LIST for which the criterion in BLOCK is true. Sets C<$_>
469
for each item in LIST in turn:
473
Returns the index of the last element in LIST for which the criterion in BLOCK
474
is true. Sets C<$_> for each item in LIST in turn:
470 475

  
471 476
    my @list = (1, 4, 3, 2, 4, 6);
472 477
    printf "item with index %i in list is 4", lastidx { $_ == 4 } @list;
......
479 484

  
480 485
=item insert_after BLOCK VALUE LIST
481 486

  
482
Inserts VALUE after the first item in LIST for which the criterion in BLOCK is true. Sets C<$_> for
483
each item in LIST in turn.
487
Inserts VALUE after the first item in LIST for which the criterion in BLOCK is
488
true. Sets C<$_> for each item in LIST in turn.
484 489

  
485 490
    my @list = qw/This is a list/;
486 491
    insert_after { $_ eq "a" } "longer" => @list;
......
517 522

  
518 523
    for (my @mult = @list) { $_ *= 2 }
519 524

  
525
=item before BLOCK LIST
526

  
527
Returns a list of values of LIST upto (and not including) the point where BLOCK
528
returns a true value. Sets C<$_> for each element in LIST in turn.
529

  
530
=item before_incl BLOCK LIST
531

  
532
Same as C<before> but also includes the element for which BLOCK is true.
533

  
520 534
=item after BLOCK LIST
521 535

  
522 536
Returns a list of the values of LIST after (and not including) the point
......
528 542

  
529 543
Same as C<after> but also inclues the element for which BLOCK is true.
530 544

  
531
=item before BLOCK LIST
532

  
533
Returns a list of values of LIST upto (and not including) the point where BLOCK
534
returns a true value. Sets C<$_> for each element in LIST in turn.
535

  
536
=item before_incl BLOCK LIST
537

  
538
Same as C<before> but also includes the element for which BLOCK is true.
539

  
540 545
=item indexes BLOCK LIST
541 546

  
542 547
Evaluates BLOCK for each element in LIST (assigned to C<$_>) and returns a list
......
646 651

  
647 652
=item uniq LIST
648 653

  
654
=item distinct LIST
655

  
649 656
Returns a new list by stripping duplicate values in LIST. The order of
650 657
elements in the returned list is the same as in LIST. In scalar context,
651 658
returns the number of unique elements in LIST.
......
656 663
=item minmax LIST
657 664

  
658 665
Calculates the minimum and maximum of LIST and returns a two element list with
659
the first element being the minimum and the second the maximum. Returns the empty
660
list if LIST was empty.
666
the first element being the minimum and the second the maximum. Returns the
667
empty list if LIST was empty.
661 668

  
662
The minmax algorithm differs from a naive iteration over the list where each element
663
is compared to two values being the so far calculated min and max value in that it
664
only requires 3n/2 - 2 comparisons. Thus it is the most efficient possible algorithm.
669
The C<minmax> algorithm differs from a naive iteration over the list where each
670
element is compared to two values being the so far calculated min and max value
671
in that it only requires 3n/2 - 2 comparisons. Thus it is the most efficient
672
possible algorithm.
665 673

  
666 674
However, the Perl implementation of it has some overhead simply due to the fact
667 675
that there are more lines of Perl code involved. Therefore, LIST needs to be
668
fairly big in order for minmax to win over a naive implementation. This
676
fairly big in order for C<minmax> to win over a naive implementation. This
669 677
limitation does not apply to the XS version.
670 678

  
671 679
=item part BLOCK LIST
672 680

  
673
Partitions LIST based on the return value of BLOCK which denotes into which partition
674
the current value is put.
681
Partitions LIST based on the return value of BLOCK which denotes into which
682
partition the current value is put.
675 683

  
676 684
Returns a list of the partitions thusly created. Each partition created is a
677 685
reference to an array.
......
692 700

  
693 701
Negative values are only ok when they refer to a partition previously created:
694 702

  
695
    my @idx = (0, 1, -1);
696
    my $i = 0;
697
    my @part = part { $idx[$++ % 3] } 1 .. 8;	# [1, 4, 7], [2, 3, 5, 6, 8]
698

  
699
=item bsearch BLOCK LIST
700

  
701
Performs a binary search on LIST which must be a sorted list of values. BLOCK
702
must return a negative value if the current element (stored in C<$_>) is smaller,
703
a positive value if it is bigger and zero if it matches.
704

  
705
Returns a boolean value in scalar context. In list context, it returns the element
706
if it was found, otherwise the empty list.
703
    my @idx  = ( 0, 1, -1 );
704
    my $i    = 0;
705
    my @part = part { $idx[$++ % 3] } 1 .. 8; # [1, 4, 7], [2, 3, 5, 6, 8]
707 706

  
708 707
=back
709 708

  
......
711 710

  
712 711
Nothing by default. To import all of this module's symbols, do the conventional
713 712

  
714
    use List::MoreUtils qw/:all/;
713
    use List::MoreUtils ':all';
715 714

  
716
It may make more sense though to only import the stuff your program actually needs:
715
It may make more sense though to only import the stuff your program actually
716
needs:
717 717

  
718
    use List::MoreUtils qw/any firstidx/;
718
    use List::MoreUtils qw{ any firstidx };
719 719

  
720 720
=head1 ENVIRONMENT
721 721

  
......
725 725
for reporting of bugs. I don't see any reason to use it in a production
726 726
environment.
727 727

  
728
=head1 VERSION
729

  
730
This is version 0.25_01.
731

  
732 728
=head1 BUGS
733 729

  
734 730
There is a problem with a bug in 5.6.x perls. It is a syntax error to write
735 731
things like:
736 732

  
737
    my @x = apply { s/foo/bar/ } qw/foo bar baz/;
733
    my @x = apply { s/foo/bar/ } qw{ foo bar baz };
738 734

  
739 735
It has to be written as either
740 736

  
......
744 740

  
745 741
    my @x = apply { s/foo/bar/ } my @dummy = qw/foo bar baz/;
746 742

  
747
Perl5.5.x and perl5.8.x don't suffer from this limitation.
743
Perl 5.5.x and Perl 5.8.x don't suffer from this limitation.
748 744

  
749 745
If you have a functionality that you could imagine being in this module, please
750
drop me a line. This module's policy will be less strict than C<List::Util>'s when
751
it comes to additions as it isn't a core module.
746
drop me a line. This module's policy will be less strict than L<List::Util>'s
747
when it comes to additions as it isn't a core module.
752 748

  
753 749
When you report bugs, it would be nice if you could additionally give me the
754 750
output of your program with the environment variable C<LIST_MOREUTILS_PP> set
755 751
to a true value. That way I know where to look for the problem (in XS,
756 752
pure-Perl or possibly both).
757 753

  
754
=head1 SUPPORT
755

  
756
Bugs should always be submitted via the CPAN bug tracker.
757

  
758
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=List-MoreUtils>
759

  
758 760
=head1 THANKS
759 761

  
760 762
Credits go to a number of people: Steve Purkis for giving me namespace advice
761 763
and James Keenan and Terrence Branno for their effort of keeping the CPAN
762
tidier by making List::Utils obsolete. 
764
tidier by making L<List::Utils> obsolete. 
763 765

  
764 766
Brian McCauley suggested the inclusion of apply() and provided the pure-Perl
765 767
implementation for it.
......
788 790

  
789 791
=head1 TODO
790 792

  
791
A pile of requests from other people is still pending further processing in my
792
mailbox. This includes:
793
A pile of requests from other people is still pending further processing in
794
my mailbox. This includes:
793 795

  
794 796
=over 4
795 797

  
798
=item * List::Util export pass-through
799

  
800
Allow B<List::MoreUtils> to pass-through the regular L<List::Util>
801
functions to end users only need to C<use> the one module.
802

  
796 803
=item * uniq_by(&@)
797 804

  
798 805
Use code-reference to extract a key based on which the uniqueness is
......
816 823

  
817 824
=item * listify
818 825

  
819
Always return a flat list when either a simple scalar value was passed or an array-reference.
820
Suggested by Mark Summersault.
826
Always return a flat list when either a simple scalar value was passed or an
827
array-reference. Suggested by Mark Summersault.
821 828

  
822 829
=back
823 830

  
......
827 834

  
828 835
=head1 AUTHOR
829 836

  
830
Tassilo von Parseval, E<lt>vparseval@gmail.comE<gt>
837
Tassilo von Parseval E<lt>tassilo.von.parseval@rwth-aachen.deE<gt>
831 838

  
832 839
=head1 COPYRIGHT AND LICENSE
833 840

  
834
Copyright (C) 2004-2009 by Tassilo von Parseval
841
Copyright 2004 - 2010 by Tassilo von Parseval
835 842

  
836 843
This library is free software; you can redistribute it and/or modify
837 844
it under the same terms as Perl itself, either Perl version 5.8.4 or,

Auch abrufbar als: Unified diff