| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Array::Each::Override; | 
| 2 |  |  |  |  |  |  |  | 
| 3 | 6 |  |  | 6 |  | 237465 | use strict; | 
|  | 6 |  |  |  |  | 14 |  | 
|  | 6 |  |  |  |  | 249 |  | 
| 4 | 6 |  |  | 6 |  | 34 | use warnings; | 
|  | 6 |  |  |  |  | 9 |  | 
|  | 6 |  |  |  |  | 302 |  | 
| 5 |  |  |  |  |  |  |  | 
| 6 |  |  |  |  |  |  | our $VERSION = '0.04'; | 
| 7 | 6 |  |  | 6 |  | 43 | use base qw; | 
|  | 6 |  |  |  |  | 10 |  | 
|  | 6 |  |  |  |  | 1294 |  | 
| 8 |  |  |  |  |  |  |  | 
| 9 | 6 |  |  | 6 |  | 39 | use Scalar::Util qw; | 
|  | 6 |  |  |  |  | 1133 |  | 
|  | 6 |  |  |  |  | 868 |  | 
| 10 | 6 |  |  | 6 |  | 37 | use Carp qw; | 
|  | 6 |  |  |  |  | 17 |  | 
|  | 6 |  |  |  |  | 1201 |  | 
| 11 |  |  |  |  |  |  |  | 
| 12 |  |  |  |  |  |  | my @FUNCTIONS = qw; | 
| 13 |  |  |  |  |  |  | my %KNOWN_FUNCTION = map { ($_ => 1, "array_$_" => 1) } @FUNCTIONS; | 
| 14 |  |  |  |  |  |  |  | 
| 15 |  |  |  |  |  |  | __PACKAGE__->bootstrap($VERSION); | 
| 16 |  |  |  |  |  |  |  | 
| 17 |  |  |  |  |  |  | sub import { | 
| 18 | 10 |  |  | 10 |  | 7968 | my ($class, @imports) = @_; | 
| 19 | 10 |  |  |  |  | 26 | my $caller = caller; | 
| 20 | 10 |  |  |  |  | 36 | for my $export (_parse_import_list($caller, @imports)) { | 
| 21 | 22 |  |  |  |  | 52 | my ($dest, $name, $func) = @$export{qw}; | 
| 22 | 6 |  |  | 6 |  | 170 | no strict qw; | 
|  | 6 |  |  |  |  | 13 |  | 
|  | 6 |  |  |  |  | 21590 |  | 
| 23 | 22 |  |  |  |  | 28 | *{"$dest\::$name"} = $func; | 
|  | 22 |  |  |  |  | 8189 |  | 
| 24 |  |  |  |  |  |  | } | 
| 25 |  |  |  |  |  |  | } | 
| 26 |  |  |  |  |  |  |  | 
| 27 |  |  |  |  |  |  | sub unimport { | 
| 28 | 3 |  |  | 3 |  | 6221 | my ($package, @imports) = @_; | 
| 29 | 3 |  |  |  |  | 8 | my $caller = caller; | 
| 30 | 3 |  |  |  |  | 9 | for my $export (_parse_import_list($caller, @imports)) { | 
| 31 | 9 |  |  |  |  | 21 | my ($dest, $name, $func) = @$export{qw}; | 
| 32 | 6 |  |  | 6 |  | 48 | no strict qw; | 
|  | 6 |  |  |  |  | 12 |  | 
|  | 6 |  |  |  |  | 1878 |  | 
| 33 | 9 |  |  |  |  | 10 | delete ${"$dest\::"}{$name} | 
|  | 9 |  |  |  |  | 288 |  | 
| 34 |  |  |  |  |  |  | } | 
| 35 |  |  |  |  |  |  | } | 
| 36 |  |  |  |  |  |  |  | 
| 37 |  |  |  |  |  |  | sub _parse_import_list { | 
| 38 | 13 |  |  | 13 |  | 32 | my ($importer, @imports) = @_; | 
| 39 |  |  |  |  |  |  |  | 
| 40 | 13 |  |  |  |  | 28 | for my $name (@imports) { | 
| 41 | 10 | 50 | 100 |  |  | 106 | croak "Unknown function '$name'" | 
|  |  |  | 66 |  |  |  |  | 
| 42 |  |  |  |  |  |  | if !$KNOWN_FUNCTION{$name} | 
| 43 |  |  |  |  |  |  | && $name ne ':global' | 
| 44 |  |  |  |  |  |  | && $name ne ':safe'; | 
| 45 |  |  |  |  |  |  | } | 
| 46 |  |  |  |  |  |  |  | 
| 47 | 13 |  |  |  |  | 25 | my $mode = ''; | 
| 48 | 13 | 100 | 100 |  |  | 89 | $mode = shift @imports | 
| 49 |  |  |  |  |  |  | if @imports && $imports[0] =~ /\A :/xms; | 
| 50 |  |  |  |  |  |  |  | 
| 51 | 4 |  |  |  |  | 500 | croak ":global or :safe must be the first item in the import list" | 
| 52 | 13 | 100 |  |  |  | 42 | if grep { /^:/ } @imports; | 
| 53 |  |  |  |  |  |  |  | 
| 54 | 11 | 100 |  |  |  | 57 | @imports = @FUNCTIONS if !@imports; | 
| 55 |  |  |  |  |  |  |  | 
| 56 | 11 | 100 |  |  |  | 37 | $importer = 'CORE::GLOBAL' | 
| 57 |  |  |  |  |  |  | if $mode eq ':global'; | 
| 58 |  |  |  |  |  |  |  | 
| 59 | 31 |  |  |  |  | 110 | return map { | 
| 60 | 11 |  |  |  |  | 23 | (my $func_name = $_) =~ s/\A (?!array_)/array_/xms; | 
| 61 | 31 | 100 |  |  |  | 89 | $_ = $func_name if $mode eq ':safe'; | 
| 62 | 6 |  |  | 6 |  | 37 | my $func = do { no strict 'refs'; \&$func_name }; | 
|  | 6 |  |  |  |  | 11 |  | 
|  | 6 |  |  |  |  | 1029 |  | 
|  | 31 |  |  |  |  | 31 |  | 
|  | 31 |  |  |  |  | 65 |  | 
| 63 |  |  |  |  |  |  | +{ | 
| 64 | 31 |  |  |  |  | 140 | dest => $importer, | 
| 65 |  |  |  |  |  |  | func => $func, | 
| 66 |  |  |  |  |  |  | name => $_, | 
| 67 |  |  |  |  |  |  | }; | 
| 68 |  |  |  |  |  |  | } @imports; | 
| 69 |  |  |  |  |  |  | } | 
| 70 |  |  |  |  |  |  |  | 
| 71 |  |  |  |  |  |  | 1; | 
| 72 |  |  |  |  |  |  |  | 
| 73 |  |  |  |  |  |  | =head1 NAME | 
| 74 |  |  |  |  |  |  |  | 
| 75 |  |  |  |  |  |  | Array::Each::Override - C for iterating over an array's keys and values | 
| 76 |  |  |  |  |  |  |  | 
| 77 |  |  |  |  |  |  | =head1 SYNOPSIS | 
| 78 |  |  |  |  |  |  |  | 
| 79 |  |  |  |  |  |  | use Array::Each::Override; | 
| 80 |  |  |  |  |  |  |  | 
| 81 |  |  |  |  |  |  | my @array = get_data(); | 
| 82 |  |  |  |  |  |  | while (my ($i, $val) = each @array) { | 
| 83 |  |  |  |  |  |  | print "Position $i contains: $val\n"; | 
| 84 |  |  |  |  |  |  | } | 
| 85 |  |  |  |  |  |  |  | 
| 86 |  |  |  |  |  |  | =head1 DESCRIPTION | 
| 87 |  |  |  |  |  |  |  | 
| 88 |  |  |  |  |  |  | This module provides new implementations of three core functions: C, | 
| 89 |  |  |  |  |  |  | C, and C. | 
| 90 |  |  |  |  |  |  |  | 
| 91 |  |  |  |  |  |  | =over 4 | 
| 92 |  |  |  |  |  |  |  | 
| 93 |  |  |  |  |  |  | =item C | 
| 94 |  |  |  |  |  |  |  | 
| 95 |  |  |  |  |  |  | The core C function iterates over a hash; each time it's called, it | 
| 96 |  |  |  |  |  |  | returns a 2-element list of a key and value in the hash.  The new version of | 
| 97 |  |  |  |  |  |  | C does not change the behaviour of C when called on a hash. | 
| 98 |  |  |  |  |  |  | However, it also allows you to call C on array.  Each time it's called, | 
| 99 |  |  |  |  |  |  | it returns a 2-element list of the next uniterated index in the the array, and | 
| 100 |  |  |  |  |  |  | the value at that index. | 
| 101 |  |  |  |  |  |  |  | 
| 102 |  |  |  |  |  |  | When the array is entirely iterated, an empty list is returned in list context. | 
| 103 |  |  |  |  |  |  | The next call to array C after that will start iterating again. | 
| 104 |  |  |  |  |  |  |  | 
| 105 |  |  |  |  |  |  | =item C | 
| 106 |  |  |  |  |  |  |  | 
| 107 |  |  |  |  |  |  | The core C function returns a list of the keys in a hash, or a count of | 
| 108 |  |  |  |  |  |  | the keys in a hash when called in scalar context.  The new version of C | 
| 109 |  |  |  |  |  |  | does not change the behaviour of C when called on a hash.  However, it | 
| 110 |  |  |  |  |  |  | also allows you to call C on an array. | 
| 111 |  |  |  |  |  |  |  | 
| 112 |  |  |  |  |  |  | In list context, C returns a list of the indexes in the array; in | 
| 113 |  |  |  |  |  |  | scalar context, it returns the number of elements in the array. | 
| 114 |  |  |  |  |  |  |  | 
| 115 |  |  |  |  |  |  | =item C | 
| 116 |  |  |  |  |  |  |  | 
| 117 |  |  |  |  |  |  | The core C function returns a list of the values in a hash, or a count | 
| 118 |  |  |  |  |  |  | of the values in a hash when called in scalar context.  The new version of | 
| 119 |  |  |  |  |  |  | C does not change the behaviour of C when called on a hash. | 
| 120 |  |  |  |  |  |  | However, it also allows you to call C on an array. | 
| 121 |  |  |  |  |  |  |  | 
| 122 |  |  |  |  |  |  | In list context, C returns a list of the elements in the array; | 
| 123 |  |  |  |  |  |  | in scalar context, it returns the number of elements in the array. | 
| 124 |  |  |  |  |  |  |  | 
| 125 |  |  |  |  |  |  | =back | 
| 126 |  |  |  |  |  |  |  | 
| 127 |  |  |  |  |  |  | There is a single iterator for each array, shared by all C, C, and | 
| 128 |  |  |  |  |  |  | C calls in the program.  It can be reset by reading all the elements | 
| 129 |  |  |  |  |  |  | from the iterator with C, or by evaluating C or C | 
| 130 |  |  |  |  |  |  | @array>. | 
| 131 |  |  |  |  |  |  |  | 
| 132 |  |  |  |  |  |  | =head1 ALTERNATIVE NAMES | 
| 133 |  |  |  |  |  |  |  | 
| 134 |  |  |  |  |  |  | You may prefer not to change the core C, C, and C | 
| 135 |  |  |  |  |  |  | functions.  If so, you can import the new functions under alternative, | 
| 136 |  |  |  |  |  |  | noninvasive names: | 
| 137 |  |  |  |  |  |  |  | 
| 138 |  |  |  |  |  |  | use Array::Each::Override qw; | 
| 139 |  |  |  |  |  |  |  | 
| 140 |  |  |  |  |  |  | Or to import all of them in one go: | 
| 141 |  |  |  |  |  |  |  | 
| 142 |  |  |  |  |  |  | use Array::Each::Override qw<:safe>; | 
| 143 |  |  |  |  |  |  |  | 
| 144 |  |  |  |  |  |  | Or mix and match: | 
| 145 |  |  |  |  |  |  |  | 
| 146 |  |  |  |  |  |  | use Array::Each::Override qw; | 
| 147 |  |  |  |  |  |  |  | 
| 148 |  |  |  |  |  |  | The functions with these noninvasive names behave exactly the same as the | 
| 149 |  |  |  |  |  |  | overridden core functions. | 
| 150 |  |  |  |  |  |  |  | 
| 151 |  |  |  |  |  |  | You might alternatively prefer to make the new functions available to all parts | 
| 152 |  |  |  |  |  |  | of your program in one fell swoop: | 
| 153 |  |  |  |  |  |  |  | 
| 154 |  |  |  |  |  |  | use Array::Each::Override qw<:global>; | 
| 155 |  |  |  |  |  |  |  | 
| 156 |  |  |  |  |  |  | Or make just some of the functions global: | 
| 157 |  |  |  |  |  |  |  | 
| 158 |  |  |  |  |  |  | use Array::Each::Override qw<:global each keys>; | 
| 159 |  |  |  |  |  |  |  | 
| 160 |  |  |  |  |  |  | You can also unimport names.  For example, this removes the globally overridden | 
| 161 |  |  |  |  |  |  | functions: | 
| 162 |  |  |  |  |  |  |  | 
| 163 |  |  |  |  |  |  | no Array::Each::Override qw<:global>; | 
| 164 |  |  |  |  |  |  |  | 
| 165 |  |  |  |  |  |  | =head1 BUGS | 
| 166 |  |  |  |  |  |  |  | 
| 167 |  |  |  |  |  |  | =over 4 | 
| 168 |  |  |  |  |  |  |  | 
| 169 |  |  |  |  |  |  | =item * | 
| 170 |  |  |  |  |  |  |  | 
| 171 |  |  |  |  |  |  | If you set C<$[> to anything other than 0, then (a) please stop doing that, | 
| 172 |  |  |  |  |  |  | because it's been deprecated for a long time, and (b) C, C, and | 
| 173 |  |  |  |  |  |  | C on arrays probably don't do what you expect. | 
| 174 |  |  |  |  |  |  |  | 
| 175 |  |  |  |  |  |  | =item * | 
| 176 |  |  |  |  |  |  |  | 
| 177 |  |  |  |  |  |  | Importing and unimporting function names has an effect on your entire package, | 
| 178 |  |  |  |  |  |  | not just your lexical scope. | 
| 179 |  |  |  |  |  |  |  | 
| 180 |  |  |  |  |  |  | =item * | 
| 181 |  |  |  |  |  |  |  | 
| 182 |  |  |  |  |  |  | There may be some outstanding memory leaks. | 
| 183 |  |  |  |  |  |  |  | 
| 184 |  |  |  |  |  |  | =item * | 
| 185 |  |  |  |  |  |  |  | 
| 186 |  |  |  |  |  |  | Tied arrays haven't been tested at all. | 
| 187 |  |  |  |  |  |  |  | 
| 188 |  |  |  |  |  |  | =back | 
| 189 |  |  |  |  |  |  |  | 
| 190 |  |  |  |  |  |  | =head1 PERFORMANCE | 
| 191 |  |  |  |  |  |  |  | 
| 192 |  |  |  |  |  |  | There is some overhead for calling the new functions on a hash, compared to | 
| 193 |  |  |  |  |  |  | the standard core functions.  The approximate penalties in each case are as | 
| 194 |  |  |  |  |  |  | follows: | 
| 195 |  |  |  |  |  |  |  | 
| 196 |  |  |  |  |  |  | =over 4 | 
| 197 |  |  |  |  |  |  |  | 
| 198 |  |  |  |  |  |  | =item C | 
| 199 |  |  |  |  |  |  |  | 
| 200 |  |  |  |  |  |  | 20-25% | 
| 201 |  |  |  |  |  |  |  | 
| 202 |  |  |  |  |  |  | =item scalar-context C | 
| 203 |  |  |  |  |  |  |  | 
| 204 |  |  |  |  |  |  | 55-60% | 
| 205 |  |  |  |  |  |  |  | 
| 206 |  |  |  |  |  |  | =item scalar-context C | 
| 207 |  |  |  |  |  |  |  | 
| 208 |  |  |  |  |  |  | 60-65% | 
| 209 |  |  |  |  |  |  |  | 
| 210 |  |  |  |  |  |  | =item list-context C | 
| 211 |  |  |  |  |  |  |  | 
| 212 |  |  |  |  |  |  | 1% | 
| 213 |  |  |  |  |  |  |  | 
| 214 |  |  |  |  |  |  | =item list-context C | 
| 215 |  |  |  |  |  |  |  | 
| 216 |  |  |  |  |  |  | 1% | 
| 217 |  |  |  |  |  |  |  | 
| 218 |  |  |  |  |  |  | =back | 
| 219 |  |  |  |  |  |  |  | 
| 220 |  |  |  |  |  |  | If this performance penalty bothers you, use the C<:safe> function names | 
| 221 |  |  |  |  |  |  | instead. | 
| 222 |  |  |  |  |  |  |  | 
| 223 |  |  |  |  |  |  | =head1 SEE ALSO | 
| 224 |  |  |  |  |  |  |  | 
| 225 |  |  |  |  |  |  | L, L, L. | 
| 226 |  |  |  |  |  |  |  | 
| 227 |  |  |  |  |  |  | =head1 AUTHOR | 
| 228 |  |  |  |  |  |  |  | 
| 229 |  |  |  |  |  |  | Aaron Crane Earc@cpan.orgE | 
| 230 |  |  |  |  |  |  |  | 
| 231 |  |  |  |  |  |  | Thanks to Chia-Liang Kao for his help in getting this working. | 
| 232 |  |  |  |  |  |  |  | 
| 233 |  |  |  |  |  |  | =head1 COPYRIGHT | 
| 234 |  |  |  |  |  |  |  | 
| 235 |  |  |  |  |  |  | Copyright 2007 Aaron Crane. | 
| 236 |  |  |  |  |  |  |  | 
| 237 |  |  |  |  |  |  | This library is free software; you can redistribute it and/or modify it under | 
| 238 |  |  |  |  |  |  | the terms of the Artistic License, or (at your option) under the terms of the | 
| 239 |  |  |  |  |  |  | GNU General Public License version 2. | 
| 240 |  |  |  |  |  |  |  | 
| 241 |  |  |  |  |  |  | =cut |