This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
futimes [PATCH]
[perl5.git] / pod / perlfaq4.pod
... / ...
CommitLineData
1=head1 NAME
2
3perlfaq4 - Data Manipulation ($Revision: 1.69 $, $Date: 2005/10/14 15:34:06 $)
4
5=head1 DESCRIPTION
6
7This section of the FAQ answers questions related to manipulating
8numbers, dates, strings, arrays, hashes, and miscellaneous data issues.
9
10=head1 Data: Numbers
11
12=head2 Why am I getting long decimals (eg, 19.9499999999999) instead of the numbers I should be getting (eg, 19.95)?
13
14Internally, your computer represents floating-point numbers
15in binary. Digital (as in powers of two) computers cannot
16store all numbers exactly. Some real numbers lose precision
17in the process. This is a problem with how computers store
18numbers and affects all computer languages, not just Perl.
19
20L<perlnumber> show the gory details of number
21representations and conversions.
22
23To limit the number of decimal places in your numbers, you
24can use the printf or sprintf function. See the
25L<"Floating Point Arithmetic"|perlop> for more details.
26
27 printf "%.2f", 10/3;
28
29 my $number = sprintf "%.2f", 10/3;
30
31=head2 Why is int() broken?
32
33Your int() is most probably working just fine. It's the numbers that
34aren't quite what you think.
35
36First, see the above item "Why am I getting long decimals
37(eg, 19.9499999999999) instead of the numbers I should be getting
38(eg, 19.95)?".
39
40For example, this
41
42 print int(0.6/0.2-2), "\n";
43
44will in most computers print 0, not 1, because even such simple
45numbers as 0.6 and 0.2 cannot be presented exactly by floating-point
46numbers. What you think in the above as 'three' is really more like
472.9999999999999995559.
48
49=head2 Why isn't my octal data interpreted correctly?
50
51Perl only understands octal and hex numbers as such when they occur as
52literals in your program. Octal literals in perl must start with a
53leading "0" and hexadecimal literals must start with a leading "0x".
54If they are read in from somewhere and assigned, no automatic
55conversion takes place. You must explicitly use oct() or hex() if you
56want the values converted to decimal. oct() interprets hex ("0x350"),
57octal ("0350" or even without the leading "0", like "377") and binary
58("0b1010") numbers, while hex() only converts hexadecimal ones, with
59or without a leading "0x", like "0x255", "3A", "ff", or "deadbeef".
60The inverse mapping from decimal to octal can be done with either the
61"%o" or "%O" sprintf() formats.
62
63This problem shows up most often when people try using chmod(), mkdir(),
64umask(), or sysopen(), which by widespread tradition typically take
65permissions in octal.
66
67 chmod(644, $file); # WRONG
68 chmod(0644, $file); # right
69
70Note the mistake in the first line was specifying the decimal literal
71644, rather than the intended octal literal 0644. The problem can
72be seen with:
73
74 printf("%#o",644); # prints 01204
75
76Surely you had not intended C<chmod(01204, $file);> - did you? If you
77want to use numeric literals as arguments to chmod() et al. then please
78try to express them as octal constants, that is with a leading zero and
79with the following digits restricted to the set 0..7.
80
81=head2 Does Perl have a round() function? What about ceil() and floor()? Trig functions?
82
83Remember that int() merely truncates toward 0. For rounding to a
84certain number of digits, sprintf() or printf() is usually the easiest
85route.
86
87 printf("%.3f", 3.1415926535); # prints 3.142
88
89The POSIX module (part of the standard Perl distribution) implements
90ceil(), floor(), and a number of other mathematical and trigonometric
91functions.
92
93 use POSIX;
94 $ceil = ceil(3.5); # 4
95 $floor = floor(3.5); # 3
96
97In 5.000 to 5.003 perls, trigonometry was done in the Math::Complex
98module. With 5.004, the Math::Trig module (part of the standard Perl
99distribution) implements the trigonometric functions. Internally it
100uses the Math::Complex module and some functions can break out from
101the real axis into the complex plane, for example the inverse sine of
1022.
103
104Rounding in financial applications can have serious implications, and
105the rounding method used should be specified precisely. In these
106cases, it probably pays not to trust whichever system rounding is
107being used by Perl, but to instead implement the rounding function you
108need yourself.
109
110To see why, notice how you'll still have an issue on half-way-point
111alternation:
112
113 for ($i = 0; $i < 1.01; $i += 0.05) { printf "%.1f ",$i}
114
115 0.0 0.1 0.1 0.2 0.2 0.2 0.3 0.3 0.4 0.4 0.5 0.5 0.6 0.7 0.7
116 0.8 0.8 0.9 0.9 1.0 1.0
117
118Don't blame Perl. It's the same as in C. IEEE says we have to do this.
119Perl numbers whose absolute values are integers under 2**31 (on 32 bit
120machines) will work pretty much like mathematical integers. Other numbers
121are not guaranteed.
122
123=head2 How do I convert between numeric representations/bases/radixes?
124
125As always with Perl there is more than one way to do it. Below
126are a few examples of approaches to making common conversions
127between number representations. This is intended to be representational
128rather than exhaustive.
129
130Some of the examples below use the Bit::Vector module from CPAN.
131The reason you might choose Bit::Vector over the perl built in
132functions is that it works with numbers of ANY size, that it is
133optimized for speed on some operations, and for at least some
134programmers the notation might be familiar.
135
136=over 4
137
138=item How do I convert hexadecimal into decimal
139
140Using perl's built in conversion of 0x notation:
141
142 $dec = 0xDEADBEEF;
143
144Using the hex function:
145
146 $dec = hex("DEADBEEF");
147
148Using pack:
149
150 $dec = unpack("N", pack("H8", substr("0" x 8 . "DEADBEEF", -8)));
151
152Using the CPAN module Bit::Vector:
153
154 use Bit::Vector;
155 $vec = Bit::Vector->new_Hex(32, "DEADBEEF");
156 $dec = $vec->to_Dec();
157
158=item How do I convert from decimal to hexadecimal
159
160Using sprintf:
161
162 $hex = sprintf("%X", 3735928559); # upper case A-F
163 $hex = sprintf("%x", 3735928559); # lower case a-f
164
165Using unpack:
166
167 $hex = unpack("H*", pack("N", 3735928559));
168
169Using Bit::Vector:
170
171 use Bit::Vector;
172 $vec = Bit::Vector->new_Dec(32, -559038737);
173 $hex = $vec->to_Hex();
174
175And Bit::Vector supports odd bit counts:
176
177 use Bit::Vector;
178 $vec = Bit::Vector->new_Dec(33, 3735928559);
179 $vec->Resize(32); # suppress leading 0 if unwanted
180 $hex = $vec->to_Hex();
181
182=item How do I convert from octal to decimal
183
184Using Perl's built in conversion of numbers with leading zeros:
185
186 $dec = 033653337357; # note the leading 0!
187
188Using the oct function:
189
190 $dec = oct("33653337357");
191
192Using Bit::Vector:
193
194 use Bit::Vector;
195 $vec = Bit::Vector->new(32);
196 $vec->Chunk_List_Store(3, split(//, reverse "33653337357"));
197 $dec = $vec->to_Dec();
198
199=item How do I convert from decimal to octal
200
201Using sprintf:
202
203 $oct = sprintf("%o", 3735928559);
204
205Using Bit::Vector:
206
207 use Bit::Vector;
208 $vec = Bit::Vector->new_Dec(32, -559038737);
209 $oct = reverse join('', $vec->Chunk_List_Read(3));
210
211=item How do I convert from binary to decimal
212
213Perl 5.6 lets you write binary numbers directly with
214the 0b notation:
215
216 $number = 0b10110110;
217
218Using oct:
219
220 my $input = "10110110";
221 $decimal = oct( "0b$input" );
222
223Using pack and ord:
224
225 $decimal = ord(pack('B8', '10110110'));
226
227Using pack and unpack for larger strings:
228
229 $int = unpack("N", pack("B32",
230 substr("0" x 32 . "11110101011011011111011101111", -32)));
231 $dec = sprintf("%d", $int);
232
233 # substr() is used to left pad a 32 character string with zeros.
234
235Using Bit::Vector:
236
237 $vec = Bit::Vector->new_Bin(32, "11011110101011011011111011101111");
238 $dec = $vec->to_Dec();
239
240=item How do I convert from decimal to binary
241
242Using sprintf (perl 5.6+):
243
244 $bin = sprintf("%b", 3735928559);
245
246Using unpack:
247
248 $bin = unpack("B*", pack("N", 3735928559));
249
250Using Bit::Vector:
251
252 use Bit::Vector;
253 $vec = Bit::Vector->new_Dec(32, -559038737);
254 $bin = $vec->to_Bin();
255
256The remaining transformations (e.g. hex -> oct, bin -> hex, etc.)
257are left as an exercise to the inclined reader.
258
259=back
260
261=head2 Why doesn't & work the way I want it to?
262
263The behavior of binary arithmetic operators depends on whether they're
264used on numbers or strings. The operators treat a string as a series
265of bits and work with that (the string C<"3"> is the bit pattern
266C<00110011>). The operators work with the binary form of a number
267(the number C<3> is treated as the bit pattern C<00000011>).
268
269So, saying C<11 & 3> performs the "and" operation on numbers (yielding
270C<3>). Saying C<"11" & "3"> performs the "and" operation on strings
271(yielding C<"1">).
272
273Most problems with C<&> and C<|> arise because the programmer thinks
274they have a number but really it's a string. The rest arise because
275the programmer says:
276
277 if ("\020\020" & "\101\101") {
278 # ...
279 }
280
281but a string consisting of two null bytes (the result of C<"\020\020"
282& "\101\101">) is not a false value in Perl. You need:
283
284 if ( ("\020\020" & "\101\101") !~ /[^\000]/) {
285 # ...
286 }
287
288=head2 How do I multiply matrices?
289
290Use the Math::Matrix or Math::MatrixReal modules (available from CPAN)
291or the PDL extension (also available from CPAN).
292
293=head2 How do I perform an operation on a series of integers?
294
295To call a function on each element in an array, and collect the
296results, use:
297
298 @results = map { my_func($_) } @array;
299
300For example:
301
302 @triple = map { 3 * $_ } @single;
303
304To call a function on each element of an array, but ignore the
305results:
306
307 foreach $iterator (@array) {
308 some_func($iterator);
309 }
310
311To call a function on each integer in a (small) range, you B<can> use:
312
313 @results = map { some_func($_) } (5 .. 25);
314
315but you should be aware that the C<..> operator creates an array of
316all integers in the range. This can take a lot of memory for large
317ranges. Instead use:
318
319 @results = ();
320 for ($i=5; $i < 500_005; $i++) {
321 push(@results, some_func($i));
322 }
323
324This situation has been fixed in Perl5.005. Use of C<..> in a C<for>
325loop will iterate over the range, without creating the entire range.
326
327 for my $i (5 .. 500_005) {
328 push(@results, some_func($i));
329 }
330
331will not create a list of 500,000 integers.
332
333=head2 How can I output Roman numerals?
334
335Get the http://www.cpan.org/modules/by-module/Roman module.
336
337=head2 Why aren't my random numbers random?
338
339If you're using a version of Perl before 5.004, you must call C<srand>
340once at the start of your program to seed the random number generator.
341
342 BEGIN { srand() if $] < 5.004 }
343
3445.004 and later automatically call C<srand> at the beginning. Don't
345call C<srand> more than once---you make your numbers less random, rather
346than more.
347
348Computers are good at being predictable and bad at being random
349(despite appearances caused by bugs in your programs :-). see the
350F<random> article in the "Far More Than You Ever Wanted To Know"
351collection in http://www.cpan.org/misc/olddoc/FMTEYEWTK.tgz , courtesy of
352Tom Phoenix, talks more about this. John von Neumann said, "Anyone
353who attempts to generate random numbers by deterministic means is, of
354course, living in a state of sin."
355
356If you want numbers that are more random than C<rand> with C<srand>
357provides, you should also check out the Math::TrulyRandom module from
358CPAN. It uses the imperfections in your system's timer to generate
359random numbers, but this takes quite a while. If you want a better
360pseudorandom generator than comes with your operating system, look at
361"Numerical Recipes in C" at http://www.nr.com/ .
362
363=head2 How do I get a random number between X and Y?
364
365C<rand($x)> returns a number such that
366C<< 0 <= rand($x) < $x >>. Thus what you want to have perl
367figure out is a random number in the range from 0 to the
368difference between your I<X> and I<Y>.
369
370That is, to get a number between 10 and 15, inclusive, you
371want a random number between 0 and 5 that you can then add
372to 10.
373
374 my $number = 10 + int rand( 15-10+1 );
375
376Hence you derive the following simple function to abstract
377that. It selects a random integer between the two given
378integers (inclusive), For example: C<random_int_in(50,120)>.
379
380 sub random_int_in ($$) {
381 my($min, $max) = @_;
382 # Assumes that the two arguments are integers themselves!
383 return $min if $min == $max;
384 ($min, $max) = ($max, $min) if $min > $max;
385 return $min + int rand(1 + $max - $min);
386 }
387
388=head1 Data: Dates
389
390=head2 How do I find the day or week of the year?
391
392The localtime function returns the day of the year. Without an
393argument localtime uses the current time.
394
395 $day_of_year = (localtime)[7];
396
397The POSIX module can also format a date as the day of the year or
398week of the year.
399
400 use POSIX qw/strftime/;
401 my $day_of_year = strftime "%j", localtime;
402 my $week_of_year = strftime "%W", localtime;
403
404To get the day of year for any date, use the Time::Local module to get
405a time in epoch seconds for the argument to localtime.
406
407 use POSIX qw/strftime/;
408 use Time::Local;
409 my $week_of_year = strftime "%W",
410 localtime( timelocal( 0, 0, 0, 18, 11, 1987 ) );
411
412The Date::Calc module provides two functions to calculate these.
413
414 use Date::Calc;
415 my $day_of_year = Day_of_Year( 1987, 12, 18 );
416 my $week_of_year = Week_of_Year( 1987, 12, 18 );
417
418=head2 How do I find the current century or millennium?
419
420Use the following simple functions:
421
422 sub get_century {
423 return int((((localtime(shift || time))[5] + 1999))/100);
424 }
425
426 sub get_millennium {
427 return 1+int((((localtime(shift || time))[5] + 1899))/1000);
428 }
429
430On some systems, the POSIX module's strftime() function has
431been extended in a non-standard way to use a C<%C> format,
432which they sometimes claim is the "century". It isn't,
433because on most such systems, this is only the first two
434digits of the four-digit year, and thus cannot be used to
435reliably determine the current century or millennium.
436
437=head2 How can I compare two dates and find the difference?
438
439(contributed by brian d foy)
440
441You could just store all your dates as a number and then subtract. Life
442isn't always that simple though. If you want to work with formatted
443dates, the Date::Manip, Date::Calc, or DateTime modules can help you.
444
445
446=head2 How can I take a string and turn it into epoch seconds?
447
448If it's a regular enough string that it always has the same format,
449you can split it up and pass the parts to C<timelocal> in the standard
450Time::Local module. Otherwise, you should look into the Date::Calc
451and Date::Manip modules from CPAN.
452
453=head2 How can I find the Julian Day?
454
455(contributed by brian d foy and Dave Cross)
456
457You can use the Time::JulianDay module available on CPAN. Ensure that
458you really want to find a Julian day, though, as many people have
459different ideas about Julian days. See
460http://www.hermetic.ch/cal_stud/jdn.htm for instance.
461
462You can also try the DateTime module, which can convert a date/time
463to a Julian Day.
464
465 $ perl -MDateTime -le'print DateTime->today->jd'
466 2453401.5
467
468Or the modified Julian Day
469
470 $ perl -MDateTime -le'print DateTime->today->mjd'
471 53401
472
473Or even the day of the year (which is what some people think of as a
474Julian day)
475
476 $ perl -MDateTime -le'print DateTime->today->doy'
477 31
478
479=head2 How do I find yesterday's date?
480
481(contributed by brian d foy)
482
483Use one of the Date modules. The C<DateTime> module makes it simple, and
484give you the same time of day, only the day before.
485
486 use DateTime;
487
488 my $yesterday = DateTime->now->subtract( days => 1 );
489
490 print "Yesterday was $yesterday\n";
491
492You can also use the C<Date::Calc> module using its Today_and_Now
493function.
494
495 use Date::Calc qw( Today_and_Now Add_Delta_DHMS );
496
497 my @date_time = Add_Delta_DHMS( Today_and_Now(), -1, 0, 0, 0 );
498
499 print "@date\n";
500
501Most people try to use the time rather than the calendar to figure out
502dates, but that assumes that days are twenty-four hours each. For
503most people, there are two days a year when they aren't: the switch to
504and from summer time throws this off. Let the modules do the work.
505
506=head2 Does Perl have a Year 2000 problem? Is Perl Y2K compliant?
507
508Short answer: No, Perl does not have a Year 2000 problem. Yes, Perl is
509Y2K compliant (whatever that means). The programmers you've hired to
510use it, however, probably are not.
511
512Long answer: The question belies a true understanding of the issue.
513Perl is just as Y2K compliant as your pencil--no more, and no less.
514Can you use your pencil to write a non-Y2K-compliant memo? Of course
515you can. Is that the pencil's fault? Of course it isn't.
516
517The date and time functions supplied with Perl (gmtime and localtime)
518supply adequate information to determine the year well beyond 2000
519(2038 is when trouble strikes for 32-bit machines). The year returned
520by these functions when used in a list context is the year minus 1900.
521For years between 1910 and 1999 this I<happens> to be a 2-digit decimal
522number. To avoid the year 2000 problem simply do not treat the year as
523a 2-digit number. It isn't.
524
525When gmtime() and localtime() are used in scalar context they return
526a timestamp string that contains a fully-expanded year. For example,
527C<$timestamp = gmtime(1005613200)> sets $timestamp to "Tue Nov 13 01:00:00
5282001". There's no year 2000 problem here.
529
530That doesn't mean that Perl can't be used to create non-Y2K compliant
531programs. It can. But so can your pencil. It's the fault of the user,
532not the language. At the risk of inflaming the NRA: "Perl doesn't
533break Y2K, people do." See http://www.perl.org/about/y2k.html for
534a longer exposition.
535
536=head1 Data: Strings
537
538=head2 How do I validate input?
539
540(contributed by brian d foy)
541
542There are many ways to ensure that values are what you expect or
543want to accept. Besides the specific examples that we cover in the
544perlfaq, you can also look at the modules with "Assert" and "Validate"
545in their names, along with other modules such as C<Regexp::Common>.
546
547Some modules have validation for particular types of input, such
548as C<Business::ISBN>, C<Business::CreditCard>, C<Email::Valid>,
549and C<Data::Validate::IP>.
550
551=head2 How do I unescape a string?
552
553It depends just what you mean by "escape". URL escapes are dealt
554with in L<perlfaq9>. Shell escapes with the backslash (C<\>)
555character are removed with
556
557 s/\\(.)/$1/g;
558
559This won't expand C<"\n"> or C<"\t"> or any other special escapes.
560
561=head2 How do I remove consecutive pairs of characters?
562
563(contributed by brian d foy)
564
565You can use the substitution operator to find pairs of characters (or
566runs of characters) and replace them with a single instance. In this
567substitution, we find a character in C<(.)>. The memory parentheses
568store the matched character in the back-reference C<\1> and we use
569that to require that the same thing immediately follow it. We replace
570that part of the string with the character in C<$1>.
571
572 s/(.)\1/$1/g;
573
574We can also use the transliteration operator, C<tr///>. In this
575example, the search list side of our C<tr///> contains nothing, but
576the C<c> option complements that so it contains everything. The
577replacement list also contains nothing, so the transliteration is
578almost a no-op since it won't do any replacements (or more exactly,
579replace the character with itself). However, the C<s> option squashes
580duplicated and consecutive characters in the string so a character
581does not show up next to itself
582
583 my $str = 'Haarlem'; # in the Netherlands
584 $str =~ tr///cs; # Now Harlem, like in New York
585
586=head2 How do I expand function calls in a string?
587
588(contributed by brian d foy)
589
590This is documented in L<perlref>, and although it's not the easiest
591thing to read, it does work. In each of these examples, we call the
592function inside the braces of used to dereference a reference. If we
593have a more than one return value, we can construct and dereference an
594anonymous array. In this case, we call the function in list context.
595
596 print "The time values are @{ [localtime] }.\n";
597
598If we want to call the function in scalar context, we have to do a bit
599more work. We can really have any code we like inside the braces, so
600we simply have to end with the scalar reference, although how you do
601that is up to you, and you can use code inside the braces.
602
603 print "The time is ${\(scalar localtime)}.\n"
604
605 print "The time is ${ my $x = localtime; \$x }.\n";
606
607If your function already returns a reference, you don't need to create
608the reference yourself.
609
610 sub timestamp { my $t = localtime; \$t }
611
612 print "The time is ${ timestamp() }.\n";
613
614In most cases, it is probably easier to simply use string
615concatenation, which also forces scalar context.
616
617 print "The time is " . localtime . ".\n";
618
619=head2 How do I find matching/nesting anything?
620
621This isn't something that can be done in one regular expression, no
622matter how complicated. To find something between two single
623characters, a pattern like C</x([^x]*)x/> will get the intervening
624bits in $1. For multiple ones, then something more like
625C</alpha(.*?)omega/> would be needed. But none of these deals with
626nested patterns. For balanced expressions using C<(>, C<{>, C<[> or
627C<< < >> as delimiters, use the CPAN module Regexp::Common, or see
628L<perlre/(??{ code })>. For other cases, you'll have to write a
629parser.
630
631If you are serious about writing a parser, there are a number of
632modules or oddities that will make your life a lot easier. There are
633the CPAN modules Parse::RecDescent, Parse::Yapp, and Text::Balanced;
634and the byacc program. Starting from perl 5.8 the Text::Balanced is
635part of the standard distribution.
636
637One simple destructive, inside-out approach that you might try is to
638pull out the smallest nesting parts one at a time:
639
640 while (s/BEGIN((?:(?!BEGIN)(?!END).)*)END//gs) {
641 # do something with $1
642 }
643
644A more complicated and sneaky approach is to make Perl's regular
645expression engine do it for you. This is courtesy Dean Inada, and
646rather has the nature of an Obfuscated Perl Contest entry, but it
647really does work:
648
649 # $_ contains the string to parse
650 # BEGIN and END are the opening and closing markers for the
651 # nested text.
652
653 @( = ('(','');
654 @) = (')','');
655 ($re=$_)=~s/((BEGIN)|(END)|.)/$)[!$3]\Q$1\E$([!$2]/gs;
656 @$ = (eval{/$re/},$@!~/unmatched/i);
657 print join("\n",@$[0..$#$]) if( $$[-1] );
658
659=head2 How do I reverse a string?
660
661Use reverse() in scalar context, as documented in
662L<perlfunc/reverse>.
663
664 $reversed = reverse $string;
665
666=head2 How do I expand tabs in a string?
667
668You can do it yourself:
669
670 1 while $string =~ s/\t+/' ' x (length($&) * 8 - length($`) % 8)/e;
671
672Or you can just use the Text::Tabs module (part of the standard Perl
673distribution).
674
675 use Text::Tabs;
676 @expanded_lines = expand(@lines_with_tabs);
677
678=head2 How do I reformat a paragraph?
679
680Use Text::Wrap (part of the standard Perl distribution):
681
682 use Text::Wrap;
683 print wrap("\t", ' ', @paragraphs);
684
685The paragraphs you give to Text::Wrap should not contain embedded
686newlines. Text::Wrap doesn't justify the lines (flush-right).
687
688Or use the CPAN module Text::Autoformat. Formatting files can be easily
689done by making a shell alias, like so:
690
691 alias fmt="perl -i -MText::Autoformat -n0777 \
692 -e 'print autoformat $_, {all=>1}' $*"
693
694See the documentation for Text::Autoformat to appreciate its many
695capabilities.
696
697=head2 How can I access or change N characters of a string?
698
699You can access the first characters of a string with substr().
700To get the first character, for example, start at position 0
701and grab the string of length 1.
702
703
704 $string = "Just another Perl Hacker";
705 $first_char = substr( $string, 0, 1 ); # 'J'
706
707To change part of a string, you can use the optional fourth
708argument which is the replacement string.
709
710 substr( $string, 13, 4, "Perl 5.8.0" );
711
712You can also use substr() as an lvalue.
713
714 substr( $string, 13, 4 ) = "Perl 5.8.0";
715
716=head2 How do I change the Nth occurrence of something?
717
718You have to keep track of N yourself. For example, let's say you want
719to change the fifth occurrence of C<"whoever"> or C<"whomever"> into
720C<"whosoever"> or C<"whomsoever">, case insensitively. These
721all assume that $_ contains the string to be altered.
722
723 $count = 0;
724 s{((whom?)ever)}{
725 ++$count == 5 # is it the 5th?
726 ? "${2}soever" # yes, swap
727 : $1 # renege and leave it there
728 }ige;
729
730In the more general case, you can use the C</g> modifier in a C<while>
731loop, keeping count of matches.
732
733 $WANT = 3;
734 $count = 0;
735 $_ = "One fish two fish red fish blue fish";
736 while (/(\w+)\s+fish\b/gi) {
737 if (++$count == $WANT) {
738 print "The third fish is a $1 one.\n";
739 }
740 }
741
742That prints out: C<"The third fish is a red one."> You can also use a
743repetition count and repeated pattern like this:
744
745 /(?:\w+\s+fish\s+){2}(\w+)\s+fish/i;
746
747=head2 How can I count the number of occurrences of a substring within a string?
748
749There are a number of ways, with varying efficiency. If you want a
750count of a certain single character (X) within a string, you can use the
751C<tr///> function like so:
752
753 $string = "ThisXlineXhasXsomeXx'sXinXit";
754 $count = ($string =~ tr/X//);
755 print "There are $count X characters in the string";
756
757This is fine if you are just looking for a single character. However,
758if you are trying to count multiple character substrings within a
759larger string, C<tr///> won't work. What you can do is wrap a while()
760loop around a global pattern match. For example, let's count negative
761integers:
762
763 $string = "-9 55 48 -2 23 -76 4 14 -44";
764 while ($string =~ /-\d+/g) { $count++ }
765 print "There are $count negative numbers in the string";
766
767Another version uses a global match in list context, then assigns the
768result to a scalar, producing a count of the number of matches.
769
770 $count = () = $string =~ /-\d+/g;
771
772=head2 How do I capitalize all the words on one line?
773
774To make the first letter of each word upper case:
775
776 $line =~ s/\b(\w)/\U$1/g;
777
778This has the strange effect of turning "C<don't do it>" into "C<Don'T
779Do It>". Sometimes you might want this. Other times you might need a
780more thorough solution (Suggested by brian d foy):
781
782 $string =~ s/ (
783 (^\w) #at the beginning of the line
784 | # or
785 (\s\w) #preceded by whitespace
786 )
787 /\U$1/xg;
788 $string =~ /([\w']+)/\u\L$1/g;
789
790To make the whole line upper case:
791
792 $line = uc($line);
793
794To force each word to be lower case, with the first letter upper case:
795
796 $line =~ s/(\w+)/\u\L$1/g;
797
798You can (and probably should) enable locale awareness of those
799characters by placing a C<use locale> pragma in your program.
800See L<perllocale> for endless details on locales.
801
802This is sometimes referred to as putting something into "title
803case", but that's not quite accurate. Consider the proper
804capitalization of the movie I<Dr. Strangelove or: How I Learned to
805Stop Worrying and Love the Bomb>, for example.
806
807Damian Conway's L<Text::Autoformat> module provides some smart
808case transformations:
809
810 use Text::Autoformat;
811 my $x = "Dr. Strangelove or: How I Learned to Stop ".
812 "Worrying and Love the Bomb";
813
814 print $x, "\n";
815 for my $style (qw( sentence title highlight ))
816 {
817 print autoformat($x, { case => $style }), "\n";
818 }
819
820=head2 How can I split a [character] delimited string except when inside [character]?
821
822Several modules can handle this sort of pasing---Text::Balanced,
823Text::CSV, Text::CSV_XS, and Text::ParseWords, among others.
824
825Take the example case of trying to split a string that is
826comma-separated into its different fields. You can't use C<split(/,/)>
827because you shouldn't split if the comma is inside quotes. For
828example, take a data line like this:
829
830 SAR001,"","Cimetrix, Inc","Bob Smith","CAM",N,8,1,0,7,"Error, Core Dumped"
831
832Due to the restriction of the quotes, this is a fairly complex
833problem. Thankfully, we have Jeffrey Friedl, author of
834I<Mastering Regular Expressions>, to handle these for us. He
835suggests (assuming your string is contained in $text):
836
837 @new = ();
838 push(@new, $+) while $text =~ m{
839 "([^\"\\]*(?:\\.[^\"\\]*)*)",? # groups the phrase inside the quotes
840 | ([^,]+),?
841 | ,
842 }gx;
843 push(@new, undef) if substr($text,-1,1) eq ',';
844
845If you want to represent quotation marks inside a
846quotation-mark-delimited field, escape them with backslashes (eg,
847C<"like \"this\"">.
848
849Alternatively, the Text::ParseWords module (part of the standard Perl
850distribution) lets you say:
851
852 use Text::ParseWords;
853 @new = quotewords(",", 0, $text);
854
855There's also a Text::CSV (Comma-Separated Values) module on CPAN.
856
857=head2 How do I strip blank space from the beginning/end of a string?
858
859(contributed by brian d foy)
860
861A substitution can do this for you. For a single line, you want to
862replace all the leading or trailing whitespace with nothing. You
863can do that with a pair of substitutions.
864
865 s/^\s+//;
866 s/\s+$//;
867
868You can also write that as a single substitution, although it turns
869out the combined statement is slower than the separate ones. That
870might not matter to you, though.
871
872 s/^\s+|\s+$//g;
873
874In this regular expression, the alternation matches either at the
875beginning or the end of the string since the anchors have a lower
876precedence than the alternation. With the C</g> flag, the substitution
877makes all possible matches, so it gets both. Remember, the trailing
878newline matches the C<\s+>, and the C<$> anchor can match to the
879physical end of the string, so the newline disappears too. Just add
880the newline to the output, which has the added benefit of preserving
881"blank" (consisting entirely of whitespace) lines which the C<^\s+>
882would remove all by itself.
883
884 while( <> )
885 {
886 s/^\s+|\s+$//g;
887 print "$_\n";
888 }
889
890For a multi-line string, you can apply the regular expression
891to each logical line in the string by adding the C</m> flag (for
892"multi-line"). With the C</m> flag, the C<$> matches I<before> an
893embedded newline, so it doesn't remove it. It still removes the
894newline at the end of the string.
895
896 $string =~ s/^\s+|\s+$//gm;
897
898Remember that lines consisting entirely of whitespace will disappear,
899since the first part of the alternation can match the entire string
900and replace it with nothing. If need to keep embedded blank lines,
901you have to do a little more work. Instead of matching any whitespace
902(since that includes a newline), just match the other whitespace.
903
904 $string =~ s/^[\t\f ]+|[\t\f ]+$//mg;
905
906=head2 How do I pad a string with blanks or pad a number with zeroes?
907
908In the following examples, C<$pad_len> is the length to which you wish
909to pad the string, C<$text> or C<$num> contains the string to be padded,
910and C<$pad_char> contains the padding character. You can use a single
911character string constant instead of the C<$pad_char> variable if you
912know what it is in advance. And in the same way you can use an integer in
913place of C<$pad_len> if you know the pad length in advance.
914
915The simplest method uses the C<sprintf> function. It can pad on the left
916or right with blanks and on the left with zeroes and it will not
917truncate the result. The C<pack> function can only pad strings on the
918right with blanks and it will truncate the result to a maximum length of
919C<$pad_len>.
920
921 # Left padding a string with blanks (no truncation):
922 $padded = sprintf("%${pad_len}s", $text);
923 $padded = sprintf("%*s", $pad_len, $text); # same thing
924
925 # Right padding a string with blanks (no truncation):
926 $padded = sprintf("%-${pad_len}s", $text);
927 $padded = sprintf("%-*s", $pad_len, $text); # same thing
928
929 # Left padding a number with 0 (no truncation):
930 $padded = sprintf("%0${pad_len}d", $num);
931 $padded = sprintf("%0*d", $pad_len, $num); # same thing
932
933 # Right padding a string with blanks using pack (will truncate):
934 $padded = pack("A$pad_len",$text);
935
936If you need to pad with a character other than blank or zero you can use
937one of the following methods. They all generate a pad string with the
938C<x> operator and combine that with C<$text>. These methods do
939not truncate C<$text>.
940
941Left and right padding with any character, creating a new string:
942
943 $padded = $pad_char x ( $pad_len - length( $text ) ) . $text;
944 $padded = $text . $pad_char x ( $pad_len - length( $text ) );
945
946Left and right padding with any character, modifying C<$text> directly:
947
948 substr( $text, 0, 0 ) = $pad_char x ( $pad_len - length( $text ) );
949 $text .= $pad_char x ( $pad_len - length( $text ) );
950
951=head2 How do I extract selected columns from a string?
952
953Use substr() or unpack(), both documented in L<perlfunc>.
954If you prefer thinking in terms of columns instead of widths,
955you can use this kind of thing:
956
957 # determine the unpack format needed to split Linux ps output
958 # arguments are cut columns
959 my $fmt = cut2fmt(8, 14, 20, 26, 30, 34, 41, 47, 59, 63, 67, 72);
960
961 sub cut2fmt {
962 my(@positions) = @_;
963 my $template = '';
964 my $lastpos = 1;
965 for my $place (@positions) {
966 $template .= "A" . ($place - $lastpos) . " ";
967 $lastpos = $place;
968 }
969 $template .= "A*";
970 return $template;
971 }
972
973=head2 How do I find the soundex value of a string?
974
975(contributed by brian d foy)
976
977You can use the Text::Soundex module. If you want to do fuzzy or close
978matching, you might also try the String::Approx, and Text::Metaphone,
979and Text::DoubleMetaphone modules.
980
981=head2 How can I expand variables in text strings?
982
983Let's assume that you have a string that contains placeholder
984variables.
985
986 $text = 'this has a $foo in it and a $bar';
987
988You can use a substitution with a double evaluation. The
989first /e turns C<$1> into C<$foo>, and the second /e turns
990C<$foo> into its value. You may want to wrap this in an
991C<eval>: if you try to get the value of an undeclared variable
992while running under C<use strict>, you get a fatal error.
993
994 eval { $text =~ s/(\$\w+)/$1/eeg };
995 die if $@;
996
997It's probably better in the general case to treat those
998variables as entries in some special hash. For example:
999
1000 %user_defs = (
1001 foo => 23,
1002 bar => 19,
1003 );
1004 $text =~ s/\$(\w+)/$user_defs{$1}/g;
1005
1006=head2 What's wrong with always quoting "$vars"?
1007
1008The problem is that those double-quotes force stringification--
1009coercing numbers and references into strings--even when you
1010don't want them to be strings. Think of it this way: double-quote
1011expansion is used to produce new strings. If you already
1012have a string, why do you need more?
1013
1014If you get used to writing odd things like these:
1015
1016 print "$var"; # BAD
1017 $new = "$old"; # BAD
1018 somefunc("$var"); # BAD
1019
1020You'll be in trouble. Those should (in 99.8% of the cases) be
1021the simpler and more direct:
1022
1023 print $var;
1024 $new = $old;
1025 somefunc($var);
1026
1027Otherwise, besides slowing you down, you're going to break code when
1028the thing in the scalar is actually neither a string nor a number, but
1029a reference:
1030
1031 func(\@array);
1032 sub func {
1033 my $aref = shift;
1034 my $oref = "$aref"; # WRONG
1035 }
1036
1037You can also get into subtle problems on those few operations in Perl
1038that actually do care about the difference between a string and a
1039number, such as the magical C<++> autoincrement operator or the
1040syscall() function.
1041
1042Stringification also destroys arrays.
1043
1044 @lines = `command`;
1045 print "@lines"; # WRONG - extra blanks
1046 print @lines; # right
1047
1048=head2 Why don't my E<lt>E<lt>HERE documents work?
1049
1050Check for these three things:
1051
1052=over 4
1053
1054=item There must be no space after the E<lt>E<lt> part.
1055
1056=item There (probably) should be a semicolon at the end.
1057
1058=item You can't (easily) have any space in front of the tag.
1059
1060=back
1061
1062If you want to indent the text in the here document, you
1063can do this:
1064
1065 # all in one
1066 ($VAR = <<HERE_TARGET) =~ s/^\s+//gm;
1067 your text
1068 goes here
1069 HERE_TARGET
1070
1071But the HERE_TARGET must still be flush against the margin.
1072If you want that indented also, you'll have to quote
1073in the indentation.
1074
1075 ($quote = <<' FINIS') =~ s/^\s+//gm;
1076 ...we will have peace, when you and all your works have
1077 perished--and the works of your dark master to whom you
1078 would deliver us. You are a liar, Saruman, and a corrupter
1079 of men's hearts. --Theoden in /usr/src/perl/taint.c
1080 FINIS
1081 $quote =~ s/\s+--/\n--/;
1082
1083A nice general-purpose fixer-upper function for indented here documents
1084follows. It expects to be called with a here document as its argument.
1085It looks to see whether each line begins with a common substring, and
1086if so, strips that substring off. Otherwise, it takes the amount of leading
1087whitespace found on the first line and removes that much off each
1088subsequent line.
1089
1090 sub fix {
1091 local $_ = shift;
1092 my ($white, $leader); # common whitespace and common leading string
1093 if (/^\s*(?:([^\w\s]+)(\s*).*\n)(?:\s*\1\2?.*\n)+$/) {
1094 ($white, $leader) = ($2, quotemeta($1));
1095 } else {
1096 ($white, $leader) = (/^(\s+)/, '');
1097 }
1098 s/^\s*?$leader(?:$white)?//gm;
1099 return $_;
1100 }
1101
1102This works with leading special strings, dynamically determined:
1103
1104 $remember_the_main = fix<<' MAIN_INTERPRETER_LOOP';
1105 @@@ int
1106 @@@ runops() {
1107 @@@ SAVEI32(runlevel);
1108 @@@ runlevel++;
1109 @@@ while ( op = (*op->op_ppaddr)() );
1110 @@@ TAINT_NOT;
1111 @@@ return 0;
1112 @@@ }
1113 MAIN_INTERPRETER_LOOP
1114
1115Or with a fixed amount of leading whitespace, with remaining
1116indentation correctly preserved:
1117
1118 $poem = fix<<EVER_ON_AND_ON;
1119 Now far ahead the Road has gone,
1120 And I must follow, if I can,
1121 Pursuing it with eager feet,
1122 Until it joins some larger way
1123 Where many paths and errands meet.
1124 And whither then? I cannot say.
1125 --Bilbo in /usr/src/perl/pp_ctl.c
1126 EVER_ON_AND_ON
1127
1128=head1 Data: Arrays
1129
1130=head2 What is the difference between a list and an array?
1131
1132An array has a changeable length. A list does not. An array is something
1133you can push or pop, while a list is a set of values. Some people make
1134the distinction that a list is a value while an array is a variable.
1135Subroutines are passed and return lists, you put things into list
1136context, you initialize arrays with lists, and you foreach() across
1137a list. C<@> variables are arrays, anonymous arrays are arrays, arrays
1138in scalar context behave like the number of elements in them, subroutines
1139access their arguments through the array C<@_>, and push/pop/shift only work
1140on arrays.
1141
1142As a side note, there's no such thing as a list in scalar context.
1143When you say
1144
1145 $scalar = (2, 5, 7, 9);
1146
1147you're using the comma operator in scalar context, so it uses the scalar
1148comma operator. There never was a list there at all! This causes the
1149last value to be returned: 9.
1150
1151=head2 What is the difference between $array[1] and @array[1]?
1152
1153The former is a scalar value; the latter an array slice, making
1154it a list with one (scalar) value. You should use $ when you want a
1155scalar value (most of the time) and @ when you want a list with one
1156scalar value in it (very, very rarely; nearly never, in fact).
1157
1158Sometimes it doesn't make a difference, but sometimes it does.
1159For example, compare:
1160
1161 $good[0] = `some program that outputs several lines`;
1162
1163with
1164
1165 @bad[0] = `same program that outputs several lines`;
1166
1167The C<use warnings> pragma and the B<-w> flag will warn you about these
1168matters.
1169
1170=head2 How can I remove duplicate elements from a list or array?
1171
1172(contributed by brian d foy)
1173
1174Use a hash. When you think the words "unique" or "duplicated", think
1175"hash keys".
1176
1177If you don't care about the order of the elements, you could just
1178create the hash then extract the keys. It's not important how you
1179create that hash: just that you use C<keys> to get the unique
1180elements.
1181
1182 my %hash = map { $_, 1 } @array;
1183 # or a hash slice: @hash{ @array } = ();
1184 # or a foreach: $hash{$_} = 1 foreach ( @array );
1185
1186 my @unique = keys %hash;
1187
1188You can also go through each element and skip the ones you've seen
1189before. Use a hash to keep track. The first time the loop sees an
1190element, that element has no key in C<%Seen>. The C<next> statement
1191creates the key and immediately uses its value, which is C<undef>, so
1192the loop continues to the C<push> and increments the value for that
1193key. The next time the loop sees that same element, its key exists in
1194the hash I<and> the value for that key is true (since it's not 0 or
1195undef), so the next skips that iteration and the loop goes to the next
1196element.
1197
1198 my @unique = ();
1199 my %seen = ();
1200
1201 foreach my $elem ( @array )
1202 {
1203 next if $seen{ $elem }++;
1204 push @unique, $elem;
1205 }
1206
1207You can write this more briefly using a grep, which does the
1208same thing.
1209
1210 my %seen = ();
1211 my @unique = grep { ! $seen{ $_ }++ } @array;
1212
1213=head2 How can I tell whether a certain element is contained in a list or array?
1214
1215(portions of this answer contributed by Anno Siegel)
1216
1217Hearing the word "in" is an I<in>dication that you probably should have
1218used a hash, not a list or array, to store your data. Hashes are
1219designed to answer this question quickly and efficiently. Arrays aren't.
1220
1221That being said, there are several ways to approach this. If you
1222are going to make this query many times over arbitrary string values,
1223the fastest way is probably to invert the original array and maintain a
1224hash whose keys are the first array's values.
1225
1226 @blues = qw/azure cerulean teal turquoise lapis-lazuli/;
1227 %is_blue = ();
1228 for (@blues) { $is_blue{$_} = 1 }
1229
1230Now you can check whether $is_blue{$some_color}. It might have been a
1231good idea to keep the blues all in a hash in the first place.
1232
1233If the values are all small integers, you could use a simple indexed
1234array. This kind of an array will take up less space:
1235
1236 @primes = (2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31);
1237 @is_tiny_prime = ();
1238 for (@primes) { $is_tiny_prime[$_] = 1 }
1239 # or simply @istiny_prime[@primes] = (1) x @primes;
1240
1241Now you check whether $is_tiny_prime[$some_number].
1242
1243If the values in question are integers instead of strings, you can save
1244quite a lot of space by using bit strings instead:
1245
1246 @articles = ( 1..10, 150..2000, 2017 );
1247 undef $read;
1248 for (@articles) { vec($read,$_,1) = 1 }
1249
1250Now check whether C<vec($read,$n,1)> is true for some C<$n>.
1251
1252These methods guarantee fast individual tests but require a re-organization
1253of the original list or array. They only pay off if you have to test
1254multiple values against the same array.
1255
1256If you are testing only once, the standard module List::Util exports
1257the function C<first> for this purpose. It works by stopping once it
1258finds the element. It's written in C for speed, and its Perl equivalant
1259looks like this subroutine:
1260
1261 sub first (&@) {
1262 my $code = shift;
1263 foreach (@_) {
1264 return $_ if &{$code}();
1265 }
1266 undef;
1267 }
1268
1269If speed is of little concern, the common idiom uses grep in scalar context
1270(which returns the number of items that passed its condition) to traverse the
1271entire list. This does have the benefit of telling you how many matches it
1272found, though.
1273
1274 my $is_there = grep $_ eq $whatever, @array;
1275
1276If you want to actually extract the matching elements, simply use grep in
1277list context.
1278
1279 my @matches = grep $_ eq $whatever, @array;
1280
1281=head2 How do I compute the difference of two arrays? How do I compute the intersection of two arrays?
1282
1283Use a hash. Here's code to do both and more. It assumes that
1284each element is unique in a given array:
1285
1286 @union = @intersection = @difference = ();
1287 %count = ();
1288 foreach $element (@array1, @array2) { $count{$element}++ }
1289 foreach $element (keys %count) {
1290 push @union, $element;
1291 push @{ $count{$element} > 1 ? \@intersection : \@difference }, $element;
1292 }
1293
1294Note that this is the I<symmetric difference>, that is, all elements in
1295either A or in B but not in both. Think of it as an xor operation.
1296
1297=head2 How do I test whether two arrays or hashes are equal?
1298
1299The following code works for single-level arrays. It uses a stringwise
1300comparison, and does not distinguish defined versus undefined empty
1301strings. Modify if you have other needs.
1302
1303 $are_equal = compare_arrays(\@frogs, \@toads);
1304
1305 sub compare_arrays {
1306 my ($first, $second) = @_;
1307 no warnings; # silence spurious -w undef complaints
1308 return 0 unless @$first == @$second;
1309 for (my $i = 0; $i < @$first; $i++) {
1310 return 0 if $first->[$i] ne $second->[$i];
1311 }
1312 return 1;
1313 }
1314
1315For multilevel structures, you may wish to use an approach more
1316like this one. It uses the CPAN module FreezeThaw:
1317
1318 use FreezeThaw qw(cmpStr);
1319 @a = @b = ( "this", "that", [ "more", "stuff" ] );
1320
1321 printf "a and b contain %s arrays\n",
1322 cmpStr(\@a, \@b) == 0
1323 ? "the same"
1324 : "different";
1325
1326This approach also works for comparing hashes. Here
1327we'll demonstrate two different answers:
1328
1329 use FreezeThaw qw(cmpStr cmpStrHard);
1330
1331 %a = %b = ( "this" => "that", "extra" => [ "more", "stuff" ] );
1332 $a{EXTRA} = \%b;
1333 $b{EXTRA} = \%a;
1334
1335 printf "a and b contain %s hashes\n",
1336 cmpStr(\%a, \%b) == 0 ? "the same" : "different";
1337
1338 printf "a and b contain %s hashes\n",
1339 cmpStrHard(\%a, \%b) == 0 ? "the same" : "different";
1340
1341
1342The first reports that both those the hashes contain the same data,
1343while the second reports that they do not. Which you prefer is left as
1344an exercise to the reader.
1345
1346=head2 How do I find the first array element for which a condition is true?
1347
1348To find the first array element which satisfies a condition, you can
1349use the first() function in the List::Util module, which comes with
1350Perl 5.8. This example finds the first element that contains "Perl".
1351
1352 use List::Util qw(first);
1353
1354 my $element = first { /Perl/ } @array;
1355
1356If you cannot use List::Util, you can make your own loop to do the
1357same thing. Once you find the element, you stop the loop with last.
1358
1359 my $found;
1360 foreach ( @array )
1361 {
1362 if( /Perl/ ) { $found = $_; last }
1363 }
1364
1365If you want the array index, you can iterate through the indices
1366and check the array element at each index until you find one
1367that satisfies the condition.
1368
1369 my( $found, $index ) = ( undef, -1 );
1370 for( $i = 0; $i < @array; $i++ )
1371 {
1372 if( $array[$i] =~ /Perl/ )
1373 {
1374 $found = $array[$i];
1375 $index = $i;
1376 last;
1377 }
1378 }
1379
1380=head2 How do I handle linked lists?
1381
1382In general, you usually don't need a linked list in Perl, since with
1383regular arrays, you can push and pop or shift and unshift at either end,
1384or you can use splice to add and/or remove arbitrary number of elements at
1385arbitrary points. Both pop and shift are both O(1) operations on Perl's
1386dynamic arrays. In the absence of shifts and pops, push in general
1387needs to reallocate on the order every log(N) times, and unshift will
1388need to copy pointers each time.
1389
1390If you really, really wanted, you could use structures as described in
1391L<perldsc> or L<perltoot> and do just what the algorithm book tells you
1392to do. For example, imagine a list node like this:
1393
1394 $node = {
1395 VALUE => 42,
1396 LINK => undef,
1397 };
1398
1399You could walk the list this way:
1400
1401 print "List: ";
1402 for ($node = $head; $node; $node = $node->{LINK}) {
1403 print $node->{VALUE}, " ";
1404 }
1405 print "\n";
1406
1407You could add to the list this way:
1408
1409 my ($head, $tail);
1410 $tail = append($head, 1); # grow a new head
1411 for $value ( 2 .. 10 ) {
1412 $tail = append($tail, $value);
1413 }
1414
1415 sub append {
1416 my($list, $value) = @_;
1417 my $node = { VALUE => $value };
1418 if ($list) {
1419 $node->{LINK} = $list->{LINK};
1420 $list->{LINK} = $node;
1421 } else {
1422 $_[0] = $node; # replace caller's version
1423 }
1424 return $node;
1425 }
1426
1427But again, Perl's built-in are virtually always good enough.
1428
1429=head2 How do I handle circular lists?
1430
1431Circular lists could be handled in the traditional fashion with linked
1432lists, or you could just do something like this with an array:
1433
1434 unshift(@array, pop(@array)); # the last shall be first
1435 push(@array, shift(@array)); # and vice versa
1436
1437=head2 How do I shuffle an array randomly?
1438
1439If you either have Perl 5.8.0 or later installed, or if you have
1440Scalar-List-Utils 1.03 or later installed, you can say:
1441
1442 use List::Util 'shuffle';
1443
1444 @shuffled = shuffle(@list);
1445
1446If not, you can use a Fisher-Yates shuffle.
1447
1448 sub fisher_yates_shuffle {
1449 my $deck = shift; # $deck is a reference to an array
1450 my $i = @$deck;
1451 while (--$i) {
1452 my $j = int rand ($i+1);
1453 @$deck[$i,$j] = @$deck[$j,$i];
1454 }
1455 }
1456
1457 # shuffle my mpeg collection
1458 #
1459 my @mpeg = <audio/*/*.mp3>;
1460 fisher_yates_shuffle( \@mpeg ); # randomize @mpeg in place
1461 print @mpeg;
1462
1463Note that the above implementation shuffles an array in place,
1464unlike the List::Util::shuffle() which takes a list and returns
1465a new shuffled list.
1466
1467You've probably seen shuffling algorithms that work using splice,
1468randomly picking another element to swap the current element with
1469
1470 srand;
1471 @new = ();
1472 @old = 1 .. 10; # just a demo
1473 while (@old) {
1474 push(@new, splice(@old, rand @old, 1));
1475 }
1476
1477This is bad because splice is already O(N), and since you do it N times,
1478you just invented a quadratic algorithm; that is, O(N**2). This does
1479not scale, although Perl is so efficient that you probably won't notice
1480this until you have rather largish arrays.
1481
1482=head2 How do I process/modify each element of an array?
1483
1484Use C<for>/C<foreach>:
1485
1486 for (@lines) {
1487 s/foo/bar/; # change that word
1488 tr/XZ/ZX/; # swap those letters
1489 }
1490
1491Here's another; let's compute spherical volumes:
1492
1493 for (@volumes = @radii) { # @volumes has changed parts
1494 $_ **= 3;
1495 $_ *= (4/3) * 3.14159; # this will be constant folded
1496 }
1497
1498which can also be done with map() which is made to transform
1499one list into another:
1500
1501 @volumes = map {$_ ** 3 * (4/3) * 3.14159} @radii;
1502
1503If you want to do the same thing to modify the values of the
1504hash, you can use the C<values> function. As of Perl 5.6
1505the values are not copied, so if you modify $orbit (in this
1506case), you modify the value.
1507
1508 for $orbit ( values %orbits ) {
1509 ($orbit **= 3) *= (4/3) * 3.14159;
1510 }
1511
1512Prior to perl 5.6 C<values> returned copies of the values,
1513so older perl code often contains constructions such as
1514C<@orbits{keys %orbits}> instead of C<values %orbits> where
1515the hash is to be modified.
1516
1517=head2 How do I select a random element from an array?
1518
1519Use the rand() function (see L<perlfunc/rand>):
1520
1521 $index = rand @array;
1522 $element = $array[$index];
1523
1524Or, simply:
1525 my $element = $array[ rand @array ];
1526
1527=head2 How do I permute N elements of a list?
1528
1529Use the List::Permutor module on CPAN. If the list is
1530actually an array, try the Algorithm::Permute module (also
1531on CPAN). It's written in XS code and is very efficient.
1532
1533 use Algorithm::Permute;
1534 my @array = 'a'..'d';
1535 my $p_iterator = Algorithm::Permute->new ( \@array );
1536 while (my @perm = $p_iterator->next) {
1537 print "next permutation: (@perm)\n";
1538 }
1539
1540For even faster execution, you could do:
1541
1542 use Algorithm::Permute;
1543 my @array = 'a'..'d';
1544 Algorithm::Permute::permute {
1545 print "next permutation: (@array)\n";
1546 } @array;
1547
1548Here's a little program that generates all permutations of
1549all the words on each line of input. The algorithm embodied
1550in the permute() function is discussed in Volume 4 (still
1551unpublished) of Knuth's I<The Art of Computer Programming>
1552and will work on any list:
1553
1554 #!/usr/bin/perl -n
1555 # Fischer-Kause ordered permutation generator
1556
1557 sub permute (&@) {
1558 my $code = shift;
1559 my @idx = 0..$#_;
1560 while ( $code->(@_[@idx]) ) {
1561 my $p = $#idx;
1562 --$p while $idx[$p-1] > $idx[$p];
1563 my $q = $p or return;
1564 push @idx, reverse splice @idx, $p;
1565 ++$q while $idx[$p-1] > $idx[$q];
1566 @idx[$p-1,$q]=@idx[$q,$p-1];
1567 }
1568 }
1569
1570 permute {print"@_\n"} split;
1571
1572=head2 How do I sort an array by (anything)?
1573
1574Supply a comparison function to sort() (described in L<perlfunc/sort>):
1575
1576 @list = sort { $a <=> $b } @list;
1577
1578The default sort function is cmp, string comparison, which would
1579sort C<(1, 2, 10)> into C<(1, 10, 2)>. C<< <=> >>, used above, is
1580the numerical comparison operator.
1581
1582If you have a complicated function needed to pull out the part you
1583want to sort on, then don't do it inside the sort function. Pull it
1584out first, because the sort BLOCK can be called many times for the
1585same element. Here's an example of how to pull out the first word
1586after the first number on each item, and then sort those words
1587case-insensitively.
1588
1589 @idx = ();
1590 for (@data) {
1591 ($item) = /\d+\s*(\S+)/;
1592 push @idx, uc($item);
1593 }
1594 @sorted = @data[ sort { $idx[$a] cmp $idx[$b] } 0 .. $#idx ];
1595
1596which could also be written this way, using a trick
1597that's come to be known as the Schwartzian Transform:
1598
1599 @sorted = map { $_->[0] }
1600 sort { $a->[1] cmp $b->[1] }
1601 map { [ $_, uc( (/\d+\s*(\S+)/)[0]) ] } @data;
1602
1603If you need to sort on several fields, the following paradigm is useful.
1604
1605 @sorted = sort { field1($a) <=> field1($b) ||
1606 field2($a) cmp field2($b) ||
1607 field3($a) cmp field3($b)
1608 } @data;
1609
1610This can be conveniently combined with precalculation of keys as given
1611above.
1612
1613See the F<sort> article in the "Far More Than You Ever Wanted
1614To Know" collection in http://www.cpan.org/misc/olddoc/FMTEYEWTK.tgz for
1615more about this approach.
1616
1617See also the question below on sorting hashes.
1618
1619=head2 How do I manipulate arrays of bits?
1620
1621Use pack() and unpack(), or else vec() and the bitwise operations.
1622
1623For example, this sets $vec to have bit N set if $ints[N] was set:
1624
1625 $vec = '';
1626 foreach(@ints) { vec($vec,$_,1) = 1 }
1627
1628Here's how, given a vector in $vec, you can
1629get those bits into your @ints array:
1630
1631 sub bitvec_to_list {
1632 my $vec = shift;
1633 my @ints;
1634 # Find null-byte density then select best algorithm
1635 if ($vec =~ tr/\0// / length $vec > 0.95) {
1636 use integer;
1637 my $i;
1638 # This method is faster with mostly null-bytes
1639 while($vec =~ /[^\0]/g ) {
1640 $i = -9 + 8 * pos $vec;
1641 push @ints, $i if vec($vec, ++$i, 1);
1642 push @ints, $i if vec($vec, ++$i, 1);
1643 push @ints, $i if vec($vec, ++$i, 1);
1644 push @ints, $i if vec($vec, ++$i, 1);
1645 push @ints, $i if vec($vec, ++$i, 1);
1646 push @ints, $i if vec($vec, ++$i, 1);
1647 push @ints, $i if vec($vec, ++$i, 1);
1648 push @ints, $i if vec($vec, ++$i, 1);
1649 }
1650 } else {
1651 # This method is a fast general algorithm
1652 use integer;
1653 my $bits = unpack "b*", $vec;
1654 push @ints, 0 if $bits =~ s/^(\d)// && $1;
1655 push @ints, pos $bits while($bits =~ /1/g);
1656 }
1657 return \@ints;
1658 }
1659
1660This method gets faster the more sparse the bit vector is.
1661(Courtesy of Tim Bunce and Winfried Koenig.)
1662
1663You can make the while loop a lot shorter with this suggestion
1664from Benjamin Goldberg:
1665
1666 while($vec =~ /[^\0]+/g ) {
1667 push @ints, grep vec($vec, $_, 1), $-[0] * 8 .. $+[0] * 8;
1668 }
1669
1670Or use the CPAN module Bit::Vector:
1671
1672 $vector = Bit::Vector->new($num_of_bits);
1673 $vector->Index_List_Store(@ints);
1674 @ints = $vector->Index_List_Read();
1675
1676Bit::Vector provides efficient methods for bit vector, sets of small integers
1677and "big int" math.
1678
1679Here's a more extensive illustration using vec():
1680
1681 # vec demo
1682 $vector = "\xff\x0f\xef\xfe";
1683 print "Ilya's string \\xff\\x0f\\xef\\xfe represents the number ",
1684 unpack("N", $vector), "\n";
1685 $is_set = vec($vector, 23, 1);
1686 print "Its 23rd bit is ", $is_set ? "set" : "clear", ".\n";
1687 pvec($vector);
1688
1689 set_vec(1,1,1);
1690 set_vec(3,1,1);
1691 set_vec(23,1,1);
1692
1693 set_vec(3,1,3);
1694 set_vec(3,2,3);
1695 set_vec(3,4,3);
1696 set_vec(3,4,7);
1697 set_vec(3,8,3);
1698 set_vec(3,8,7);
1699
1700 set_vec(0,32,17);
1701 set_vec(1,32,17);
1702
1703 sub set_vec {
1704 my ($offset, $width, $value) = @_;
1705 my $vector = '';
1706 vec($vector, $offset, $width) = $value;
1707 print "offset=$offset width=$width value=$value\n";
1708 pvec($vector);
1709 }
1710
1711 sub pvec {
1712 my $vector = shift;
1713 my $bits = unpack("b*", $vector);
1714 my $i = 0;
1715 my $BASE = 8;
1716
1717 print "vector length in bytes: ", length($vector), "\n";
1718 @bytes = unpack("A8" x length($vector), $bits);
1719 print "bits are: @bytes\n\n";
1720 }
1721
1722=head2 Why does defined() return true on empty arrays and hashes?
1723
1724The short story is that you should probably only use defined on scalars or
1725functions, not on aggregates (arrays and hashes). See L<perlfunc/defined>
1726in the 5.004 release or later of Perl for more detail.
1727
1728=head1 Data: Hashes (Associative Arrays)
1729
1730=head2 How do I process an entire hash?
1731
1732Use the each() function (see L<perlfunc/each>) if you don't care
1733whether it's sorted:
1734
1735 while ( ($key, $value) = each %hash) {
1736 print "$key = $value\n";
1737 }
1738
1739If you want it sorted, you'll have to use foreach() on the result of
1740sorting the keys as shown in an earlier question.
1741
1742=head2 What happens if I add or remove keys from a hash while iterating over it?
1743
1744(contributed by brian d foy)
1745
1746The easy answer is "Don't do that!"
1747
1748If you iterate through the hash with each(), you can delete the key
1749most recently returned without worrying about it. If you delete or add
1750other keys, the iterator may skip or double up on them since perl
1751may rearrange the hash table. See the
1752entry for C<each()> in L<perlfunc>.
1753
1754=head2 How do I look up a hash element by value?
1755
1756Create a reverse hash:
1757
1758 %by_value = reverse %by_key;
1759 $key = $by_value{$value};
1760
1761That's not particularly efficient. It would be more space-efficient
1762to use:
1763
1764 while (($key, $value) = each %by_key) {
1765 $by_value{$value} = $key;
1766 }
1767
1768If your hash could have repeated values, the methods above will only find
1769one of the associated keys. This may or may not worry you. If it does
1770worry you, you can always reverse the hash into a hash of arrays instead:
1771
1772 while (($key, $value) = each %by_key) {
1773 push @{$key_list_by_value{$value}}, $key;
1774 }
1775
1776=head2 How can I know how many entries are in a hash?
1777
1778If you mean how many keys, then all you have to do is
1779use the keys() function in a scalar context:
1780
1781 $num_keys = keys %hash;
1782
1783The keys() function also resets the iterator, which means that you may
1784see strange results if you use this between uses of other hash operators
1785such as each().
1786
1787=head2 How do I sort a hash (optionally by value instead of key)?
1788
1789Internally, hashes are stored in a way that prevents you from imposing
1790an order on key-value pairs. Instead, you have to sort a list of the
1791keys or values:
1792
1793 @keys = sort keys %hash; # sorted by key
1794 @keys = sort {
1795 $hash{$a} cmp $hash{$b}
1796 } keys %hash; # and by value
1797
1798Here we'll do a reverse numeric sort by value, and if two keys are
1799identical, sort by length of key, or if that fails, by straight ASCII
1800comparison of the keys (well, possibly modified by your locale--see
1801L<perllocale>).
1802
1803 @keys = sort {
1804 $hash{$b} <=> $hash{$a}
1805 ||
1806 length($b) <=> length($a)
1807 ||
1808 $a cmp $b
1809 } keys %hash;
1810
1811=head2 How can I always keep my hash sorted?
1812
1813You can look into using the DB_File module and tie() using the
1814$DB_BTREE hash bindings as documented in L<DB_File/"In Memory Databases">.
1815The Tie::IxHash module from CPAN might also be instructive.
1816
1817=head2 What's the difference between "delete" and "undef" with hashes?
1818
1819Hashes contain pairs of scalars: the first is the key, the
1820second is the value. The key will be coerced to a string,
1821although the value can be any kind of scalar: string,
1822number, or reference. If a key $key is present in
1823%hash, C<exists($hash{$key})> will return true. The value
1824for a given key can be C<undef>, in which case
1825C<$hash{$key}> will be C<undef> while C<exists $hash{$key}>
1826will return true. This corresponds to (C<$key>, C<undef>)
1827being in the hash.
1828
1829Pictures help... here's the %hash table:
1830
1831 keys values
1832 +------+------+
1833 | a | 3 |
1834 | x | 7 |
1835 | d | 0 |
1836 | e | 2 |
1837 +------+------+
1838
1839And these conditions hold
1840
1841 $hash{'a'} is true
1842 $hash{'d'} is false
1843 defined $hash{'d'} is true
1844 defined $hash{'a'} is true
1845 exists $hash{'a'} is true (Perl5 only)
1846 grep ($_ eq 'a', keys %hash) is true
1847
1848If you now say
1849
1850 undef $hash{'a'}
1851
1852your table now reads:
1853
1854
1855 keys values
1856 +------+------+
1857 | a | undef|
1858 | x | 7 |
1859 | d | 0 |
1860 | e | 2 |
1861 +------+------+
1862
1863and these conditions now hold; changes in caps:
1864
1865 $hash{'a'} is FALSE
1866 $hash{'d'} is false
1867 defined $hash{'d'} is true
1868 defined $hash{'a'} is FALSE
1869 exists $hash{'a'} is true (Perl5 only)
1870 grep ($_ eq 'a', keys %hash) is true
1871
1872Notice the last two: you have an undef value, but a defined key!
1873
1874Now, consider this:
1875
1876 delete $hash{'a'}
1877
1878your table now reads:
1879
1880 keys values
1881 +------+------+
1882 | x | 7 |
1883 | d | 0 |
1884 | e | 2 |
1885 +------+------+
1886
1887and these conditions now hold; changes in caps:
1888
1889 $hash{'a'} is false
1890 $hash{'d'} is false
1891 defined $hash{'d'} is true
1892 defined $hash{'a'} is false
1893 exists $hash{'a'} is FALSE (Perl5 only)
1894 grep ($_ eq 'a', keys %hash) is FALSE
1895
1896See, the whole entry is gone!
1897
1898=head2 Why don't my tied hashes make the defined/exists distinction?
1899
1900This depends on the tied hash's implementation of EXISTS().
1901For example, there isn't the concept of undef with hashes
1902that are tied to DBM* files. It also means that exists() and
1903defined() do the same thing with a DBM* file, and what they
1904end up doing is not what they do with ordinary hashes.
1905
1906=head2 How do I reset an each() operation part-way through?
1907
1908Using C<keys %hash> in scalar context returns the number of keys in
1909the hash I<and> resets the iterator associated with the hash. You may
1910need to do this if you use C<last> to exit a loop early so that when you
1911re-enter it, the hash iterator has been reset.
1912
1913=head2 How can I get the unique keys from two hashes?
1914
1915First you extract the keys from the hashes into lists, then solve
1916the "removing duplicates" problem described above. For example:
1917
1918 %seen = ();
1919 for $element (keys(%foo), keys(%bar)) {
1920 $seen{$element}++;
1921 }
1922 @uniq = keys %seen;
1923
1924Or more succinctly:
1925
1926 @uniq = keys %{{%foo,%bar}};
1927
1928Or if you really want to save space:
1929
1930 %seen = ();
1931 while (defined ($key = each %foo)) {
1932 $seen{$key}++;
1933 }
1934 while (defined ($key = each %bar)) {
1935 $seen{$key}++;
1936 }
1937 @uniq = keys %seen;
1938
1939=head2 How can I store a multidimensional array in a DBM file?
1940
1941Either stringify the structure yourself (no fun), or else
1942get the MLDBM (which uses Data::Dumper) module from CPAN and layer
1943it on top of either DB_File or GDBM_File.
1944
1945=head2 How can I make my hash remember the order I put elements into it?
1946
1947Use the Tie::IxHash from CPAN.
1948
1949 use Tie::IxHash;
1950 tie my %myhash, 'Tie::IxHash';
1951 for (my $i=0; $i<20; $i++) {
1952 $myhash{$i} = 2*$i;
1953 }
1954 my @keys = keys %myhash;
1955 # @keys = (0,1,2,3,...)
1956
1957=head2 Why does passing a subroutine an undefined element in a hash create it?
1958
1959If you say something like:
1960
1961 somefunc($hash{"nonesuch key here"});
1962
1963Then that element "autovivifies"; that is, it springs into existence
1964whether you store something there or not. That's because functions
1965get scalars passed in by reference. If somefunc() modifies C<$_[0]>,
1966it has to be ready to write it back into the caller's version.
1967
1968This has been fixed as of Perl5.004.
1969
1970Normally, merely accessing a key's value for a nonexistent key does
1971I<not> cause that key to be forever there. This is different than
1972awk's behavior.
1973
1974=head2 How can I make the Perl equivalent of a C structure/C++ class/hash or array of hashes or arrays?
1975
1976Usually a hash ref, perhaps like this:
1977
1978 $record = {
1979 NAME => "Jason",
1980 EMPNO => 132,
1981 TITLE => "deputy peon",
1982 AGE => 23,
1983 SALARY => 37_000,
1984 PALS => [ "Norbert", "Rhys", "Phineas"],
1985 };
1986
1987References are documented in L<perlref> and the upcoming L<perlreftut>.
1988Examples of complex data structures are given in L<perldsc> and
1989L<perllol>. Examples of structures and object-oriented classes are
1990in L<perltoot>.
1991
1992=head2 How can I use a reference as a hash key?
1993
1994(contributed by brian d foy)
1995
1996Hash keys are strings, so you can't really use a reference as the key.
1997When you try to do that, perl turns the reference into its stringified
1998form (for instance, C<HASH(0xDEADBEEF)>). From there you can't get back
1999the reference from the stringified form, at least without doing some
2000extra work on your own. Also remember that hash keys must be unique, but
2001two different variables can store the same reference (and those variables
2002can change later).
2003
2004The Tie::RefHash module, which is distributed with perl, might be what
2005you want. It handles that extra work.
2006
2007=head1 Data: Misc
2008
2009=head2 How do I handle binary data correctly?
2010
2011Perl is binary clean, so this shouldn't be a problem. For example,
2012this works fine (assuming the files are found):
2013
2014 if (`cat /vmunix` =~ /gzip/) {
2015 print "Your kernel is GNU-zip enabled!\n";
2016 }
2017
2018On less elegant (read: Byzantine) systems, however, you have
2019to play tedious games with "text" versus "binary" files. See
2020L<perlfunc/"binmode"> or L<perlopentut>.
2021
2022If you're concerned about 8-bit ASCII data, then see L<perllocale>.
2023
2024If you want to deal with multibyte characters, however, there are
2025some gotchas. See the section on Regular Expressions.
2026
2027=head2 How do I determine whether a scalar is a number/whole/integer/float?
2028
2029Assuming that you don't care about IEEE notations like "NaN" or
2030"Infinity", you probably just want to use a regular expression.
2031
2032 if (/\D/) { print "has nondigits\n" }
2033 if (/^\d+$/) { print "is a whole number\n" }
2034 if (/^-?\d+$/) { print "is an integer\n" }
2035 if (/^[+-]?\d+$/) { print "is a +/- integer\n" }
2036 if (/^-?\d+\.?\d*$/) { print "is a real number\n" }
2037 if (/^-?(?:\d+(?:\.\d*)?|\.\d+)$/) { print "is a decimal number\n" }
2038 if (/^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/)
2039 { print "a C float\n" }
2040
2041There are also some commonly used modules for the task.
2042L<Scalar::Util> (distributed with 5.8) provides access to perl's
2043internal function C<looks_like_number> for determining
2044whether a variable looks like a number. L<Data::Types>
2045exports functions that validate data types using both the
2046above and other regular expressions. Thirdly, there is
2047C<Regexp::Common> which has regular expressions to match
2048various types of numbers. Those three modules are available
2049from the CPAN.
2050
2051If you're on a POSIX system, Perl supports the C<POSIX::strtod>
2052function. Its semantics are somewhat cumbersome, so here's a C<getnum>
2053wrapper function for more convenient access. This function takes
2054a string and returns the number it found, or C<undef> for input that
2055isn't a C float. The C<is_numeric> function is a front end to C<getnum>
2056if you just want to say, "Is this a float?"
2057
2058 sub getnum {
2059 use POSIX qw(strtod);
2060 my $str = shift;
2061 $str =~ s/^\s+//;
2062 $str =~ s/\s+$//;
2063 $! = 0;
2064 my($num, $unparsed) = strtod($str);
2065 if (($str eq '') || ($unparsed != 0) || $!) {
2066 return undef;
2067 } else {
2068 return $num;
2069 }
2070 }
2071
2072 sub is_numeric { defined getnum($_[0]) }
2073
2074Or you could check out the L<String::Scanf> module on the CPAN
2075instead. The POSIX module (part of the standard Perl distribution) provides
2076the C<strtod> and C<strtol> for converting strings to double and longs,
2077respectively.
2078
2079=head2 How do I keep persistent data across program calls?
2080
2081For some specific applications, you can use one of the DBM modules.
2082See L<AnyDBM_File>. More generically, you should consult the FreezeThaw
2083or Storable modules from CPAN. Starting from Perl 5.8 Storable is part
2084of the standard distribution. Here's one example using Storable's C<store>
2085and C<retrieve> functions:
2086
2087 use Storable;
2088 store(\%hash, "filename");
2089
2090 # later on...
2091 $href = retrieve("filename"); # by ref
2092 %hash = %{ retrieve("filename") }; # direct to hash
2093
2094=head2 How do I print out or copy a recursive data structure?
2095
2096The Data::Dumper module on CPAN (or the 5.005 release of Perl) is great
2097for printing out data structures. The Storable module on CPAN (or the
20985.8 release of Perl), provides a function called C<dclone> that recursively
2099copies its argument.
2100
2101 use Storable qw(dclone);
2102 $r2 = dclone($r1);
2103
2104Where $r1 can be a reference to any kind of data structure you'd like.
2105It will be deeply copied. Because C<dclone> takes and returns references,
2106you'd have to add extra punctuation if you had a hash of arrays that
2107you wanted to copy.
2108
2109 %newhash = %{ dclone(\%oldhash) };
2110
2111=head2 How do I define methods for every class/object?
2112
2113Use the UNIVERSAL class (see L<UNIVERSAL>).
2114
2115=head2 How do I verify a credit card checksum?
2116
2117Get the Business::CreditCard module from CPAN.
2118
2119=head2 How do I pack arrays of doubles or floats for XS code?
2120
2121The kgbpack.c code in the PGPLOT module on CPAN does just this.
2122If you're doing a lot of float or double processing, consider using
2123the PDL module from CPAN instead--it makes number-crunching easy.
2124
2125=head1 AUTHOR AND COPYRIGHT
2126
2127Copyright (c) 1997-2005 Tom Christiansen, Nathan Torkington, and
2128other authors as noted. All rights reserved.
2129
2130This documentation is free; you can redistribute it and/or modify it
2131under the same terms as Perl itself.
2132
2133Irrespective of its distribution, all code examples in this file
2134are hereby placed into the public domain. You are permitted and
2135encouraged to use this code in your own programs for fun
2136or for profit as you see fit. A simple comment in the code giving
2137credit would be courteous but is not required.