1 # -*- mode: cperl; tab-width: 8; indent-tabs-mode: nil; basic-offset: 2 -*-
2 # vim:ts=8:sw=2:et:sta:sts=2
3 package Module::Metadata;
5 # Adapted from Perl-licensed code originally distributed with
6 # Module-Build by Ken Williams
8 # This module provides routines to gather information about
9 # perl modules (assuming this may be expanded in the distant
10 # parrot future to look at other types of modules).
13 use vars qw($VERSION);
14 $VERSION = '1.000011';
15 $VERSION = eval $VERSION;
22 if ($INC{'Log/Contextual.pm'}) {
23 Log::Contextual->import('log_info');
25 *log_info = sub (&) { warn $_[0]->() };
28 use File::Find qw(find);
30 my $V_NUM_REGEXP = qr{v?[0-9._]+}; # crudely, a v-string or decimal
32 my $PKG_FIRST_WORD_REGEXP = qr{ # the FIRST word in a package name
33 [a-zA-Z_] # the first word CANNOT start with a digit
35 [\w']? # can contain letters, digits, _, or ticks
36 \w # But, NO multi-ticks or trailing ticks
40 my $PKG_ADDL_WORD_REGEXP = qr{ # the 2nd+ word in a package name
41 \w # the 2nd+ word CAN start with digits
43 [\w']? # and can contain letters or ticks
44 \w # But, NO multi-ticks or trailing ticks
48 my $PKG_NAME_REGEXP = qr{ # match a package name
49 (?: :: )? # a pkg name can start with aristotle
50 $PKG_FIRST_WORD_REGEXP # a package word
52 (?: :: )+ ### aristotle (allow one or many times)
53 $PKG_ADDL_WORD_REGEXP ### a package word
54 )* # ^ zero, one or many times
56 :: # allow trailing aristotle
60 my $PKG_REGEXP = qr{ # match a package declaration
61 ^[\s\{;]* # intro chars on a line
62 package # the word 'package'
64 ($PKG_NAME_REGEXP) # a package name
65 \s* # optional whitespace
66 ($V_NUM_REGEXP)? # optional version number
67 \s* # optional whitesapce
68 [;\{] # semicolon line terminator or block start (since 5.16)
71 my $VARNAME_REGEXP = qr{ # match fully-qualified VERSION name
72 ([\$*]) # sigil - $ or *
74 ( # optional leading package name
75 (?:::|\')? # possibly starting like just :: (Ì la $::VERSION)
76 (?:\w+(?:::|\'))* # Foo::Bar:: ...
82 my $VERS_REGEXP = qr{ # match a VERSION definition
84 \(\s*$VARNAME_REGEXP\s*\) # with parens
86 $VARNAME_REGEXP # without parens
89 =[^=~] # = but not ==, nor =~
94 my $filename = File::Spec->rel2abs( shift );
96 return undef unless defined( $filename ) && -f $filename;
97 return $class->_init(undef, $filename, @_);
100 sub new_from_handle {
103 my $filename = shift;
104 return undef unless defined($handle) && defined($filename);
105 $filename = File::Spec->rel2abs( $filename );
107 return $class->_init(undef, $filename, @_, handle => $handle);
112 sub new_from_module {
117 $props{inc} ||= \@INC;
118 my $filename = $class->find_module_by_name( $module, $props{inc} );
119 return undef unless defined( $filename ) && -f $filename;
120 return $class->_init($module, $filename, %props);
125 my $compare_versions = sub {
126 my ($v1, $op, $v2) = @_;
127 $v1 = version->new($v1)
128 unless UNIVERSAL::isa($v1,'version');
130 my $eval_str = "\$v1 $op \$v2";
131 my $result = eval $eval_str;
132 log_info { "error comparing versions: '$eval_str' $@" } if $@;
137 my $normalize_version = sub {
139 if ( $version =~ /[=<>!,]/ ) { # logic, not just version
140 # take as is without modification
142 elsif ( ref $version eq 'version' ) { # version objects
143 $version = $version->is_qv ? $version->normal : $version->stringify;
145 elsif ( $version =~ /^[^v][^.]*\.[^.]+\./ ) { # no leading v, multiple dots
146 # normalize string tuples without "v": "1.2.3" -> "v1.2.3"
147 $version = "v$version";
155 # separate out some of the conflict resolution logic
157 my $resolve_module_versions = sub {
158 my $packages = shift;
160 my( $file, $version );
162 foreach my $p ( @$packages ) {
163 if ( defined( $p->{version} ) ) {
164 if ( defined( $version ) ) {
165 if ( $compare_versions->( $version, '!=', $p->{version} ) ) {
166 $err .= " $p->{file} ($p->{version})\n";
168 # same version declared multiple times, ignore
172 $version = $p->{version};
175 $file ||= $p->{file} if defined( $p->{file} );
179 $err = " $file ($version)\n" . $err;
194 croak "provides() requires key/value pairs \n" if @_ % 2;
197 croak "provides() takes only one of 'dir' or 'files'\n"
198 if $args{dir} && $args{files};
200 croak "provides() requires a 'version' argument"
201 unless defined $args{version};
203 croak "provides() does not support version '$args{version}' metadata"
204 unless grep { $args{version} eq $_ } qw/1.4 2/;
206 $args{prefix} = 'lib' unless defined $args{prefix};
210 $p = $class->package_versions_from_directory($args{dir});
213 croak "provides() requires 'files' to be an array reference\n"
214 unless ref $args{files} eq 'ARRAY';
215 $p = $class->package_versions_from_directory($args{files});
218 # Now, fix up files with prefix
219 if ( length $args{prefix} ) { # check in case disabled with q{}
220 $args{prefix} =~ s{/$}{};
221 for my $v ( values %$p ) {
222 $v->{file} = "$args{prefix}/$v->{file}";
229 sub package_versions_from_directory {
230 my ( $class, $dir, $files ) = @_;
239 push @files, $_ if -f $_ && /\.pm$/;
245 # First, we enumerate all packages & versions,
246 # separating into primary & alternative candidates
248 foreach my $file (@files) {
249 my $mapped_filename = File::Spec::Unix->abs2rel( $file, $dir );
250 my @path = split( /\//, $mapped_filename );
251 (my $prime_package = join( '::', @path )) =~ s/\.pm$//;
253 my $pm_info = $class->new_from_file( $file );
255 foreach my $package ( $pm_info->packages_inside ) {
256 next if $package eq 'main'; # main can appear numerous times, ignore
257 next if $package eq 'DB'; # special debugging package, ignore
258 next if grep /^_/, split( /::/, $package ); # private package, ignore
260 my $version = $pm_info->version( $package );
262 $prime_package = $package if lc($prime_package) eq lc($package);
263 if ( $package eq $prime_package ) {
264 if ( exists( $prime{$package} ) ) {
265 croak "Unexpected conflict in '$package'; multiple versions found.\n";
267 $mapped_filename = "$package.pm" if lc("$package.pm") eq lc($mapped_filename);
268 $prime{$package}{file} = $mapped_filename;
269 $prime{$package}{version} = $version if defined( $version );
272 push( @{$alt{$package}}, {
273 file => $mapped_filename,
280 # Then we iterate over all the packages found above, identifying conflicts
281 # and selecting the "best" candidate for recording the file & version
283 foreach my $package ( keys( %alt ) ) {
284 my $result = $resolve_module_versions->( $alt{$package} );
286 if ( exists( $prime{$package} ) ) { # primary package selected
288 if ( $result->{err} ) {
289 # Use the selected primary package, but there are conflicting
290 # errors among multiple alternative packages that need to be
293 "Found conflicting versions for package '$package'\n" .
294 " $prime{$package}{file} ($prime{$package}{version})\n" .
298 } elsif ( defined( $result->{version} ) ) {
299 # There is a primary package selected, and exactly one
300 # alternative package
302 if ( exists( $prime{$package}{version} ) &&
303 defined( $prime{$package}{version} ) ) {
304 # Unless the version of the primary package agrees with the
305 # version of the alternative package, report a conflict
306 if ( $compare_versions->(
307 $prime{$package}{version}, '!=', $result->{version}
312 "Found conflicting versions for package '$package'\n" .
313 " $prime{$package}{file} ($prime{$package}{version})\n" .
314 " $result->{file} ($result->{version})\n"
319 # The prime package selected has no version so, we choose to
320 # use any alternative package that does have a version
321 $prime{$package}{file} = $result->{file};
322 $prime{$package}{version} = $result->{version};
326 # no alt package found with a version, but we have a prime
327 # package so we use it whether it has a version or not
330 } else { # No primary package was selected, use the best alternative
332 if ( $result->{err} ) {
334 "Found conflicting versions for package '$package'\n" .
339 # Despite possible conflicting versions, we choose to record
340 # something rather than nothing
341 $prime{$package}{file} = $result->{file};
342 $prime{$package}{version} = $result->{version}
343 if defined( $result->{version} );
347 # Normalize versions. Can't use exists() here because of bug in YAML::Node.
348 # XXX "bug in YAML::Node" comment seems irrelvant -- dagolden, 2009-05-18
349 for (grep defined $_->{version}, values %prime) {
350 $_->{version} = $normalize_version->( $_->{version} );
361 my $filename = shift;
364 my $handle = delete $props{handle};
365 my( %valid_props, @valid_props );
366 @valid_props = qw( collect_pod inc );
367 @valid_props{@valid_props} = delete( @props{@valid_props} );
368 warn "Unknown properties: @{[keys %props]}\n" if scalar( %props );
372 filename => $filename,
383 my $self = bless(\%data, $class);
386 $self->_parse_fh($handle);
389 $self->_parse_file();
392 unless($self->{module} and length($self->{module})) {
393 my ($v, $d, $f) = File::Spec->splitpath($self->{filename});
396 my @candidates = grep /$f$/, @{$self->{packages}};
397 $self->{module} = shift(@candidates); # punt
400 if(grep /main/, @{$self->{packages}}) {
401 $self->{module} = 'main';
404 $self->{module} = $self->{packages}[0] || '';
409 $self->{version} = $self->{versions}{$self->{module}}
410 if defined( $self->{module} );
416 sub _do_find_module {
418 my $module = shift || croak 'find_module_by_name() requires a package name';
419 my $dirs = shift || \@INC;
421 my $file = File::Spec->catfile(split( /::/, $module));
422 foreach my $dir ( @$dirs ) {
423 my $testfile = File::Spec->catfile($dir, $file);
424 return [ File::Spec->rel2abs( $testfile ), $dir ]
425 if -e $testfile and !-d _; # For stuff like ExtUtils::xsubpp
426 return [ File::Spec->rel2abs( "$testfile.pm" ), $dir ]
427 if -e "$testfile.pm";
433 sub find_module_by_name {
434 my $found = shift()->_do_find_module(@_) or return;
439 sub find_module_dir_by_name {
440 my $found = shift()->_do_find_module(@_) or return;
445 # given a line of perl code, attempt to parse it if it looks like a
446 # $VERSION assignment, returning sigil, full name, & package name
447 sub _parse_version_expression {
451 my( $sig, $var, $pkg );
452 if ( $line =~ /$VERS_REGEXP/o ) {
453 ( $sig, $var, $pkg ) = $2 ? ( $1, $2, $3 ) : ( $4, $5, $6 );
455 $pkg = ($pkg eq '::') ? 'main' : $pkg;
460 return ( $sig, $var, $pkg );
466 my $filename = $self->{filename};
467 my $fh = IO::File->new( $filename )
468 or croak( "Can't open '$filename': $!" );
470 $self->_handle_bom($fh, $filename);
472 $self->_parse_fh($fh);
475 # Look for a UTF-8/UTF-16BE/UTF-16LE BOM at the beginning of the stream.
476 # If there's one, then skip it and set the :encoding layer appropriately.
478 my ($self, $fh, $filename) = @_;
480 my $pos = $fh->getpos;
481 return unless defined $pos;
484 my $count = $fh->read( $buf, length $buf );
485 return unless defined $count and $count >= 2;
488 if ( $buf eq "\x{FE}\x{FF}" ) {
489 $encoding = 'UTF-16BE';
490 } elsif ( $buf eq "\x{FF}\x{FE}" ) {
491 $encoding = 'UTF-16LE';
492 } elsif ( $buf eq "\x{EF}\x{BB}" ) {
494 $count = $fh->read( $buf, length $buf );
495 if ( defined $count and $count >= 1 and $buf eq "\x{BF}" ) {
500 if ( defined $encoding ) {
501 if ( "$]" >= 5.008 ) {
502 # $fh->binmode requires perl 5.10
503 binmode( $fh, ":encoding($encoding)" );
507 or croak( sprintf "Can't reset position to the top of '$filename'" );
514 my ($self, $fh) = @_;
516 my( $in_pod, $seen_end, $need_vers ) = ( 0, 0, 0 );
517 my( @pkgs, %vers, %pod, @pod );
522 while (defined( my $line = <$fh> )) {
527 # From toke.c : any line that begins by "=X", where X is an alphabetic
528 # character, introduces a POD segment.
530 if ( $line =~ /^=([a-zA-Z].*)/ ) {
532 # Then it goes back to Perl code for "=cutX" where X is a non-alphabetic
533 # character (which includes the newline, but here we chomped it away).
534 $is_cut = $cmd =~ /^cut(?:[^a-zA-Z]|$)/;
540 if ( $line =~ /^=head[1-4]\s+(.+)\s*$/ ) {
542 if ( $self->{collect_pod} && length( $pod_data ) ) {
543 $pod{$pod_sect} = $pod_data;
548 } elsif ( $self->{collect_pod} ) {
549 $pod_data .= "$line\n";
553 } elsif ( $is_cut ) {
555 if ( $self->{collect_pod} && length( $pod_data ) ) {
556 $pod{$pod_sect} = $pod_data;
563 # Skip comments in code
564 next if $line =~ /^\s*#/;
566 # Would be nice if we could also check $in_string or something too
567 last if $line =~ /^__(?:DATA|END)__$/;
569 # parse $line to see if it's a $VERSION declaration
570 my( $vers_sig, $vers_fullname, $vers_pkg ) =
572 ? $self->_parse_version_expression( $line )
575 if ( $line =~ /$PKG_REGEXP/o ) {
577 push( @pkgs, $pkg ) unless grep( $pkg eq $_, @pkgs );
578 $vers{$pkg} = $2 unless exists( $vers{$pkg} );
579 $need_vers = defined $2 ? 0 : 1;
581 # VERSION defined with full package spec, i.e. $Module::VERSION
582 } elsif ( $vers_fullname && $vers_pkg ) {
583 push( @pkgs, $vers_pkg ) unless grep( $vers_pkg eq $_, @pkgs );
584 $need_vers = 0 if $vers_pkg eq $pkg;
586 unless ( defined $vers{$vers_pkg} && length $vers{$vers_pkg} ) {
588 $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
591 # first non-comment line in undeclared package main is VERSION
592 } elsif ( !exists($vers{main}) && $pkg eq 'main' && $vers_fullname ) {
595 $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
597 push( @pkgs, 'main' );
599 # first non-comment line in undeclared package defines package main
600 } elsif ( !exists($vers{main}) && $pkg eq 'main' && $line =~ /\w+/ ) {
603 push( @pkgs, 'main' );
605 # only keep if this is the first $VERSION seen
606 } elsif ( $vers_fullname && $need_vers ) {
609 $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
612 unless ( defined $vers{$pkg} && length $vers{$pkg} ) {
622 if ( $self->{collect_pod} && length($pod_data) ) {
623 $pod{$pod_sect} = $pod_data;
626 $self->{versions} = \%vers;
627 $self->{packages} = \@pkgs;
628 $self->{pod} = \%pod;
629 $self->{pod_headings} = \@pod;
634 sub _evaluate_version_line {
636 my( $sigil, $var, $line ) = @_;
638 # Some of this code came from the ExtUtils:: hierarchy.
640 # We compile into $vsub because 'use version' would cause
641 # compiletime/runtime issues with local()
643 $pn++; # everybody gets their own package
644 my $eval = qq{BEGIN { q# Hide from _packages_inside()
645 #; package Module::Metadata::_version::p$pn;
658 # Try to get the $VERSION
660 # some modules say $VERSION = $Foo::Bar::VERSION, but Foo::Bar isn't
661 # installed, so we need to hunt in ./lib for it
662 if ( $@ =~ /Can't locate/ && -d 'lib' ) {
663 local @INC = ('lib',@INC);
666 warn "Error evaling version line '$eval' in $self->{filename}: $@\n"
668 (ref($vsub) eq 'CODE') or
669 croak "failed to build version sub for $self->{filename}";
670 my $result = eval { $vsub->() };
671 croak "Could not get version from $self->{filename} by executing:\n$eval\n\nThe fatal error was: $@\n"
674 # Upgrade it into a version object
675 my $version = eval { _dwim_version($result) };
677 croak "Version '$result' from $self->{filename} does not appear to be valid:\n$eval\n\nThe fatal error was: $@\n"
678 unless defined $version; # "0" is OK!
684 # Try to DWIM when things fail the lax version test in obvious ways
687 # Best case, it just works
688 sub { return shift },
690 # If we still don't have a version, try stripping any
691 # trailing junk that is prohibited by lax rules
694 $v =~ s{([0-9])[a-z-].*$}{$1}i; # 1.23-alpha or 1.23b
698 # Activestate apparently creates custom versions like '1.23_45_01', which
699 # cause version.pm to think it's an invalid alpha. So check for that
703 my $num_dots = () = $v =~ m{(\.)}g;
704 my $num_unders = () = $v =~ m{(_)}g;
705 my $leading_v = substr($v,0,1) eq 'v';
706 if ( ! $leading_v && $num_dots < 2 && $num_unders > 1 ) {
708 $num_unders = () = $v =~ m{(_)}g;
713 # Worst case, try numifying it like we would have before version objects
716 no warnings 'numeric';
723 my ($result) = shift;
725 return $result if ref($result) eq 'version';
727 my ($version, $error);
728 for my $f (@version_prep) {
729 $result = $f->($result);
730 $version = eval { version->new($result) };
731 $error ||= $@ if $@; # capture first failure
732 last if defined $version;
735 croak $error unless defined $version;
741 ############################################################
744 sub name { $_[0]->{module} }
746 sub filename { $_[0]->{filename} }
747 sub packages_inside { @{$_[0]->{packages}} }
748 sub pod_inside { @{$_[0]->{pod_headings}} }
749 sub contains_pod { 0+@{$_[0]->{pod_headings}} }
753 my $mod = shift || $self->{module};
755 if ( defined( $mod ) && length( $mod ) &&
756 exists( $self->{versions}{$mod} ) ) {
757 return $self->{versions}{$mod};
766 if ( defined( $sect ) && length( $sect ) &&
767 exists( $self->{pod}{$sect} ) ) {
768 return $self->{pod}{$sect};
778 Module::Metadata - Gather package and POD information from perl module files
782 use Module::Metadata;
784 # information about a .pm file
785 my $info = Module::Metadata->new_from_file( $file );
786 my $version = $info->version;
788 # CPAN META 'provides' field for .pm files in a directory
789 my $provides = Module::Metadata->provides(
790 dir => 'lib', version => 2
795 This module provides a standard way to gather metadata about a .pm file
796 without executing unsafe code.
804 =item C<< new_from_file($filename, collect_pod => 1) >>
806 Constructs a C<Module::Metadata> object given the path to a file. Returns
807 undef if the filename does not exist.
809 C<collect_pod> is a optional boolean argument that determines whether POD
810 data is collected and stored for reference. POD data is not collected by
811 default. POD headings are always collected.
813 If the file begins by an UTF-8, UTF-16BE or UTF-16LE byte-order mark, then
814 it is skipped before processing, and the content of the file is also decoded
815 appropriately starting from perl 5.8.
817 =item C<< new_from_handle($handle, $filename, collect_pod => 1) >>
819 This works just like C<new_from_file>, except that a handle can be provided
820 as the first argument.
822 Note that there is no validation to confirm that the handle is a handle or
823 something that can act like one. Passing something that isn't a handle will
824 cause a exception when trying to read from it. The C<filename> argument is
825 mandatory or undef will be returned.
827 You are responsible for setting the decoding layers on C<$handle> if
830 =item C<< new_from_module($module, collect_pod => 1, inc => \@dirs) >>
832 Constructs a C<Module::Metadata> object given a module or package name.
833 Returns undef if the module cannot be found.
835 In addition to accepting the C<collect_pod> argument as described above,
836 this method accepts a C<inc> argument which is a reference to an array of
837 directories to search for the module. If none are given, the default is
840 If the file that contains the module begins by an UTF-8, UTF-16BE or
841 UTF-16LE byte-order mark, then it is skipped before processing, and the
842 content of the file is also decoded appropriately starting from perl 5.8.
844 =item C<< find_module_by_name($module, \@dirs) >>
846 Returns the path to a module given the module or package name. A list
847 of directories can be passed in as an optional parameter, otherwise
850 Can be called as either an object or a class method.
852 =item C<< find_module_dir_by_name($module, \@dirs) >>
854 Returns the entry in C<@dirs> (or C<@INC> by default) that contains
855 the module C<$module>. A list of directories can be passed in as an
856 optional parameter, otherwise @INC is searched.
858 Can be called as either an object or a class method.
860 =item C<< provides( %options ) >>
862 This is a convenience wrapper around C<package_versions_from_directory>
863 to generate a CPAN META C<provides> data structure. It takes key/value
864 pairs. Valid option keys include:
868 =item version B<(required)>
870 Specifies which version of the L<CPAN::Meta::Spec> should be used as
871 the format of the C<provides> output. Currently only '1.4' and '2'
872 are supported (and their format is identical). This may change in
873 the future as the definition of C<provides> changes.
875 The C<version> option is required. If it is omitted or if
876 an unsupported version is given, then C<provides> will throw an error.
880 Directory to search recursively for F<.pm> files. May not be specified with
885 Array reference of files to examine. May not be specified with C<dir>.
889 String to prepend to the C<file> field of the resulting output. This defaults
890 to F<lib>, which is the common case for most CPAN distributions with their
891 F<.pm> files in F<lib>. This option ensures the META information has the
892 correct relative path even when the C<dir> or C<files> arguments are
893 absolute or have relative paths from a location other than the distribution
898 For example, given C<dir> of 'lib' and C<prefix> of 'lib', the return value
899 is a hashref of the form:
904 file => 'lib/Package/Name.pm'
906 'OtherPackage::Name' => ...
909 =item C<< package_versions_from_directory($dir, \@files?) >>
911 Scans C<$dir> for .pm files (unless C<@files> is given, in which case looks
912 for those files in C<$dir> - and reads each file for packages and versions,
913 returning a hashref of the form:
918 file => 'Package/Name.pm'
920 'OtherPackage::Name' => ...
923 The C<DB> and C<main> packages are always omitted, as are any "private"
924 packages that have leading underscores in the namespace (e.g.
927 Note that the file path is relative to C<$dir> if that is specified.
928 This B<must not> be used directly for CPAN META C<provides>. See
929 the C<provides> method instead.
931 =item C<< log_info (internal) >>
933 Used internally to perform logging; imported from Log::Contextual if
934 Log::Contextual has already been loaded, otherwise simply calls warn.
938 =head2 Object methods
944 Returns the name of the package represented by this module. If there
945 are more than one packages, it makes a best guess based on the
946 filename. If it's a script (i.e. not a *.pm) the package name is
949 =item C<< version($package) >>
951 Returns the version as defined by the $VERSION variable for the
952 package as returned by the C<name> method if no arguments are
953 given. If given the name of a package it will attempt to return the
954 version of that package if it is specified in the file.
956 =item C<< filename() >>
958 Returns the absolute path to the file.
960 =item C<< packages_inside() >>
962 Returns a list of packages. Note: this is a raw list of packages
963 discovered (or assumed, in the case of C<main>). It is not
964 filtered for C<DB>, C<main> or private packages the way the
965 C<provides> method does. Invalid package names are not returned,
966 for example "Foo:Bar". Strange but valid package names are
967 returned, for example "Foo::Bar::", and are left up to the caller
970 =item C<< pod_inside() >>
972 Returns a list of POD sections.
974 =item C<< contains_pod() >>
976 Returns true if there is any POD in the file.
978 =item C<< pod($section) >>
980 Returns the POD data in the given section.
986 Original code from Module::Build::ModuleInfo by Ken Williams
987 <kwilliams@cpan.org>, Randy W. Sims <RandyS@ThePierianSpring.org>
989 Released as Module::Metadata by Matt S Trout (mst) <mst@shadowcat.co.uk> with
990 assistance from David Golden (xdg) <dagolden@cpan.org>.
992 =head1 COPYRIGHT & LICENSE
994 Original code Copyright (c) 2001-2011 Ken Williams.
995 Additional code Copyright (c) 2010-2011 Matt Trout and David Golden.
998 This library is free software; you can redistribute it and/or
999 modify it under the same terms as Perl itself.