5 # $^C was only introduced in 5.005-ish. We do this to prevent
6 # use of uninitialized value warnings in older perls.
10 use vars qw($VERSION $CLASS);
14 my $IsVMS = $^O eq 'VMS';
16 # Make Test::Builder thread-safe for ithreads.
19 if( $] >= 5.008 && $Config{useithreads} ) {
21 require threads::shared;
22 threads::shared->import;
33 my $Original_Pid = $$;
34 my $Curr_Test = 0; share($Curr_Test);
35 my @Test_Results = (); share(@Test_Results);
36 my @Test_Details = (); share(@Test_Details);
41 Test::Builder - Backend for building test libraries
45 package My::Test::Module;
51 my $Test = Test::Builder->new;
52 $Test->output('my_logfile');
58 $Test->exported_to($pack);
61 $self->export_to_level(1, $self, 'ok');
65 my($test, $name) = @_;
67 $Test->ok($test, $name);
73 Test::Simple and Test::More have proven to be popular testing modules,
74 but they're not always flexible enough. Test::Builder provides the a
75 building block upon which to write your own test libraries I<which can
84 my $Test = Test::Builder->new;
86 Returns a Test::Builder object representing the current state of the
89 Since you only run one test per program, there is B<one and only one>
90 Test::Builder object. No matter how many times you call new(), you're
91 getting the same object. (This is called a singleton).
98 $Test ||= bless ['Move along, nothing to see here'], $class;
104 =head2 Setting up tests
106 These methods are for setting up tests and declaring how many there
107 are. You usually only want to call one of these methods.
113 my $pack = $Test->exported_to;
114 $Test->exported_to($pack);
116 Tells Test::Builder what package you exported your functions to.
117 This is important for getting TODO tests right.
123 my($self, $pack) = @_;
125 if( defined $pack ) {
126 $Exported_To = $pack;
133 $Test->plan('no_plan');
134 $Test->plan( skip_all => $reason );
135 $Test->plan( tests => $num_tests );
137 A convenient way to set up your tests. Call this and Test::Builder
138 will print the appropriate headers and take the appropriate actions.
140 If you call plan(), don't call any of the other methods below.
145 my($self, $cmd, $arg) = @_;
150 die sprintf "You tried to plan twice! Second plan at %s line %d\n",
151 ($self->caller)[1,2];
154 if( $cmd eq 'no_plan' ) {
157 elsif( $cmd eq 'skip_all' ) {
158 return $self->skip_all($arg);
160 elsif( $cmd eq 'tests' ) {
162 return $self->expected_tests($arg);
164 elsif( !defined $arg ) {
165 die "Got an undefined number of tests. Looks like you tried to ".
166 "say how many tests you plan to run but made a mistake.\n";
169 die "You said to run 0 tests! You've got to run something.\n";
174 my @args = grep { defined } ($cmd, $arg);
175 Carp::croak("plan() doesn't understand @args");
181 =item B<expected_tests>
183 my $max = $Test->expected_tests;
184 $Test->expected_tests($max);
186 Gets/sets the # of tests we expect this test to run and prints out
187 the appropriate headers.
191 my $Expected_Tests = 0;
193 my($self, $max) = @_;
196 $Expected_Tests = $max;
199 $self->_print("1..$max\n") unless $self->no_header;
201 return $Expected_Tests;
209 Declares that this test will run an indeterminate # of tests.
221 $plan = $Test->has_plan
223 Find out whether a plan has been defined. $plan is either C<undef> (no plan has been set), C<no_plan> (indeterminate # of tests) or an integer (the number of expected tests).
228 return($Expected_Tests) if $Expected_Tests;
229 return('no_plan') if $No_Plan;
237 $Test->skip_all($reason);
239 Skips all the tests, using the given $reason. Exits immediately with 0.
245 my($self, $reason) = @_;
248 $out .= " # Skip $reason" if $reason;
253 $self->_print($out) unless $self->no_header;
261 These actually run the tests, analogous to the functions in
264 $name is always optional.
270 $Test->ok($test, $name);
272 Your basic test. Pass if $test is true, fail if $test is false. Just
273 like Test::Simple's ok().
278 my($self, $test, $name) = @_;
280 # $test might contain an object which we don't want to accidentally
281 # store, so we turn it into a boolean.
282 $test = $test ? 1 : 0;
284 unless( $Have_Plan ) {
286 Carp::croak("You tried to run a test without a plan! Gotta have a plan.");
292 $self->diag(<<ERR) if defined $name and $name =~ /^[\d\s]+$/;
293 You named your test '$name'. You shouldn't use numbers for your test names.
297 my($pack, $file, $line) = $self->caller;
299 my $todo = $self->todo($pack);
307 @$result{ 'ok', 'actual_ok' } = ( ( $todo ? 1 : 0 ), 0 );
310 @$result{ 'ok', 'actual_ok' } = ( 1, $test );
314 $out .= " $Curr_Test" if $self->use_numbers;
316 if( defined $name ) {
317 $name =~ s|#|\\#|g; # # in a name can confuse Test::Harness.
319 $result->{name} = $name;
322 $result->{name} = '';
326 my $what_todo = $todo;
327 $out .= " # TODO $what_todo";
328 $result->{reason} = $what_todo;
329 $result->{type} = 'todo';
332 $result->{reason} = '';
333 $result->{type} = '';
336 $Test_Results[$Curr_Test-1] = $result;
342 my $msg = $todo ? "Failed (TODO)" : "Failed";
343 $self->diag(" $msg test ($file at line $line)\n");
346 return $test ? 1 : 0;
351 $Test->is_eq($got, $expected, $name);
353 Like Test::More's is(). Checks if $got eq $expected. This is the
358 $Test->is_num($got, $expected, $name);
360 Like Test::More's is(). Checks if $got == $expected. This is the
366 my($self, $got, $expect, $name) = @_;
367 local $Level = $Level + 1;
369 if( !defined $got || !defined $expect ) {
370 # undef only matches undef and nothing else
371 my $test = !defined $got && !defined $expect;
373 $self->ok($test, $name);
374 $self->_is_diag($got, 'eq', $expect) unless $test;
378 return $self->cmp_ok($got, 'eq', $expect, $name);
382 my($self, $got, $expect, $name) = @_;
383 local $Level = $Level + 1;
385 if( !defined $got || !defined $expect ) {
386 # undef only matches undef and nothing else
387 my $test = !defined $got && !defined $expect;
389 $self->ok($test, $name);
390 $self->_is_diag($got, '==', $expect) unless $test;
394 return $self->cmp_ok($got, '==', $expect, $name);
398 my($self, $got, $type, $expect) = @_;
400 foreach my $val (\$got, \$expect) {
401 if( defined $$val ) {
402 if( $type eq 'eq' ) {
403 # quote and force string context
407 # force numeric context
416 return $self->diag(sprintf <<DIAGNOSTIC, $got, $expect);
425 $Test->isnt_eq($got, $dont_expect, $name);
427 Like Test::More's isnt(). Checks if $got ne $dont_expect. This is
432 $Test->is_num($got, $dont_expect, $name);
434 Like Test::More's isnt(). Checks if $got ne $dont_expect. This is
440 my($self, $got, $dont_expect, $name) = @_;
441 local $Level = $Level + 1;
443 if( !defined $got || !defined $dont_expect ) {
444 # undef only matches undef and nothing else
445 my $test = defined $got || defined $dont_expect;
447 $self->ok($test, $name);
448 $self->_cmp_diag('ne', $got, $dont_expect) unless $test;
452 return $self->cmp_ok($got, 'ne', $dont_expect, $name);
456 my($self, $got, $dont_expect, $name) = @_;
457 local $Level = $Level + 1;
459 if( !defined $got || !defined $dont_expect ) {
460 # undef only matches undef and nothing else
461 my $test = defined $got || defined $dont_expect;
463 $self->ok($test, $name);
464 $self->_cmp_diag('!=', $got, $dont_expect) unless $test;
468 return $self->cmp_ok($got, '!=', $dont_expect, $name);
474 $Test->like($this, qr/$regex/, $name);
475 $Test->like($this, '/$regex/', $name);
477 Like Test::More's like(). Checks if $this matches the given $regex.
479 You'll want to avoid qr// if you want your tests to work before 5.005.
483 $Test->unlike($this, qr/$regex/, $name);
484 $Test->unlike($this, '/$regex/', $name);
486 Like Test::More's unlike(). Checks if $this B<does not match> the
492 my($self, $this, $regex, $name) = @_;
494 local $Level = $Level + 1;
495 $self->_regex_ok($this, $regex, '=~', $name);
499 my($self, $this, $regex, $name) = @_;
501 local $Level = $Level + 1;
502 $self->_regex_ok($this, $regex, '!~', $name);
507 $Test->maybe_regex(qr/$regex/);
508 $Test->maybe_regex('/$regex/');
510 Convenience method for building testing functions that take regular
511 expressions as arguments, but need to work before perl 5.005.
513 Takes a quoted regular expression produced by qr//, or a string
514 representing a regular expression.
516 Returns a Perl value which may be used instead of the corresponding
517 regular expression, or undef if it's argument is not recognised.
519 For example, a version of like(), sans the useful diagnostic messages,
523 my ($self, $this, $regex, $name) = @_;
524 my $usable_regex = $self->maybe_regex($regex);
525 die "expecting regex, found '$regex'\n"
526 unless $usable_regex;
527 $self->ok($this =~ m/$usable_regex/, $name);
534 my ($self, $regex) = @_;
535 my $usable_regex = undef;
536 if( ref $regex eq 'Regexp' ) {
537 $usable_regex = $regex;
539 # Check if it looks like '/foo/'
540 elsif( my($re, $opts) = $regex =~ m{^ /(.*)/ (\w*) $ }sx ) {
541 $usable_regex = length $opts ? "(?$opts)$re" : $re;
543 return($usable_regex)
547 my($self, $this, $regex, $cmp, $name) = @_;
549 local $Level = $Level + 1;
552 my $usable_regex = $self->maybe_regex($regex);
553 unless (defined $usable_regex) {
554 $ok = $self->ok( 0, $name );
555 $self->diag(" '$regex' doesn't look much like a regex to me.");
561 my $test = $this =~ /$usable_regex/ ? 1 : 0;
562 $test = !$test if $cmp eq '!~';
563 $ok = $self->ok( $test, $name );
567 $this = defined $this ? "'$this'" : 'undef';
568 my $match = $cmp eq '=~' ? "doesn't match" : "matches";
569 $self->diag(sprintf <<DIAGNOSTIC, $this, $match, $regex);
581 $Test->cmp_ok($this, $type, $that, $name);
583 Works just like Test::More's cmp_ok().
585 $Test->cmp_ok($big_num, '!=', $other_big_num);
590 my($self, $got, $type, $expect, $name) = @_;
595 local($@,$!); # don't interfere with $@
596 # eval() sometimes resets $!
597 $test = eval "\$got $type \$expect";
599 local $Level = $Level + 1;
600 my $ok = $self->ok($test, $name);
603 if( $type =~ /^(eq|==)$/ ) {
604 $self->_is_diag($got, $type, $expect);
607 $self->_cmp_diag($got, $type, $expect);
614 my($self, $got, $type, $expect) = @_;
616 $got = defined $got ? "'$got'" : 'undef';
617 $expect = defined $expect ? "'$expect'" : 'undef';
618 return $self->diag(sprintf <<DIAGNOSTIC, $got, $type, $expect);
627 $Test->BAILOUT($reason);
629 Indicates to the Test::Harness that things are going so badly all
630 testing should terminate. This includes running any additional test
633 It will exit with 255.
638 my($self, $reason) = @_;
640 $self->_print("Bail out! $reason");
649 Skips the current test, reporting $why.
654 my($self, $why) = @_;
657 unless( $Have_Plan ) {
659 Carp::croak("You tried to run tests without a plan! Gotta have a plan.");
674 $Test_Results[$Curr_Test-1] = \%result;
677 $out .= " $Curr_Test" if $self->use_numbers;
678 $out .= " # skip $why\n";
689 $Test->todo_skip($why);
691 Like skip(), only it will declare the test as failing and TODO. Similar
694 print "not ok $tnum # TODO $why\n";
699 my($self, $why) = @_;
702 unless( $Have_Plan ) {
704 Carp::croak("You tried to run tests without a plan! Gotta have a plan.");
720 $Test_Results[$Curr_Test-1] = \%result;
723 $out .= " $Curr_Test" if $self->use_numbers;
724 $out .= " # TODO & SKIP $why\n";
732 =begin _unimplemented
737 $Test->skip_rest($reason);
739 Like skip(), only it skips all the rest of the tests you plan to run
740 and terminates the test.
742 If you're running under no_plan, it skips once and terminates the
756 $Test->level($how_high);
758 How far up the call stack should $Test look when reporting where the
763 Setting $Test::Builder::Level overrides. This is typically useful
767 local $Test::Builder::Level = 2;
774 my($self, $level) = @_;
776 if( defined $level ) {
787 $Test->use_numbers($on_or_off);
789 Whether or not the test should output numbers. That is, this if true:
801 Most useful when you can't depend on the test output order, such as
802 when threads or forking is involved.
804 Test::Harness will accept either, but avoid mixing the two styles.
812 my($self, $use_nums) = @_;
814 if( defined $use_nums ) {
815 $Use_Nums = $use_nums;
822 $Test->no_header($no_header);
824 If set to true, no "1..N" header will be printed.
828 $Test->no_ending($no_ending);
830 Normally, Test::Builder does some extra diagnostics when the test
831 ends. It also changes the exit code as described in Test::Simple.
833 If this is true, none of that will be done.
837 my($No_Header, $No_Ending) = (0,0);
839 my($self, $no_header) = @_;
841 if( defined $no_header ) {
842 $No_Header = $no_header;
848 my($self, $no_ending) = @_;
850 if( defined $no_ending ) {
851 $No_Ending = $no_ending;
861 Controlling where the test output goes.
863 It's ok for your test to change where STDOUT and STDERR point to,
864 Test::Builder's default output settings will not be affected.
872 Prints out the given $message. Normally, it uses the failure_output()
873 handle, but if this is for a TODO test, the todo_output() handle is
876 Output will be indented and marked with a # so as not to interfere
877 with test output. A newline will be put on the end if there isn't one
880 We encourage using this rather than calling print directly.
882 Returns false. Why? Because diag() is often used in conjunction with
883 a failing test (C<ok() || diag()>) it "passes through" the failure.
885 return ok(...) || diag(...);
888 Mark Fowler <mark@twoshortplanks.com>
893 my($self, @msgs) = @_;
896 # Prevent printing headers when compiling (i.e. -c)
899 # Escape each line with a #.
901 $_ = 'undef' unless defined;
905 push @msgs, "\n" unless $msgs[-1] =~ /\n\Z/;
907 local $Level = $Level + 1;
908 my $fh = $self->todo ? $self->todo_output : $self->failure_output;
909 local($\, $", $,) = (undef, ' ', '');
919 $Test->_print(@msgs);
921 Prints to the output() filehandle.
928 my($self, @msgs) = @_;
930 # Prevent printing headers when only compiling. Mostly for when
931 # tests are deparsed with B::Deparse
934 local($\, $", $,) = (undef, ' ', '');
935 my $fh = $self->output;
937 # Escape each line after the first with a # so we don't
938 # confuse Test::Harness.
943 push @msgs, "\n" unless $msgs[-1] =~ /\n\Z/;
952 $Test->output($file);
954 Where normal "ok/not ok" test output should go.
958 =item B<failure_output>
960 $Test->failure_output($fh);
961 $Test->failure_output($file);
963 Where diagnostic output on test failures and diag() should go.
969 $Test->todo_output($fh);
970 $Test->todo_output($file);
972 Where diagnostics about todo test failures and diag() should go.
978 my($Out_FH, $Fail_FH, $Todo_FH);
983 $Out_FH = _new_fh($fh);
992 $Fail_FH = _new_fh($fh);
1001 $Todo_FH = _new_fh($fh);
1007 my($file_or_fh) = shift;
1010 unless( UNIVERSAL::isa($file_or_fh, 'GLOB') ) {
1011 $fh = do { local *FH };
1012 open $fh, ">$file_or_fh" or
1013 die "Can't open test output log $file_or_fh: $!";
1023 # We dup STDOUT and STDERR so people can change them in their
1024 # test suites while still getting normal test output.
1025 open(TESTOUT, ">&STDOUT") or die "Can't dup STDOUT: $!";
1026 open(TESTERR, ">&STDERR") or die "Can't dup STDERR: $!";
1028 # Set everything to unbuffered else plain prints to STDOUT will
1029 # come out in the wrong order from our own prints.
1030 _autoflush(\*TESTOUT);
1031 _autoflush(\*STDOUT);
1032 _autoflush(\*TESTERR);
1033 _autoflush(\*STDERR);
1035 $CLASS->output(\*TESTOUT);
1036 $CLASS->failure_output(\*TESTERR);
1037 $CLASS->todo_output(\*TESTOUT);
1042 my $old_fh = select $fh;
1051 =head2 Test Status and Info
1055 =item B<current_test>
1057 my $curr_test = $Test->current_test;
1058 $Test->current_test($num);
1060 Gets/sets the current test # we're on.
1062 You usually shouldn't have to set this.
1067 my($self, $num) = @_;
1070 if( defined $num ) {
1071 unless( $Have_Plan ) {
1073 Carp::croak("Can't change the current test number without a plan!");
1077 if( $num > @Test_Results ) {
1078 my $start = @Test_Results ? $#Test_Results + 1 : 0;
1079 for ($start..$num-1) {
1082 %result = ( ok => 1,
1084 reason => 'incrementing test number',
1088 $Test_Results[$_] = \%result;
1098 my @tests = $Test->summary;
1100 A simple summary of the tests so far. True for pass, false for fail.
1101 This is a logical pass/fail, so todos are passes.
1103 Of course, test #1 is $tests[0], etc...
1110 return map { $_->{'ok'} } @Test_Results;
1115 my @tests = $Test->details;
1117 Like summary(), but with a lot more detail.
1119 $tests[$test_num - 1] =
1120 { 'ok' => is the test considered a pass?
1121 actual_ok => did it literally say 'ok'?
1122 name => name of the test (if any)
1123 type => type of test (if any, see below).
1124 reason => reason for the above (if any)
1127 'ok' is true if Test::Harness will consider the test to be a pass.
1129 'actual_ok' is a reflection of whether or not the test literally
1130 printed 'ok' or 'not ok'. This is for examining the result of 'todo'
1133 'name' is the name of the test.
1135 'type' indicates if it was a special test. Normal tests have a type
1136 of ''. Type can be one of the following:
1140 todo_skip see todo_skip()
1143 Sometimes the Test::Builder test counter is incremented without it
1144 printing any test output, for example, when current_test() is changed.
1145 In these cases, Test::Builder doesn't know the result of the test, so
1146 it's type is 'unkown'. These details for these tests are filled in.
1147 They are considered ok, but the name and actual_ok is left undef.
1149 For example "not ok 23 - hole count # TODO insufficient donuts" would
1150 result in this structure:
1152 $tests[22] = # 23 - 1, since arrays start from 0.
1153 { ok => 1, # logically, the test passed since it's todo
1154 actual_ok => 0, # in absolute terms, it failed
1155 name => 'hole count',
1157 reason => 'insufficient donuts'
1163 return @Test_Results;
1168 my $todo_reason = $Test->todo;
1169 my $todo_reason = $Test->todo($pack);
1171 todo() looks for a $TODO variable in your tests. If set, all tests
1172 will be considered 'todo' (see Test::More and Test::Harness for
1173 details). Returns the reason (ie. the value of $TODO) if running as
1174 todo tests, false otherwise.
1176 todo() is pretty part about finding the right package to look for
1177 $TODO in. It uses the exported_to() package to find it. If that's
1178 not set, it's pretty good at guessing the right package to look at.
1180 Sometimes there is some confusion about where todo() should be looking
1181 for the $TODO variable. If you want to be sure, tell it explicitly
1187 my($self, $pack) = @_;
1189 $pack = $pack || $self->exported_to || $self->caller(1);
1192 return defined ${$pack.'::TODO'} ? ${$pack.'::TODO'}
1198 my $package = $Test->caller;
1199 my($pack, $file, $line) = $Test->caller;
1200 my($pack, $file, $line) = $Test->caller($height);
1202 Like the normal caller(), except it reports according to your level().
1207 my($self, $height) = @_;
1210 my @caller = CORE::caller($self->level + $height + 1);
1211 return wantarray ? @caller : $caller[0];
1222 =item B<_sanity_check>
1226 Runs a bunch of end of test sanity checks to make sure reality came
1227 through ok. If anything is wrong it will die with a fairly friendly
1234 _whoa($Curr_Test < 0, 'Says here you ran a negative number of tests!');
1235 _whoa(!$Have_Plan and $Curr_Test,
1236 'Somehow your tests ran without a plan!');
1237 _whoa($Curr_Test != @Test_Results,
1238 'Somehow you got a different number of results than tests ran!');
1243 _whoa($check, $description);
1245 A sanity check, similar to assert(). If the $check is true, something
1246 has gone horribly wrong. It will die with the given $description and
1247 a note to contact the author.
1252 my($check, $desc) = @_;
1256 This should never happen! Please contact the author immediately!
1263 _my_exit($exit_num);
1265 Perl seems to have some trouble with exiting inside an END block. 5.005_03
1266 and 5.6.1 both seem to do odd things. Instead, this function edits $?
1267 directly. It should ONLY be called from inside an END block. It
1268 doesn't actually exit, that's your job.
1285 $SIG{__DIE__} = sub {
1286 # We don't want to muck with death in an eval, but $^S isn't
1287 # totally reliable. 5.005_03 and 5.6.1 both do the wrong thing
1288 # with it. Instead, we use caller. This also means it runs under
1291 for( my $stack = 1; my $sub = (CORE::caller($stack))[3]; $stack++ ) {
1292 $in_eval = 1 if $sub =~ /^\(eval\)/;
1294 $Test_Died = 1 unless $in_eval;
1302 # Don't bother with an ending if this is a forked copy. Only the parent
1303 # should do the ending.
1304 do{ _my_exit($?) && return } if $Original_Pid != $$;
1306 # Bailout if plan() was never called. This is so
1307 # "require Test::Simple" doesn't puke.
1308 do{ _my_exit(0) && return } if !$Have_Plan && !$Test_Died;
1310 # Figure out if we passed or failed and print helpful messages.
1311 if( @Test_Results ) {
1312 # The plan? We have no plan.
1314 $self->_print("1..$Curr_Test\n") unless $self->no_header;
1315 $Expected_Tests = $Curr_Test;
1318 # 5.8.0 threads bug. Shared arrays will not be auto-extended
1319 # by a slice. Worse, we have to fill in every entry else
1320 # we'll get an "Invalid value for shared scalar" error
1321 for my $idx ($#Test_Results..$Expected_Tests-1) {
1322 my %empty_result = ();
1323 share(%empty_result);
1324 $Test_Results[$idx] = \%empty_result
1325 unless defined $Test_Results[$idx];
1328 my $num_failed = grep !$_->{'ok'}, @Test_Results[0..$Expected_Tests-1];
1329 $num_failed += abs($Expected_Tests - @Test_Results);
1331 if( $Curr_Test < $Expected_Tests ) {
1332 $self->diag(<<"FAIL");
1333 Looks like you planned $Expected_Tests tests but only ran $Curr_Test.
1336 elsif( $Curr_Test > $Expected_Tests ) {
1337 my $num_extra = $Curr_Test - $Expected_Tests;
1338 $self->diag(<<"FAIL");
1339 Looks like you planned $Expected_Tests tests but ran $num_extra extra.
1342 elsif ( $num_failed ) {
1343 $self->diag(<<"FAIL");
1344 Looks like you failed $num_failed tests of $Expected_Tests.
1349 $self->diag(<<"FAIL");
1350 Looks like your test died just after $Curr_Test.
1353 _my_exit( 255 ) && return;
1356 _my_exit( $num_failed <= 254 ? $num_failed : 254 ) && return;
1358 elsif ( $Skip_All ) {
1359 _my_exit( 0 ) && return;
1361 elsif ( $Test_Died ) {
1362 $self->diag(<<'FAIL');
1363 Looks like your test died before it could output anything.
1367 $self->diag("No tests run!\n");
1368 _my_exit( 255 ) && return;
1373 $Test->_ending if defined $Test and !$Test->no_ending;
1378 In perl 5.8.0 and later, Test::Builder is thread-safe. The test
1379 number is shared amongst all threads. This means if one thread sets
1380 the test number using current_test() they will all be effected.
1384 CPAN can provide the best examples. Test::Simple, Test::More,
1385 Test::Exception and Test::Differences all use Test::Builder.
1389 Test::Simple, Test::More, Test::Harness
1393 Original code by chromatic, maintained by Michael G Schwern
1394 E<lt>schwern@pobox.comE<gt>
1398 Copyright 2002 by chromatic E<lt>chromatic@wgz.orgE<gt>,
1399 Michael G Schwern E<lt>schwern@pobox.comE<gt>.
1401 This program is free software; you can redistribute it and/or
1402 modify it under the same terms as Perl itself.
1404 See F<http://www.perl.com/perl/misc/Artistic.html>