X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FModule%2FMetadata.pm;h=e5910d09a065202a8fa368cf58fe7d6a2b3bb774;hb=a4aafbc2cda96948f9a5dd4475d0f78f27d29afe;hp=2e70b715046913a2d61855caff1fb0d02c9c9f6d;hpb=f77c3f08b49a3d3763892adbaa9881e9fbe12754;p=p5sagit%2FModule-Metadata.git diff --git a/lib/Module/Metadata.pm b/lib/Module/Metadata.pm index 2e70b71..e5910d0 100644 --- a/lib/Module/Metadata.pm +++ b/lib/Module/Metadata.pm @@ -61,6 +61,9 @@ my $VERS_REGEXP = qr{ # match a VERSION definition =[^=~] # = but not ==, nor =~ }x; +my $PODSECT_REGEXP = qr{ + ^=(cut|pod|head[1-4]|over|item|back|begin|end|for|encoding)\b +}x; sub new_from_file { my $class = shift; @@ -496,10 +499,9 @@ sub _parse_fh { my $line_num = $.; chomp( $line ); - next if $line =~ /^\s*#/; my $is_cut; - if ( $line =~ /^=(.{0,3})/ ) { + if ( $line =~ /$PODSECT_REGEXP/o ) { $is_cut = $1 eq 'cut'; $in_pod = !$is_cut; } @@ -507,9 +509,9 @@ sub _parse_fh { # Would be nice if we could also check $in_string or something too last if !$in_pod && $line =~ /^__(?:DATA|END)__$/; - if ( $in_pod || $is_cut ) { + if ( $in_pod ) { - if ( $line =~ /^=head\d\s+(.+)\s*$/ ) { + if ( $line =~ /^=head[1-4]\s+(.+)\s*$/ ) { push( @pod, $1 ); if ( $self->{collect_pod} && length( $pod_data ) ) { $pod{$pod_sect} = $pod_data; @@ -517,16 +519,23 @@ sub _parse_fh { } $pod_sect = $1; - } elsif ( $self->{collect_pod} ) { $pod_data .= "$line\n"; } - } else { + } elsif ( $is_cut ) { + if ( $self->{collect_pod} && length( $pod_data ) ) { + $pod{$pod_sect} = $pod_data; + $pod_data = ''; + } $pod_sect = ''; - $pod_data = ''; + + } else { + + # Skip comments in code + next if $line =~ /^\s*#/; # parse $line to see if it's a $VERSION declaration my( $vers_sig, $vers_fullname, $vers_pkg ) = @@ -537,7 +546,7 @@ sub _parse_fh { if ( $line =~ /$PKG_REGEXP/o ) { $pkg = $1; push( @pkgs, $pkg ) unless grep( $pkg eq $_, @pkgs ); - $vers{$pkg} = (defined $2 ? $2 : undef) unless exists( $vers{$pkg} ); + $vers{$pkg} = $2 unless exists( $vers{$pkg} ); $need_vers = defined $2 ? 0 : 1; # VERSION defined with full package spec, i.e. $Module::VERSION @@ -778,33 +787,43 @@ without executing unsafe code. =item C<< new_from_file($filename, collect_pod => 1) >> -Construct a C object given the path to a file. Takes an -optional argument C which is a boolean that determines whether POD -data is collected and stored for reference. POD data is not collected by -default. POD headings are always collected. Returns undef if the filename -does not exist. If the file begins by an UTF-8, UTF-16BE or UTF-16LE -byte-order mark, then it is skipped before processing, and the content of the -file is also decoded appropriately starting from perl 5.8. +Constructs a C object given the path to a file. Returns +undef if the filename does not exist. + +C is a optional boolean argument that determines whether POD +data is collected and stored for reference. POD data is not collected by +default. POD headings are always collected. + +If the file begins by an UTF-8, UTF-16BE or UTF-16LE byte-order mark, then +it is skipped before processing, and the content of the file is also decoded +appropriately starting from perl 5.8. =item C<< new_from_handle($handle, $filename, collect_pod => 1) >> This works just like C, except that a handle can be provided -as the first argument. Note that there is no validation to confirm that the -handle is a handle or something that can act like one. Passing something that -isn't a handle will cause a exception when trying to read from it. The -C argument is mandatory or undef will be returned. You are -responsible for setting the decoding layers on C<$handle> if required. +as the first argument. + +Note that there is no validation to confirm that the handle is a handle or +something that can act like one. Passing something that isn't a handle will +cause a exception when trying to read from it. The C argument is +mandatory or undef will be returned. + +You are responsible for setting the decoding layers on C<$handle> if +required. =item C<< new_from_module($module, collect_pod => 1, inc => \@dirs) >> -Construct a C object given a module or package name. In addition -to accepting the C argument as described above, this -method accepts a C argument which is a reference to an array of -of directories to search for the module. If none are given, the -default is @INC. Returns undef if the module cannot be found. -If the file that contains the module begins by an UTF-8, UTF-16BE or UTF-16LE -byte-order mark, then it is skipped before processing, and the content of the -file is also decoded appropriately starting from perl 5.8. +Constructs a C object given a module or package name. +Returns undef if the module cannot be found. + +In addition to accepting the C argument as described above, +this method accepts a C argument which is a reference to an array of +directories to search for the module. If none are given, the default is +@INC. + +If the file that contains the module begins by an UTF-8, UTF-16BE or +UTF-16LE byte-order mark, then it is skipped before processing, and the +content of the file is also decoded appropriately starting from perl 5.8. =item C<< find_module_by_name($module, \@dirs) >> @@ -951,7 +970,7 @@ Original code from Module::Build::ModuleInfo by Ken Williams Released as Module::Metadata by Matt S Trout (mst) with assistance from David Golden (xdg) . -=head1 COPYRIGHT +=head1 COPYRIGHT & LICENSE Original code Copyright (c) 2001-2011 Ken Williams. Additional code Copyright (c) 2010-2011 Matt Trout and David Golden.