X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FModule%2FMetadata.pm;h=6902a1a6c926eb827edca7e1c25595b8b5bf9b69;hb=9a855c0e4e08016937bdde54d9b979202c80b571;hp=0afa14e11fbbd85817ea852bcf0e0c66c431946d;hpb=141ef4bd703e52632c28b3fea6f2c30b19dde2f2;p=p5sagit%2FModule-Metadata.git diff --git a/lib/Module/Metadata.pm b/lib/Module/Metadata.pm index 0afa14e..6902a1a 100644 --- a/lib/Module/Metadata.pm +++ b/lib/Module/Metadata.pm @@ -47,14 +47,14 @@ my $PKG_ADDL_WORD_REGEXP = qr{ # the 2nd+ word in a package name }x; my $PKG_NAME_REGEXP = qr{ # match a package name - (?: :: )? # a pkg name can start with aristotle + (?: :: )? # a pkg name can start with arisdottle $PKG_FIRST_WORD_REGEXP # a package word (?: - (?: :: )+ ### aristotle (allow one or many times) + (?: :: )+ ### arisdottle (allow one or many times) $PKG_ADDL_WORD_REGEXP ### a package word )* # ^ zero, one or many times (?: - :: # allow trailing aristotle + :: # allow trailing arisdottle )? }x; @@ -383,12 +383,14 @@ sub _init { my $self = bless(\%data, $class); - if ( $handle ) { - $self->_parse_fh($handle); - } - else { - $self->_parse_file(); + if ( not $handle ) { + my $filename = $self->{filename}; + $handle = IO::File->new( $filename ) + or croak( "Can't open '$filename': $!" ); + + $self->_handle_bom($handle, $filename); } + $self->_parse_fh($handle); unless($self->{module} and length($self->{module})) { my ($v, $d, $f) = File::Spec->splitpath($self->{filename}); @@ -449,29 +451,18 @@ sub _parse_version_expression { my $self = shift; my $line = shift; - my( $sig, $var, $pkg ); + my( $sigil, $variable_name, $package); if ( $line =~ /$VERS_REGEXP/o ) { - ( $sig, $var, $pkg ) = $2 ? ( $1, $2, $3 ) : ( $4, $5, $6 ); - if ( $pkg ) { - $pkg = ($pkg eq '::') ? 'main' : $pkg; - $pkg =~ s/::$//; + ( $sigil, $variable_name, $package) = $2 ? ( $1, $2, $3 ) : ( $4, $5, $6 ); + if ( $package ) { + $package = ($package eq '::') ? 'main' : $package; + $package =~ s/::$//; } } - return ( $sig, $var, $pkg ); + return ( $sigil, $variable_name, $package ); } -sub _parse_file { - my $self = shift; - - my $filename = $self->{filename}; - my $fh = IO::File->new( $filename ) - or croak( "Can't open '$filename': $!" ); - - $self->_handle_bom($fh, $filename); - - $self->_parse_fh($fh); -} # Look for a UTF-8/UTF-16BE/UTF-16LE BOM at the beginning of the stream. # If there's one, then skip it and set the :encoding layer appropriately. @@ -515,8 +506,8 @@ sub _parse_fh { my ($self, $fh) = @_; my( $in_pod, $seen_end, $need_vers ) = ( 0, 0, 0 ); - my( @pkgs, %vers, %pod, @pod ); - my $pkg = 'main'; + my( @packages, %vers, %pod, @pod ); + my $package = 'main'; my $pod_sect = ''; my $pod_data = ''; my $in_end = 0; @@ -576,46 +567,46 @@ sub _parse_fh { last if $line eq '__DATA__'; # parse $line to see if it's a $VERSION declaration - my( $vers_sig, $vers_fullname, $vers_pkg ) = + my( $version_sigil, $version_fullname, $version_package ) = ($line =~ /VERSION/) ? $self->_parse_version_expression( $line ) : (); if ( $line =~ /$PKG_REGEXP/o ) { - $pkg = $1; - push( @pkgs, $pkg ) unless grep( $pkg eq $_, @pkgs ); - $vers{$pkg} = $2 unless exists( $vers{$pkg} ); + $package = $1; + push( @packages, $package ) unless grep( $package eq $_, @packages ); + $vers{$package} = $2 unless exists( $vers{$package} ); $need_vers = defined $2 ? 0 : 1; # VERSION defined with full package spec, i.e. $Module::VERSION - } elsif ( $vers_fullname && $vers_pkg ) { - push( @pkgs, $vers_pkg ) unless grep( $vers_pkg eq $_, @pkgs ); - $need_vers = 0 if $vers_pkg eq $pkg; + } elsif ( $version_fullname && $version_package ) { + push( @packages, $version_package ) unless grep( $version_package eq $_, @packages ); + $need_vers = 0 if $version_package eq $package; - unless ( defined $vers{$vers_pkg} && length $vers{$vers_pkg} ) { - $vers{$vers_pkg} = $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line ); + unless ( defined $vers{$version_package} && length $vers{$version_package} ) { + $vers{$version_package} = $self->_evaluate_version_line( $version_sigil, $version_fullname, $line ); } # first non-comment line in undeclared package main is VERSION - } elsif ( !exists($vers{main}) && $pkg eq 'main' && $vers_fullname ) { + } elsif ( !exists($vers{main}) && $package eq 'main' && $version_fullname ) { $need_vers = 0; - my $v = $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line ); - $vers{$pkg} = $v; - push( @pkgs, 'main' ); + my $v = $self->_evaluate_version_line( $version_sigil, $version_fullname, $line ); + $vers{$package} = $v; + push( @packages, 'main' ); # first non-comment line in undeclared package defines package main - } elsif ( !exists($vers{main}) && $pkg eq 'main' && $line =~ /\w+/ ) { + } elsif ( !exists($vers{main}) && $package eq 'main' && $line =~ /\w+/ ) { $need_vers = 1; $vers{main} = ''; - push( @pkgs, 'main' ); + push( @packages, 'main' ); # only keep if this is the first $VERSION seen - } elsif ( $vers_fullname && $need_vers ) { + } elsif ( $version_fullname && $need_vers ) { $need_vers = 0; - my $v = $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line ); + my $v = $self->_evaluate_version_line( $version_sigil, $version_fullname, $line ); - unless ( defined $vers{$pkg} && length $vers{$pkg} ) { - $vers{$pkg} = $v; + unless ( defined $vers{$package} && length $vers{$package} ) { + $vers{$package} = $v; } } } @@ -626,7 +617,7 @@ sub _parse_fh { } $self->{versions} = \%vers; - $self->{packages} = \@pkgs; + $self->{packages} = \@packages; $self->{pod} = \%pod; $self->{pod_headings} = \@pod; } @@ -635,7 +626,7 @@ sub _parse_fh { my $pn = 0; sub _evaluate_version_line { my $self = shift; - my( $sigil, $var, $line ) = @_; + my( $sigil, $variable_name, $line ) = @_; # Some of this code came from the ExtUtils:: hierarchy. @@ -650,10 +641,10 @@ sub _evaluate_version_line { no warnings; \$vsub = sub { - local $sigil$var; - \$$var=undef; + local $sigil$variable_name; + \$$variable_name=undef; $line; - \$$var + \$$variable_name }; }};