File Coverage

blib/lib/Module/Build/Bundle.pm

Criterion	Covered	Total	%
statement	109	176	61.9
branch	27	76	35.5
condition	7	24	29.1
subroutine	14	17	82.3
pod	5	5	100.0
total	162	298	54.3

package Module::Build::Bundle;

use 5.008;    #$^V
use strict;
use warnings;
use Carp qw(croak);
use Cwd qw(getcwd);
use Tie::IxHash;
use English qw( -no_match_vars );
use File::Slurp;    #read_file
use base qw(Module::Build::Base);
use utf8;

use constant EXTENDED_POD_LINK_VERSION => 5.12.0;

our $VERSION = '0.16';

#HACK: we need a writable copy for testing purposes
## no critic qw(Variables::ProhibitPackageVars Variables::ProhibitPunctuationVars)
our $myPERL_VERSION = $^V;

sub ACTION_build {
    my $self = shift;

    if ( !$self->{'_completed_actions'}{'contents'} ) {
        $self->ACTION_contents();
    }

    return Module::Build::Base::ACTION_build($self);
}

sub ACTION_contents {
    my $self = shift;

    #Fetching requirements from Build.PL
    my @list = %{ $self->requires() };

    my $section_header = $self->notes('section_header') || 'CONTENTS';

    my $sorted = 'Tie::IxHash'->new(@list);
    $sorted->SortByKey();

    my $pod = "=head1 $section_header\n\n=over\n\n";
    foreach ( $sorted->Keys ) {
        my ( $module, $version ) = $sorted->Shift();

        my $dist = $module;
        $dist =~ s/::/\-/g;

        my $module_path = $module;
        $module_path =~ s[::][/]g;
        $module_path .= '.pm';

        if ( $myPERL_VERSION ge EXTENDED_POD_LINK_VERSION ) {
            if ($version) {
                $pod .= "=item * L<$module|$module>, "
                    . "L<$version|http://search.cpan.org/dist/$dist-$version/lib/$module_path>\n\n";
            } else {
                $pod .= "=item * L<$module|$module>\n\n";
            }
        } else {
            if ($version) {
                $pod .= "=item * L<$module|$module>, $version\n\n";
            } else {
                $pod .= "=item * L<$module|$module>\n\n";
            }
        }
    }
    $pod .= "=back\n\n=head1";

    my $cwd = getcwd();

    my @path = split /::/, $self->{properties}->{module_name}
        || $self->{properties}->{module_name};

    #HACK: induced from test suite
    my $dir = $self->notes('temp_wd') ? $self->notes('temp_wd') : $cwd .'/t/';

    ## no critic qw(ValuesAndExpressions::ProhibitNoisyQuotes)
    my $file = ( join '/', ( $dir, @path ) ) . '.pm';

    my $contents = read_file($file) or croak "Unable to read file: $file - $!";

    my $rv = $contents =~ s/=head1\s*$section_header\s*.*=head1/$pod/s;

    if ( !$rv ) {
        croak "No $section_header section replaced";
    }

    open my $fout, '>', $file
        or croak "Unable to open file: $file - $!";

    print $fout $contents;

    close $fout or croak "Unable to close file: $file - $!";

    return 1;
}

#Lifted from Module::Build::Base
sub do_create_metafile {
  my $self = shift;
  return if $self->{wrote_metadata};
  my $p = $self->{properties};

  unless ($p->{license}) {
    $self->log_warn("No license specified, setting license = 'unknown'\n");
    $p->{license} = 'unknown';
  }

  my @metafiles = ( $self->metafile, $self->metafile2 );
  # If we're in the distdir, the metafile may exist and be non-writable.
  $self->delete_filetree($_) for @metafiles;

  # Since we're building ourself, we have to do some special stuff
  # here: the ConfigData module is found in blib/lib.
  local @INC = @INC;
  if (($self->module_name || '') eq 'Module::Build') {
    $self->depends_on('config_data');
    push @INC, File::Spec->catdir($self->blib, 'lib');
  }

  my $meta_obj = $self->_get_meta_object(
    quiet => 0, fatal => 1, auto => 1
  );

  #JONASBN: Changed file parameter
  my @created = $self->_write_meta_files( $meta_obj, $self->metafile );

  if ( @created ) {
    $self->{wrote_metadata} = 1;
    $self->_add_to_manifest('MANIFEST', $_) for @created;
  }
  return 1;
}

#lifted from Module::Build::Base, sets generated_by
sub get_metadata {
  my ($self, %args) = @_;

  my $fatal = $args{fatal} || 0;
  my $p = $self->{properties};

  $self->auto_config_requires if $args{auto};

  # validate required fields
  foreach my $f (qw(dist_name dist_version dist_author dist_abstract license)) {
    my $field = $self->$f();
    unless ( defined $field and length $field ) {
      my $err = "ERROR: Missing required field '$f' for metafile\n";
      if ( $fatal ) {
        die $err;
      }
      else {
        $self->log_warn($err);
      }
    }
  }

  my %metadata = (
    name => $self->dist_name,
    version => $self->normalize_version($self->dist_version),
    author => $self->dist_author,
    abstract => $self->dist_abstract,
    #JONASBN changed the generated_by
    generated_by => "Module::Build::Bundle version $Module::Build::Bundle::VERSION",
    'meta-spec' => {
      version => '2',
      url     => 'http://search.cpan.org/perldoc?CPAN::Meta::Spec',
    },
    dynamic_config => exists $p->{dynamic_config} ? $p->{dynamic_config} : 1,
    release_status => $self->release_status,
  );

  my ($meta_license, $meta_license_url) = $self->_get_license;
  $metadata{license} = [ $meta_license ];
  $metadata{resources}{license} = [ $meta_license_url ] if defined $meta_license_url;

  $metadata{prereqs} = $self->_normalize_prereqs;

  if (exists $p->{no_index}) {
    $metadata{no_index} = $p->{no_index};
  } elsif (my $pkgs = eval { $self->find_dist_packages }) {
    $metadata{provides} = $pkgs if %$pkgs;
  } else {
    $self->log_warn("$@\nWARNING: Possible missing or corrupt 'MANIFEST' file.\n" .
                    "Nothing to enter for 'provides' field in metafile.\n");
  }

  if (my $add = $self->meta_add) {
    if (not exists $add->{'meta-spec'} or $add->{'meta-spec'}{version} != 2) {
      require CPAN::Meta::Converter;
      if (CPAN::Meta::Converter->VERSION('2.141170')) {
        $add = CPAN::Meta::Converter->new($add)->upgrade_fragment;
        delete $add->{prereqs}; # XXX this would now overwrite all prereqs
      }
      else {
        $self->log_warn("Can't meta_add without CPAN::Meta 2.141170");
      }
    }

    while (my($k, $v) = each %{$add}) {
      $metadata{$k} = $v;
    }
  }

  if (my $merge = $self->meta_merge) {
    if (eval { require CPAN::Meta::Merge }) {
      %metadata = %{ CPAN::Meta::Merge->new(default_version => '1.4')->merge(\%metadata, $merge) };
    }
    else {
      $self->log_warn("Can't merge without CPAN::Meta::Merge");
    }
  }

  return \%metadata;
}

#lifted from Module::Build::Base, added package and version resolution and
# addition to configure requires
sub prepare_metadata {
  my ($self, $node, $keys) = @_;
  my $p = $self->{properties};

  #JONASBN: Added package resolution
  my $package = ref $self;
  my $version = $package::VERSION;

  # A little helper sub
  my $add_node = sub {
    my ($name, $val) = @_;
    $node->{$name} = $val;
    push @$keys, $name if $keys;
  };

  foreach (qw(dist_name dist_version dist_author dist_abstract license)) {
    (my $name = $_) =~ s/^dist_//;
    $add_node->($name, $self->$_());
    die "ERROR: Missing required field '$_' for META.yml\n"
      unless defined($node->{$name}) && length($node->{$name});
  }
  $node->{version} = $self->normalize_version($node->{version});

  if (defined( my $l = $self->license )) {
    die "Unknown license string '$l'"
      unless exists $self->valid_licenses->{ $l };

    if (my $key = $self->valid_licenses->{ $l }) {
      my $class = "Software::License::$key";
      if (eval "use $class; 1") {
        # S::L requires a 'holder' key
        $node->{resources}{license} = $class->new({holder=>"nobody"})->url;
      }
      else {
        $node->{resources}{license} = $self->_license_url($l);
      }
    }
    # XXX we are silently omitting the url for any unknown license
  }

  # copy prereq data structures so we can modify them before writing to META
  my %prereq_types;
  for my $type ( 'configure_requires', @{$self->prereq_action_types} ) {
    if (exists $p->{$type}) {
      for my $mod ( keys %{ $p->{$type} } ) {
        $prereq_types{$type}{$mod} =
          $self->normalize_version($p->{$type}{$mod});
      }
    }
  }

  # add current Module::Build to configure_requires if there
  # isn't one already specified (but not ourself, so we're not circular)
  if ( $self->dist_name ne 'Module-Build'
    && $self->auto_configure_requires
    && ! exists $prereq_types{'configure_requires'}{'Module::Build'}
  ) {
    $prereq_types{configure_requires}{'Module::Build'} = $VERSION;
    #JONASBN added configure requires
    $prereq_types{configure_requires}{$package} = $version;
  }

  for my $t ( keys %prereq_types ) {
      $add_node->($t, $prereq_types{$t});
  }

  if (exists $p->{dynamic_config}) {
    $add_node->('dynamic_config', $p->{dynamic_config});
  }
  my $pkgs = eval { $self->find_dist_packages };
  if ($@) {
    $self->log_warn("$@\nWARNING: Possible missing or corrupt 'MANIFEST' file.\n" .
        "Nothing to enter for 'provides' field in META.yml\n");
  } else {
    $node->{provides} = $pkgs if %$pkgs;
  }
;
  if (exists $p->{no_index}) {
    $add_node->('no_index', $p->{no_index});
  }

  $add_node->('generated_by', "$package version $version");

  $add_node->('meta-spec',
        {version => '1.4',
         url     => 'http://module-build.sourceforge.net/META-spec-v1.4.html',
        });

  while (my($k, $v) = each %{$self->meta_add}) {
    $add_node->($k, $v);
  }

  while (my($k, $v) = each %{$self->meta_merge}) {
    $self->_hash_merge($node, $k, $v);
  }

  return $node;
}

1;

__END__