/[cvs]/nfo/perl/libs/Iterate.pm
ViewVC logotype

Contents of /nfo/perl/libs/Iterate.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (show annotations)
Sat Sep 27 12:51:07 2003 UTC (21 years, 1 month ago) by jonen
Branch: MAIN
CVS Tags: HEAD
+ uploaded original from local perl-libs,
   because it cannot be found at internet (cpan.org, google.com) anymore!!

1 package Iterate;
2
3
4 =for
5 Iterate - Smart, Simple, Recursive Iterators for Perl programming.
6 Copyright (C) 2002 Greg London
7
8 This program is free software; you can redistribute it and/or modify
9 it under the same terms as Perl 5 itself.
10
11 This program is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 Perl 5 License schemes for more details.
15
16 contact the author via http://www.greglondon.com
17 =cut
18
19
20 require 5.005_62;
21 use strict;
22 use warnings;
23
24 use Carp;
25
26 require Exporter;
27
28 our @ISA = qw(Exporter);
29
30 # Items to export into callers namespace by default. Note: do not export
31 # names by default without a very good reason. Use EXPORT_OK instead.
32 # Do not simply export all your public functions/methods/constants.
33
34 our @EXPORT = qw(
35
36 IterArray
37 IterHash
38 IterFile
39
40 );
41 our $VERSION = '0.01';
42
43
44
45 ##############################################################################
46 sub IterArray(\@&)
47 ##############################################################################
48 {
49 my $arrayref = shift(@_);
50 my $callback = shift(@_);
51
52 my $index;
53 my @return;
54
55 my $wantarray = (defined(wantarray()) and wantarray()) ? 1 : 0;
56 #print "wantarray is $wantarray \n";
57
58 for(my $index=0; $index<scalar(@$arrayref); $index++)
59 {
60 if($wantarray)
61 {
62 push(@return, $callback->($arrayref->[$index], $index));
63 }
64 else
65 {
66 $callback->($arrayref->[$index], $index);
67 }
68 }
69 if($wantarray)
70 { return (@return); }
71 else
72 {return;}}
73
74
75
76 ##############################################################################
77 sub IterHash(\%&)
78 ##############################################################################
79 {
80 my $hashref = shift(@_);
81 my $callback = shift(@_);
82
83 my $arrayref = [keys(%$hashref)];
84 my $index;
85 my @return;
86
87 my $wantarray = (defined(wantarray()) and wantarray()) ? 1 : 0;
88 #print "wantarray is $wantarray \n";
89
90 for(my $index=0; $index<scalar(@$arrayref); $index++)
91 {
92 if($wantarray)
93 {
94 push(@return, $callback->($arrayref->[$index], $hashref->{$arrayref->[$index]}, $index));
95 }
96 else
97 {
98 $callback->($arrayref->[$index], $hashref->{$arrayref->[$index]}, $index);
99 }
100 }
101
102 if($wantarray)
103 { return (@return); }
104 else
105 {return;}
106 }
107
108
109
110 ##############################################################################
111 sub IterFile($&)
112 ##############################################################################
113 {
114 my $filename = shift(@_);
115 my $callback = shift(@_);
116
117 my @return;
118
119 my $wantarray = (defined(wantarray()) and wantarray()) ? 1 : 0;
120 #print "wantarray is $wantarray \n";
121
122 open ( my $filehandle, $filename ) or croak "Error: cannot open $filename";
123
124 my $linenumber=0;
125 while(<$filehandle>)
126 {
127 $linenumber++;
128 if($wantarray)
129 {
130 push(@return, $callback->($_, $linenumber));
131 }
132 else
133 {
134 $callback->($_, $linenumber);
135 }
136 }
137
138 close($filehandle) or croak "Error: cannot close $filename";
139 if($wantarray)
140 { return (@return); }
141 else
142 {return;}
143 }
144
145
146 1;
147 __END__
148
149 =head1 NAME
150
151 Iterate - Smart, Simple, Recursive Iterators for Perl programming.
152
153 =head1 SYNOPSIS
154
155 use Iterate;
156
157 # iterate an array, at index 3, change the value in the array to "three"
158 my @array = qw (alpha bravo charlie delta echo);
159
160 IterArray @array, sub
161 {
162 # $_[1] is the current numeric index
163 if($_[1] == 3)
164 {
165 # modify the element in the original array
166 $_[0] = 'three'; # current element available via $_[0]
167 }
168 }
169
170
171 # iterate a hash, perform nested iteration on the same hash.
172
173 my %hash =
174 (
175 blue => 'moon',
176 green => 'egg',
177 red => 'baron',
178 );
179
180 IterHash (%hash, sub
181 {
182 my $key1 = $_[0];
183 my $val1 = $_[1];
184
185 print "checking key1 $key1, val1 $val1 for collisions \n";
186
187 IterHash (%hash, sub
188 {
189 my $key2 = $_[0];
190 my $val2 = $_[1];
191
192 print "\tchecking key2 $key2, val2 $val2 for collisions \n";
193
194 print "\t $val2 is not $key1\n"
195 unless($key1 eq $key2);
196 return;
197 });
198 });
199
200 # iterate a file, read it line by line, and grep for a string.
201 IterFile "tfile.pl", sub
202 {
203 # the line read from the file is stored in $_[0]
204 my $line = $_[0];
205
206 # the current line number corresponding to $_[0] is stored in $_[-1]
207 my $number = $_[-1];
208
209 if($line =~ /search/)
210 {
211 print "found at line $number: $line";
212 }
213 };
214
215
216
217 =head1 DESCRIPTION
218
219 This module is intended to demonstrate a simple way to implement
220 iterators on perl variables with little code required of the
221 programmer using them.
222
223 Some additional advantages over standard perl iterators:
224
225 Array iterators give access to the current index within the array.
226 Hash iterators can be nested upon the same hash without conflicts.
227 File iterators allow simple file munging in a few lines of code.
228
229 =head2 EXPORT
230
231 IterArray
232 IterHash
233 IterFile
234
235 =head1 AUTHOR
236
237 Iterate - Smart, Simple, Recursive Iterators for Perl programming.
238 Copyright (C) 2002 Greg London
239
240 This program is free software; you can redistribute it and/or modify
241 it under the same terms as Perl 5 itself.
242
243 This program is distributed in the hope that it will be useful,
244 but WITHOUT ANY WARRANTY; without even the implied warranty of
245 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
246 Perl 5 License schemes for more details.
247
248 contact the author via http://www.greglondon.com
249
250
251 =head1 SEE ALSO
252
253 perl(1).
254
255 =cut

MailToCvsAdmin">MailToCvsAdmin
ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed