Merge pull request #32 from Perl-Toolchain-Gang/decode_pod

Add a decode_pod option for automatic =encoding handling

Author: karenetheridge

Changes

@@ -1,6 +1,7 @@
 Revision history for Module-Metadata
 
 {{$NEXT}}
+  - add decode_pod option for automatic =encoding handling
 
 1.000036  2019-04-18 18:25:15Z
   - properly clean up temp dirs after testing

lib/Module/Metadata.pm

@@ -383,7 +383,7 @@ sub _init {
 
   my $handle = delete $props{handle};
   my( %valid_props, @valid_props );
-  @valid_props = qw( collect_pod inc );
+  @valid_props = qw( collect_pod inc decode_pod );
   @valid_props{@valid_props} = delete( @props{@valid_props} );
   warn "Unknown properties: @{[keys %props]}\n" if scalar( %props );
 
@@ -542,6 +542,7 @@ sub _parse_fh {
   my $pod_sect = '';
   my $pod_data = '';
   my $in_end = 0;
+  my $encoding = '';
 
   while (defined( my $line = <$fh> )) {
     my $line_num = $.;
@@ -570,6 +571,9 @@ sub _parse_fh {
         $pod_sect = $1;
       }
       elsif ( $self->{collect_pod} ) {
+        if ( $self->{decode_pod} && $line =~ /^=encoding ([\w-]+)/ ) {
+          $encoding = $1;
+        }
         $pod_data .= "$line\n";
       }
       next;
@@ -658,6 +662,11 @@ sub _parse_fh {
     $pod{$pod_sect} = $pod_data;
   }
 
+  if ( $self->{decode_pod} && $encoding ) {
+    require Encode;
+    $_ = Encode::decode( $encoding, $_ ) for values %pod;
+  }
+
   $self->{versions} = \%vers;
   $self->{packages} = \@packages;
   $self->{pod} = \%pod;
@@ -854,7 +863,7 @@ in the CPAN toolchain.
 
 =head1 CLASS METHODS
 
-=head2 C<< new_from_file($filename, collect_pod => 1) >>
+=head2 C<< new_from_file($filename, collect_pod => 1, decode_pod => 1) >>
 
 Constructs a C<Module::Metadata> object given the path to a file.  Returns
 undef if the filename does not exist.
@@ -867,7 +876,10 @@ 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.
 
-=head2 C<< new_from_handle($handle, $filename, collect_pod => 1) >>
+Alternatively, if C<decode_pod> is set, it will decode the collected pod
+sections according to the C<=encoding> declaration.
+
+=head2 C<< new_from_handle($handle, $filename, collect_pod => 1, decode_pod => 1) >>
 
 This works just like C<new_from_file>, except that a handle can be provided
 as the first argument.
@@ -880,15 +892,15 @@ mandatory or undef will be returned.
 You are responsible for setting the decoding layers on C<$handle> if
 required.
 
-=head2 C<< new_from_module($module, collect_pod => 1, inc => \@dirs) >>
+=head2 C<< new_from_module($module, collect_pod => 1, inc => \@dirs, decode_pod => 1) >>
 
 Constructs a C<Module::Metadata> object given a module or package name.
 Returns undef if the module cannot be found.
 
-In addition to accepting the C<collect_pod> argument as described above,
-this method accepts a C<inc> argument which is a reference to an array of
-directories to search for the module.  If none are given, the default is
-@INC.
+In addition to accepting the C<collect_pod> and C<decode_pod> arguments as
+described above, this method accepts a C<inc> 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

t/metadata.t

@@ -3,6 +3,7 @@
 
 use strict;
 use warnings;
+use Encode 'decode';
 use Test::More 0.82;
 use IO::File;
 use File::Spec;
@@ -16,7 +17,7 @@ use GeneratePackage;
 
 my $tmpdir = GeneratePackage::tmpdir();
 
-plan tests => 71;
+plan tests => 72;
 
 require_ok('Module::Metadata');
 
@@ -209,13 +210,15 @@ $VERSION = '0.01';
 package Simple::Ex;
 $VERSION = '0.02';
 
+=encoding UTF-8
+
 =head1 NAME
 
 Simple - It's easy.
 
 =head1 AUTHOR
 
-Simple Simon
+Símple Simon
 
 You can find me on the IRC channel
 #simon on irc.perl.org.
@@ -270,7 +273,7 @@ You can find me on the IRC channel
   my %expected = (
     NAME   => q|Simple - It's easy.|,
     AUTHOR => <<'EXPECTED'
-Simple Simon
+Símple Simon
 
 You can find me on the IRC channel
 #simon on irc.perl.org.
@@ -282,6 +285,13 @@ EXPECTED
   }
   is( $pod{NAME},   $expected{NAME},   'collected NAME pod section' );
   is( $pod{AUTHOR}, $expected{AUTHOR}, 'collected AUTHOR pod section' );
+
+  my $pm_info2 = Module::Metadata->new_from_module(
+               'Simple', inc => [ 'lib', @INC ], collect_pod => 1, decode_pod => 1 );
+  my $author = $pm_info2->pod( 'AUTHOR' );
+  $author =~ s/^\s+//;
+  $author =~ s/\s+$//;
+  is( $author, decode('UTF-8', $expected{AUTHOR} ), 'collected AUTHOR pod section in UTF-8' );
 }
 
 {