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.000014';
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 irrelevant -- 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 );
523 while (defined( my $line = <$fh> )) {
528 # From toke.c : any line that begins by "=X", where X is an alphabetic
529 # character, introduces a POD segment.
531 if ( $line =~ /^=([a-zA-Z].*)/ ) {
533 # Then it goes back to Perl code for "=cutX" where X is a non-alphabetic
534 # character (which includes the newline, but here we chomped it away).
535 $is_cut = $cmd =~ /^cut(?:[^a-zA-Z]|$)/;
541 if ( $line =~ /^=head[1-4]\s+(.+)\s*$/ ) {
543 if ( $self->{collect_pod} && length( $pod_data ) ) {
544 $pod{$pod_sect} = $pod_data;
549 } elsif ( $self->{collect_pod} ) {
550 $pod_data .= "$line\n";
554 } elsif ( $is_cut ) {
556 if ( $self->{collect_pod} && length( $pod_data ) ) {
557 $pod{$pod_sect} = $pod_data;
567 # Skip comments in code
568 next if $line =~ /^\s*#/;
570 # Would be nice if we could also check $in_string or something too
571 if ($line eq '__END__') {
575 last if $line eq '__DATA__';
577 # parse $line to see if it's a $VERSION declaration
578 my( $vers_sig, $vers_fullname, $vers_pkg ) =
580 ? $self->_parse_version_expression( $line )
583 if ( $line =~ /$PKG_REGEXP/o ) {
585 push( @pkgs, $pkg ) unless grep( $pkg eq $_, @pkgs );
586 $vers{$pkg} = $2 unless exists( $vers{$pkg} );
587 $need_vers = defined $2 ? 0 : 1;
589 # VERSION defined with full package spec, i.e. $Module::VERSION
590 } elsif ( $vers_fullname && $vers_pkg ) {
591 push( @pkgs, $vers_pkg ) unless grep( $vers_pkg eq $_, @pkgs );
592 $need_vers = 0 if $vers_pkg eq $pkg;
594 unless ( defined $vers{$vers_pkg} && length $vers{$vers_pkg} ) {
596 $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
599 # first non-comment line in undeclared package main is VERSION
600 } elsif ( !exists($vers{main}) && $pkg eq 'main' && $vers_fullname ) {
603 $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
605 push( @pkgs, 'main' );
607 # first non-comment line in undeclared package defines package main
608 } elsif ( !exists($vers{main}) && $pkg eq 'main' && $line =~ /\w+/ ) {
611 push( @pkgs, 'main' );
613 # only keep if this is the first $VERSION seen
614 } elsif ( $vers_fullname && $need_vers ) {
617 $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
620 unless ( defined $vers{$pkg} && length $vers{$pkg} ) {
630 if ( $self->{collect_pod} && length($pod_data) ) {
631 $pod{$pod_sect} = $pod_data;
634 $self->{versions} = \%vers;
635 $self->{packages} = \@pkgs;
636 $self->{pod} = \%pod;
637 $self->{pod_headings} = \@pod;
642 sub _evaluate_version_line {
644 my( $sigil, $var, $line ) = @_;
646 # Some of this code came from the ExtUtils:: hierarchy.
648 # We compile into $vsub because 'use version' would cause
649 # compiletime/runtime issues with local()
651 $pn++; # everybody gets their own package
652 my $eval = qq{BEGIN { q# Hide from _packages_inside()
653 #; package Module::Metadata::_version::p$pn;
666 # Try to get the $VERSION
668 # some modules say $VERSION = $Foo::Bar::VERSION, but Foo::Bar isn't
669 # installed, so we need to hunt in ./lib for it
670 if ( $@ =~ /Can't locate/ && -d 'lib' ) {
671 local @INC = ('lib',@INC);
674 warn "Error evaling version line '$eval' in $self->{filename}: $@\n"
676 (ref($vsub) eq 'CODE') or
677 croak "failed to build version sub for $self->{filename}";
678 my $result = eval { $vsub->() };
679 croak "Could not get version from $self->{filename} by executing:\n$eval\n\nThe fatal error was: $@\n"
682 # Upgrade it into a version object
683 my $version = eval { _dwim_version($result) };
685 croak "Version '$result' from $self->{filename} does not appear to be valid:\n$eval\n\nThe fatal error was: $@\n"
686 unless defined $version; # "0" is OK!
692 # Try to DWIM when things fail the lax version test in obvious ways
695 # Best case, it just works
696 sub { return shift },
698 # If we still don't have a version, try stripping any
699 # trailing junk that is prohibited by lax rules
702 $v =~ s{([0-9])[a-z-].*$}{$1}i; # 1.23-alpha or 1.23b
706 # Activestate apparently creates custom versions like '1.23_45_01', which
707 # cause version.pm to think it's an invalid alpha. So check for that
711 my $num_dots = () = $v =~ m{(\.)}g;
712 my $num_unders = () = $v =~ m{(_)}g;
713 my $leading_v = substr($v,0,1) eq 'v';
714 if ( ! $leading_v && $num_dots < 2 && $num_unders > 1 ) {
716 $num_unders = () = $v =~ m{(_)}g;
721 # Worst case, try numifying it like we would have before version objects
724 no warnings 'numeric';
731 my ($result) = shift;
733 return $result if ref($result) eq 'version';
735 my ($version, $error);
736 for my $f (@version_prep) {
737 $result = $f->($result);
738 $version = eval { version->new($result) };
739 $error ||= $@ if $@; # capture first failure
740 last if defined $version;
743 croak $error unless defined $version;
749 ############################################################
752 sub name { $_[0]->{module} }
754 sub filename { $_[0]->{filename} }
755 sub packages_inside { @{$_[0]->{packages}} }
756 sub pod_inside { @{$_[0]->{pod_headings}} }
757 sub contains_pod { 0+@{$_[0]->{pod_headings}} }
761 my $mod = shift || $self->{module};
763 if ( defined( $mod ) && length( $mod ) &&
764 exists( $self->{versions}{$mod} ) ) {
765 return $self->{versions}{$mod};
774 if ( defined( $sect ) && length( $sect ) &&
775 exists( $self->{pod}{$sect} ) ) {
776 return $self->{pod}{$sect};
786 Module::Metadata - Gather package and POD information from perl module files
790 use Module::Metadata;
792 # information about a .pm file
793 my $info = Module::Metadata->new_from_file( $file );
794 my $version = $info->version;
796 # CPAN META 'provides' field for .pm files in a directory
797 my $provides = Module::Metadata->provides(
798 dir => 'lib', version => 2
803 This module provides a standard way to gather metadata about a .pm file
804 without executing unsafe code.
812 =item C<< new_from_file($filename, collect_pod => 1) >>
814 Constructs a C<Module::Metadata> object given the path to a file. Returns
815 undef if the filename does not exist.
817 C<collect_pod> is a optional boolean argument that determines whether POD
818 data is collected and stored for reference. POD data is not collected by
819 default. POD headings are always collected.
821 If the file begins by an UTF-8, UTF-16BE or UTF-16LE byte-order mark, then
822 it is skipped before processing, and the content of the file is also decoded
823 appropriately starting from perl 5.8.
825 =item C<< new_from_handle($handle, $filename, collect_pod => 1) >>
827 This works just like C<new_from_file>, except that a handle can be provided
828 as the first argument.
830 Note that there is no validation to confirm that the handle is a handle or
831 something that can act like one. Passing something that isn't a handle will
832 cause a exception when trying to read from it. The C<filename> argument is
833 mandatory or undef will be returned.
835 You are responsible for setting the decoding layers on C<$handle> if
838 =item C<< new_from_module($module, collect_pod => 1, inc => \@dirs) >>
840 Constructs a C<Module::Metadata> object given a module or package name.
841 Returns undef if the module cannot be found.
843 In addition to accepting the C<collect_pod> argument as described above,
844 this method accepts a C<inc> argument which is a reference to an array of
845 directories to search for the module. If none are given, the default is
848 If the file that contains the module begins by an UTF-8, UTF-16BE or
849 UTF-16LE byte-order mark, then it is skipped before processing, and the
850 content of the file is also decoded appropriately starting from perl 5.8.
852 =item C<< find_module_by_name($module, \@dirs) >>
854 Returns the path to a module given the module or package name. A list
855 of directories can be passed in as an optional parameter, otherwise
858 Can be called as either an object or a class method.
860 =item C<< find_module_dir_by_name($module, \@dirs) >>
862 Returns the entry in C<@dirs> (or C<@INC> by default) that contains
863 the module C<$module>. A list of directories can be passed in as an
864 optional parameter, otherwise @INC is searched.
866 Can be called as either an object or a class method.
868 =item C<< provides( %options ) >>
870 This is a convenience wrapper around C<package_versions_from_directory>
871 to generate a CPAN META C<provides> data structure. It takes key/value
872 pairs. Valid option keys include:
876 =item version B<(required)>
878 Specifies which version of the L<CPAN::Meta::Spec> should be used as
879 the format of the C<provides> output. Currently only '1.4' and '2'
880 are supported (and their format is identical). This may change in
881 the future as the definition of C<provides> changes.
883 The C<version> option is required. If it is omitted or if
884 an unsupported version is given, then C<provides> will throw an error.
888 Directory to search recursively for F<.pm> files. May not be specified with
893 Array reference of files to examine. May not be specified with C<dir>.
897 String to prepend to the C<file> field of the resulting output. This defaults
898 to F<lib>, which is the common case for most CPAN distributions with their
899 F<.pm> files in F<lib>. This option ensures the META information has the
900 correct relative path even when the C<dir> or C<files> arguments are
901 absolute or have relative paths from a location other than the distribution
906 For example, given C<dir> of 'lib' and C<prefix> of 'lib', the return value
907 is a hashref of the form:
912 file => 'lib/Package/Name.pm'
914 'OtherPackage::Name' => ...
917 =item C<< package_versions_from_directory($dir, \@files?) >>
919 Scans C<$dir> for .pm files (unless C<@files> is given, in which case looks
920 for those files in C<$dir> - and reads each file for packages and versions,
921 returning a hashref of the form:
926 file => 'Package/Name.pm'
928 'OtherPackage::Name' => ...
931 The C<DB> and C<main> packages are always omitted, as are any "private"
932 packages that have leading underscores in the namespace (e.g.
935 Note that the file path is relative to C<$dir> if that is specified.
936 This B<must not> be used directly for CPAN META C<provides>. See
937 the C<provides> method instead.
939 =item C<< log_info (internal) >>
941 Used internally to perform logging; imported from Log::Contextual if
942 Log::Contextual has already been loaded, otherwise simply calls warn.
946 =head2 Object methods
952 Returns the name of the package represented by this module. If there
953 are more than one packages, it makes a best guess based on the
954 filename. If it's a script (i.e. not a *.pm) the package name is
957 =item C<< version($package) >>
959 Returns the version as defined by the $VERSION variable for the
960 package as returned by the C<name> method if no arguments are
961 given. If given the name of a package it will attempt to return the
962 version of that package if it is specified in the file.
964 =item C<< filename() >>
966 Returns the absolute path to the file.
968 =item C<< packages_inside() >>
970 Returns a list of packages. Note: this is a raw list of packages
971 discovered (or assumed, in the case of C<main>). It is not
972 filtered for C<DB>, C<main> or private packages the way the
973 C<provides> method does. Invalid package names are not returned,
974 for example "Foo:Bar". Strange but valid package names are
975 returned, for example "Foo::Bar::", and are left up to the caller
978 =item C<< pod_inside() >>
980 Returns a list of POD sections.
982 =item C<< contains_pod() >>
984 Returns true if there is any POD in the file.
986 =item C<< pod($section) >>
988 Returns the POD data in the given section.
994 Original code from Module::Build::ModuleInfo by Ken Williams
995 <kwilliams@cpan.org>, Randy W. Sims <RandyS@ThePierianSpring.org>
997 Released as Module::Metadata by Matt S Trout (mst) <mst@shadowcat.co.uk> with
998 assistance from David Golden (xdg) <dagolden@cpan.org>.
1000 =head1 COPYRIGHT & LICENSE
1002 Original code Copyright (c) 2001-2011 Ken Williams.
1003 Additional code Copyright (c) 2010-2011 Matt Trout and David Golden.
1004 All rights reserved.
1006 This library is free software; you can redistribute it and/or
1007 modify it under the same terms as Perl itself.