t/test.pm

   1 # (X)Emacs mode: -*- cperl -*-
   2
   3 package test;
   4
   5 =head1 NAME
   6
   7 test - tools for helping in test suites (not including running externalprograms).
   8
   9 =head1 SYNOPSIS
  10
  11   use FindBin               1.42 qw( $Bin );
  12   use Test                  1.13 qw( ok plan );
  13
  14   BEGIN { unshift @INC, $Bin };
  15
  16   use test                  qw(   evcheck runcheck );
  17
  18   BEGIN {
  19     plan tests  => 3,
  20          todo   => [],
  21          ;
  22   }
  23
  24   ok evcheck(sub {
  25                open my $fh, '>', 'foo';
  26                print $fh "$_\n"
  27                  for 'Bulgaria', 'Cholet';
  28                close $fh;
  29              }, 'write foo'), 1, 'write foo';
  30
  31   save_output('stderr', *STDERR{IO});
  32   warn 'Hello, Mum!';
  33   print restore_output('stderr');
  34
  35 =head1 DESCRIPTION
  36
  37 This package provides some variables, and sets up an environment, for test
  38 scripts, such as those used in F<t/>.
  39
  40 This package does not including running external programs; that is provided by
  41 C<test2.pm>.  This is so that suites not needing that can include only
  42 test.pm, and so not require the presence of C<IPC::Run>.
  43
  44 Setting up the environment includes:
  45
  46 =over 4
  47
  48 =item Prepending F<blib/script> onto the path
  49
  50 =item Pushing the module F<lib/> dir onto the @INC var
  51
  52 For internal C<use> calls.
  53
  54 =item Changing directory to a temporary directory
  55
  56 To avoid cluttering the local dir, and/or allowing the local directory
  57 structure to affect matters.
  58
  59 =item Cleaning up the temporary directory afterwards
  60
  61 Unless TEST_DEBUG is set in the environment.
  62
  63 =back
  64
  65 =cut
  66
  67 # ----------------------------------------------------------------------------
  68
  69 # Pragmas -----------------------------
  70
  71 use 5.00503;
  72 use strict;
  73 use vars qw( @EXPORT_OK );
  74
  75 # Inheritance -------------------------
  76
  77 use base qw( Exporter );
  78
  79 =head2 EXPORTS
  80
  81 The following symbols are exported upon request:
  82
  83 =over 4
  84
  85 =item compare
  86
  87 =item evcheck
  88
  89 =item save_output
  90
  91 =item restore_output
  92
  93 =item tmpnam
  94
  95 =item tempdir
  96
  97 =item find_exec
  98
  99 =back
 100
 101 =cut
 102
 103 @EXPORT_OK = qw( evcheck save_output restore_output );
 104
 105 # Utility -----------------------------
 106
 107 use Carp                          qw( carp croak );
 108 use Cwd                      2.01 qw( cwd );
 109 use Env                           qw( PATH );
 110 use Fatal                    1.02 qw( close open seek sysopen unlink );
 111 use Fcntl                    1.03 qw( :DEFAULT );
 112 use File::Basename                qw( basename );
 113 use File::Compare          1.1002 qw( );
 114 use File::Path             1.0401 qw( mkpath rmtree );
 115 use File::Spec                0.6 qw( );
 116 use FindBin                  1.42 qw( $Bin );
 117 use POSIX                    1.02 qw( );
 118 use Test                    1.122 qw( ok skip );
 119
 120 # ----------------------------------------------------------------------------
 121
 122 sub rel2abs {
 123   if ( File::Spec->file_name_is_absolute($_[0]) ) {
 124     return $_[0];
 125   } else {
 126     return File::Spec->catdir(cwd, $_[0]);
 127   }
 128 }
 129
 130 sub min {
 131   croak "Can't min over 0 args!\n"
 132     unless @_;
 133   my $min = $_[0];
 134   for (@_[1..$#_]) {
 135     $min = $_
 136       if $_ < $min;
 137   }
 138
 139   return $min;
 140 }
 141
 142 # -------------------------------------
 143 # PACKAGE CONSTANTS
 144 # -------------------------------------
 145
 146 use constant BUILD_SCRIPT_DIR => => File::Spec->catdir( $Bin, File::Spec->updir, qw( blib script ) );
 147
 148 sub find_exec {
 149   my ($exec) = @_;
 150
 151   for (split /:/, $PATH) {
 152     my $try = File::Spec->catfile($_, $exec);
 153     return rel2abs($try)
 154       if -x $try;
 155   }
 156   return;
 157 }
 158
 159 # -------------------------------------
 160 # PACKAGE ACTIONS
 161 # -------------------------------------
 162
 163 $PATH = join ':', BUILD_SCRIPT_DIR, split /:/, $PATH;
 164
 165 $_ = rel2abs($_)
 166   for @INC;
 167
 168 my $tmpdn = tempdir();
 169 $| = 1;
 170
 171 mkpath $tmpdn;
 172 die "Couldn't create temp dir: $tmpdn: $!\n"
 173   unless -r $tmpdn and -w $tmpdn and -x $tmpdn and -o $tmpdn and -d $tmpdn;
 174
 175 #@INC = map rel2abs($_), @INC;
 176 chdir $tmpdn;
 177
 178 # -------------------------------------
 179 # PACKAGE FUNCTIONS
 180 # -------------------------------------
 181
 182 =head2 evcheck
 183
 184 Eval code, return status
 185
 186 =over 4
 187
 188 =item ARGUMENTS
 189
 190 =over 4
 191
 192 =item code
 193
 194 Coderef to eval
 195
 196 =item name
 197
 198 Name to use in error messages
 199
 200 =back
 201
 202 =item RETURNS
 203
 204 =over 4
 205
 206 =item okay
 207
 208 1 if eval was okay, 0 if not.
 209
 210 =back
 211
 212 =back
 213
 214 =cut
 215
 216 sub evcheck {
 217   my ($code, $name) = @_;
 218
 219   my $ok = 0;
 220
 221   eval {
 222     &$code;
 223     $ok = 1;
 224   }; if ( $@ ) {
 225     carp "Code $name failed: $@\n"
 226       if $ENV{TEST_DEBUG};
 227     $ok = 0;
 228   }
 229
 230   return $ok;
 231 }
 232
 233 # -------------------------------------
 234
 235 =head2 save_output
 236
 237 Redirect a filehandle to temporary storage for later examination.
 238
 239 =over 4
 240
 241 =item ARGUMENTS
 242
 243 =over 4
 244
 245 =item name
 246
 247 Name to store as (used in L<restore_output>)
 248
 249 =item filehandle
 250
 251 The filehandle to save
 252
 253 =back
 254
 255 =cut
 256
 257 # Map from names to saved filehandles.
 258
 259 # Values are arrayrefs, being filehandle that was saved (to restore), the
 260 # filehandle being printed to in the meantime, and the original filehandle.
 261 # This may be treated as a stack; to allow multiple saves... push & pop this
 262 # stack.
 263
 264 my %grabs;
 265
 266 sub save_output {
 267   croak sprintf("%s takes 2 arguments\n", (caller 0)[3])
 268     unless @_ == 2;
 269   my ($name, $filehandle) = @_;
 270
 271   my $tmpfh  = do { local *F; *F; };
 272   my $savefh = do { local *F; *F; };
 273
 274   (undef, $tmpfh) = test::tmpnam();
 275   select((select($tmpfh), $| = 1)[0]);
 276
 277   open $savefh, '>&' . fileno $filehandle
 278     or die "can't dup $name: $!";
 279   open $filehandle, '>&' . fileno $tmpfh
 280     or die "can't open $name to tempfile: $!";
 281
 282   push @{$grabs{$name}}, $savefh, $tmpfh, $filehandle;
 283 }
 284
 285 # -------------------------------------
 286
 287 =head2 restore_output
 288
 289 Restore a saved filehandle to its original state, return the saved output.
 290
 291 =over 4
 292
 293 =item ARGUMENTS
 294
 295 =over 4
 296
 297 =item name
 298
 299 Name of the filehandle to restore (as passed to L<save_output>).
 300
 301 =back
 302
 303 =item RETURNS
 304
 305 =over 4
 306
 307 =item saved_string
 308
 309 A single string being the output saved.
 310
 311 =back
 312
 313 =cut
 314
 315 sub restore_output {
 316   my ($name) = @_;
 317
 318   croak "$name has not been saved\n"
 319     unless exists $grabs{$name};
 320   croak "All saved instances of $name have been restored\n"
 321     unless @{$grabs{$name}};
 322   my ($savefh, $tmpfh, $origfh) = splice @{$grabs{$name}}, -3;
 323
 324   close $origfh
 325     or die "cannot close $name opened to tempfile: $!";
 326   open  $origfh, '>&' . fileno $savefh
 327     or die "cannot dup $name back again: $!";
 328   select((select($origfh), $| = 1)[0]);
 329
 330   seek $tmpfh, 0, 0;
 331   local $/ = undef;
 332   my $string = <$tmpfh>;
 333   close $tmpfh;
 334
 335   return $string;
 336 }
 337
 338 sub _test_save_restore_output {
 339   warn "to stderr 1\n";
 340   save_output("stderr", *STDERR{IO});
 341   warn "Hello, Mum!";
 342   print 'SAVED:->:', restore_output("stderr"), ":<-\n";
 343   warn "to stderr 2\n";
 344 }
 345
 346 # -------------------------------------
 347
 348 =head2 tmpnam
 349
 350 Very much like the one in L<POSIX> or L<File::Temp>, but does not get deleted
 351 if TEST_DEBUG has SAVE in the value.
 352
 353 =over 4
 354
 355 =item ARGUMENTS
 356
 357 =over 4
 358
 359 =item name
 360
 361 I<Optional>.  If defined, a name by which to refer to the tmpfile in user
 362 messages.
 363
 364 =back
 365
 366 =item RETURNS
 367
 368 =over 4
 369
 370 =item filename
 371
 372 Name of temporary file.
 373
 374 =item fh
 375
 376 Open filehandle to temp file, in r/w mode.  Only created & returned in list
 377 context.
 378
 379 =back
 380
 381 =back
 382
 383 =cut
 384
 385 my @tmpfns;
 386
 387 BEGIN {
 388   my $savewarn = $SIG{__WARN__};
 389   # Subvert bizarre (& incorrect) subroutine redefined errors in 5.005_03
 390   local $SIG{__WARN__} =
 391     sub {
 392       $savewarn->(@_)
 393         if defined $savewarn                        and
 394            UNIVERSAL::isa($savewarn,'CODE')         and
 395            $_[0] !~ /^Subroutine tmpnam redefined/;
 396     };
 397
 398   *tmpnam = sub {
 399     my $tmpnam = POSIX::tmpnam;
 400
 401     if (@_) {
 402       push @tmpfns, [ $tmpnam, $_[0] ];
 403     } else {
 404       push @tmpfns, $tmpnam;
 405     }
 406
 407     if (wantarray) {
 408       sysopen my $tmpfh, $tmpnam, O_RDWR | O_CREAT | O_EXCL;
 409       return $tmpnam, $tmpfh;
 410     } else {
 411       return $tmpnam;
 412     }
 413   }
 414 }
 415
 416 END {
 417   if ( defined $ENV{TEST_DEBUG} and $ENV{TEST_DEBUG} =~ /\bSAVE\b/ ) {
 418     for (@tmpfns) {
 419       if ( ref $_ ) {
 420         printf "Used temp file: %s (%s)\n", @$_;
 421       } else {
 422         print "Used temp file: $_\n";
 423       }
 424     }
 425   } else {
 426     unlink map((ref $_ ? $_->[0] : $_), @tmpfns)
 427       if @tmpfns;
 428   }
 429 }
 430
 431 # -------------------------------------
 432
 433 =head2 tempdir
 434
 435 Very much like the one in L<POSIX> or L<File::Temp>, but does not get deleted
 436 if TEST_DEBUG has SAVE in the value (does get deleted otherwise).
 437
 438 =over 4
 439
 440 =item ARGUMENTS
 441
 442 I<None>
 443
 444 =item RETURNS
 445
 446 =over 4
 447
 448 =item name
 449
 450 Name of temporary dir.
 451
 452 =back
 453
 454 =back
 455
 456 =cut
 457
 458 my @tmpdirs;
 459 sub tempdir {
 460   my $tempdir = POSIX::tmpnam;
 461   mkdir $tempdir, 0700
 462     or die "Failed to create temporary directory $tempdir: $!\n";
 463
 464   if (@_) {
 465     push @tmpdirs, [ $tempdir, $_[0] ];
 466   } else {
 467     push @tmpdirs, $tempdir;
 468   }
 469
 470   return $tempdir;
 471 }
 472
 473 END {
 474   for (@tmpdirs) {
 475     if ( ref $_ ) {
 476       if ( defined $ENV{TEST_DEBUG} and $ENV{TEST_DEBUG} =~ /\bSAVE\b/ ) {
 477         printf "Used temp dir: %s (%s)\n", @$_;
 478       } else {
 479         # Solaris gets narky about removing the pwd.
 480         chdir File::Spec->rootdir;
 481         rmtree $_->[0];
 482       }
 483     } else {
 484       if ( defined $ENV{TEST_DEBUG} and $ENV{TEST_DEBUG} =~ /\bSAVE\b/ ) {
 485         print "Used temp dir: $_\n";
 486       } else {
 487         # Solaris gets narky about removing the pwd.
 488         chdir File::Spec->rootdir;
 489         rmtree $_;
 490       }
 491     }
 492   }
 493 }
 494
 495 # -------------------------------------
 496
 497 =head2 compare
 498
 499   compare(+{ fn1 => $fn1, fn2 => $fn2, gzip => 1 });
 500
 501 This performs one test.
 502
 503 =over 4
 504
 505 =item ARGUMENTS
 506
 507 A single argument is taken, considered as a hash ref, with the following keys:
 508
 509 In TEST_DEBUG mode, if the files do not compare equal, outputs file info on
 510 STDERR.
 511
 512 =over 4
 513
 514 =item fn1
 515
 516 B<Mandatory>  File to compare
 517
 518 =item fn2
 519
 520 B<Mandatory>  File to compare
 521
 522 =item name
 523
 524 B<Mandatory>  Test name
 525
 526 =item sort
 527
 528 B<Optional> sort files prior to comparison.  Requires the C<sort> command to
 529 be on C<$PATH> (else skips).
 530
 531 =item gunzip
 532
 533 B<Optional> gunzip files prior to comparison.  Requires the C<gzip> command to
 534 be on C<$PATH> (else skips).  gzip occurs prior to any sort.
 535
 536 =item untar
 537
 538 B<Optional> untar files prior to comparison.  Requires the C<tar> command to
 539 be on C<$PATH> (else skips).  any gzip occurs prior to any tar.  Tar files are
 540 considered equal if they each contain the same filenames & each file contained
 541 is equal.  If the sort flag is present, each file is sorted prior to comparison.
 542
 543 =back
 544
 545 =back
 546
 547 =cut
 548
 549 # return codes and old-style call semantics left for backwards compatibility
 550 BEGIN {
 551   my $savewarn = $SIG{__WARN__};
 552   # Subvert bizarre (& incorrect) subroutine redefined errors in 5.005_03
 553   local $SIG{__WARN__} =
 554     sub {
 555       $savewarn->(@_)
 556         if defined $savewarn                        and
 557            UNIVERSAL::isa($savewarn,'CODE')         and
 558            $_[0] !~ /^Subroutine compare redefined/;
 559     };
 560
 561   *compare = sub {
 562     my ($fn1, $fn2, $sort) = @_;
 563     my ($gzip, $tar, $name);
 564     my $notest = 1;
 565
 566     if ( @_ == 1 and UNIVERSAL::isa($_[0], 'HASH') ) {
 567       ($fn1, $fn2, $name, $sort, $gzip, $tar, $notest) =
 568         @{$_[0]}{qw( fn1 fn2 name sort gunzip untar notest )};
 569       my @missing = grep ! defined $_[0]->{$_}, qw( fn1 fn2 name );
 570       carp "Missing mandatory key(s): " . join(', ', @missing) . "\n"
 571         if @missing;
 572     }
 573
 574     my ($name1, $name2) = ($fn1, $fn2);
 575
 576     for ( grep ! defined, $fn1, $fn2 ) {
 577       carp 'Usage: compare({fn1 => $fn1, fn2 => $fn2, name => "some name"})' ."\n"
 578           if $ENV{TEST_DEBUG};
 579       ok 0, 1, $name
 580         unless $notest;
 581       return -8;
 582     }
 583
 584     {
 585       my $err = 0;
 586
 587       for (0..1) {
 588         my $fn = ($name1, $name2)[$_];
 589         if ( ! -e $fn ) {
 590           carp "Does not exist: $fn\n"
 591             if $ENV{TEST_DEBUG};
 592           $err |= 2 ** $_;
 593         } elsif ( ! -r $fn ) {
 594           carp "Cannot read: $fn\n"
 595             if $ENV{TEST_DEBUG};
 596           $err |= 2 ** $_;
 597         }
 598       }
 599
 600       if ( $err ) {
 601         ok 0, 1, $name
 602           unless $notest;
 603         return -$err;
 604       }
 605     }
 606
 607     if ( $gzip ) {
 608       unless ( find_exec('gzip') ) {
 609         print "ok # Skip gzip not found in path\n";
 610         return -16;
 611       }
 612
 613       my $tmp1 = tmpnam;
 614       my $tmp2 = tmpnam;
 615       system "gzip $fn1 -cd > $tmp1"
 616         and croak "gzip $fn1 failed: $?\n";
 617       system "gzip $fn2 -cd > $tmp2"
 618         and croak "gzip $fn2 failed: $?\n";
 619       ($fn1, $fn2) = ($tmp1, $tmp2);
 620     }
 621
 622     if ( $tar ) {
 623       unless ( find_exec('tar') ) {
 624         print "ok # Skip tar not found in path\n";
 625         return -16;
 626       }
 627
 628       local $/ = "\n";
 629       chomp (my @list1 = sort qx( tar tf $fn1 ));
 630       croak "tar tf $fn1 failed with wait status: $?\n"
 631         if $?;
 632       chomp(my @list2 = sort qx( tar tf $fn2 ));
 633       croak "tar tf $fn2 failed with wait status: $?\n"
 634         if $?;
 635
 636       if ( @list2 > @list1 ) {
 637         carp
 638           sprintf("More files (%d) in $name2 than $name1 (%d)\n",
 639                   scalar @list2, scalar @list1)
 640           if $ENV{TEST_DEBUG};
 641         ok @list1, @list2, $name
 642           unless $notest;
 643         return 0;
 644       } elsif ( @list1 > @list2 ) {
 645         carp
 646           sprintf("More files (%d) in $name1 than $name2 (%d)\n",
 647                   scalar @list1, scalar @list2)
 648           if $ENV{TEST_DEBUG};
 649         ok @list1, @list2, $name
 650           unless $notest;
 651         return 0;
 652       }
 653
 654       for (my $i = 0; $i < @list1; $i++) {
 655         if ( $list1[$i] lt $list2[$i] ) {
 656           carp "File $list1[$i] is present in $name1 but not $name2\n"
 657             if $ENV{TEST_DEBUG};
 658           ok $list1[$i], $list2[$i], $name
 659             unless $notest;
 660           return 0;
 661         } elsif ( $list1[$i] gt $list2[$i] ) {
 662           carp "File $list2[$i] is present in $name2 but not $name1\n"
 663             if $ENV{TEST_DEBUG};
 664           ok $list2[$i], $list1[$i], $name
 665             unless $notest;
 666           return 0;
 667         }
 668       }
 669
 670       for my $fn (@list1) {
 671         my $tmp1 = tmpnam;
 672         my $tmp2 = tmpnam;
 673         system "tar -xf $fn1 -O $fn > $tmp1"
 674           and croak "tar -xf $fn1 -O $fn failed: $?\n";
 675         system "tar -xf $fn2 -O $fn > $tmp2"
 676           and croak "tar -xf $fn2 -O $fn failed: $?\n";
 677         my $ok = compare({ fn1    => $tmp1,
 678                            fn2    => $tmp2,
 679                            sort   => $sort,
 680                            notest => 1,
 681                            name   =>
 682                              qq'Subcheck file "$fn" for compare $name1, $name2',
 683                          });
 684         unless ( $ok >= 1 ) {
 685           carp qq'Difference found testing file "$fn" in tars $name1 ($tmp1), $name2 ($tmp2)\n'
 686             if $ENV{TEST_DEBUG};
 687           ok 0, 1, $name
 688             unless $notest;
 689           return 0;
 690         }
 691       }
 692
 693       ok 1, 1, $name
 694         unless $notest;
 695       return 1;
 696     }
 697
 698     if ( $sort ) {
 699       unless ( find_exec('sort') ) {
 700         print "ok # Skip sort not found in path\n";
 701         return -16;
 702       }
 703
 704       my $tmp1 = tmpnam;
 705       my $tmp2 = tmpnam;
 706       system sort => $fn1, -o => $tmp1
 707         and croak "Sort $fn1 failed: $?\n";
 708       system sort => $fn2, -o => $tmp2
 709         and croak "Sort $fn2 failed: $?\n";
 710       ($fn1, $fn2) = ($tmp1, $tmp2);
 711     }
 712
 713     unless ( File::Compare::compare($fn1, $fn2) ) {
 714       ok 1, 1, $name
 715         unless $notest;
 716       return 1;
 717     }
 718
 719     if ( $ENV{TEST_DEBUG} ) {
 720       my $pid = fork;
 721       die "Fork failed: $!\n"
 722         unless defined $pid;
 723
 724       if ( $pid ) { # Parent
 725         my $waitpid = waitpid($pid, 0);
 726         die "Waitpid got: $waitpid (expected $pid)\n"
 727           unless $waitpid == $pid;
 728       } else { # Child
 729         open *STDOUT{IO}, ">&" . fileno STDERR;
 730         # Uniquify file names
 731         my @args = keys %{+{ map {;$_=>1} $name1, $name2, $fn1, $fn2 }};
 732         exec qw(ls -l), @args;
 733       }
 734
 735       my $fh1 = IO::File->new($fn1, O_RDONLY)
 736         or die "Couldn't open $fn1: $!\n";
 737       my $fh2 = IO::File->new($fn2, O_RDONLY)
 738         or die "Couldn't open $fn2: $!\n";
 739
 740       local $/ = "\n";
 741
 742       my $found = 0;
 743       while ( ! $found and my $line1 = <$fh1> ) {
 744         my $line2 = <$fh2>;
 745         if ( ! defined $line2 ) {
 746           print STDERR "$fn2 ended at line: $.\n";
 747           $found = 1;
 748         } elsif ( $line2 ne $line1 ) {
 749           my $maxlength = max(map length($_), $line1, $line2);
 750           my $minlength = min(map length($_), $line1, $line2);
 751
 752           my @diffchars = grep(substr($line1, $_, 1) ne substr($line2, $_, 1),
 753                                0..$minlength-1);
 754           my $diff = ' ' x $minlength;
 755           substr($diff, $_, 1) = '|'
 756             for @diffchars;
 757
 758           my @extrachars, map((length($line1) > length($line2) ? '^' : 'v'),
 759                               $minlength..$maxlength-1);
 760
 761           $diff = join '', $diff, @extrachars;
 762
 763           my $diff_count  = @diffchars;
 764           my $extra_count = @extrachars;
 765
 766           print STDERR <<"END";
 767 Difference at line $. ($diff_count characters differ) (top line is $extra_count chars longer):
 768 $name1:
 769 -->$line1<--
 770    $diff
 771 -->$line2<--
 772 $name2:
 773 Differing characters at positions @{[join ',',@diffchars]} (zero-based)
 774 END
 775           $found = 1;
 776         }
 777       }
 778
 779       if ( ! $found ) {
 780         my $line2 = <$fh2>;
 781         if ( defined $line2 ) {
 782           print STDERR "$name1 ended before line: $.\n";
 783         } else {
 784           print STDERR "Difference between $name1, $name2 not found!\n";
 785         }
 786       }
 787
 788       close $fh1;
 789       close $fh2;
 790     }
 791
 792     ok 0, 1, $name
 793       unless $notest;
 794     return 0;
 795   }
 796 }
 797
 798 # -------------------------------------
 799
 800 =head2 find_exec
 801
 802 =over 4
 803
 804 =item ARGUMENTS
 805
 806 =over 4
 807
 808 =item proggie
 809
 810 The name of the program
 811
 812 =back
 813
 814 =item RETURNS
 815
 816 =over 4
 817
 818 =item path
 819
 820 The path to the first executable file with the given name on C<$PATH>.  Or
 821 nothing, if no such file exists.
 822
 823 =back
 824
 825 =back
 826
 827 =cut
 828
 829 # defined further up to use in constants
 830
 831 # ----------------------------------------------------------------------------
 832
 833 =head1 EXAMPLES
 834
 835 Z<>
 836
 837 =head1 BUGS
 838
 839 Z<>
 840
 841 =head1 REPORTING BUGS
 842
 843 Email the author.
 844
 845 =head1 AUTHOR
 846
 847 Martyn J. Pearce C<fluffy@cpan.org>
 848
 849 =head1 COPYRIGHT
 850
 851 Copyright (c) 2001, 2002, 2004 Martyn J. Pearce.  This program is free
 852 software; you can redistribute it and/or modify it under the same terms as
 853 Perl itself.
 854
 855 =head1 SEE ALSO
 856
 857 Z<>
 858
 859 =cut
 860
 861 1; # keep require happy.
 862
 863 __END__