view release on metacpan or  search on metacpan

inc/inc_Module-Build/Module/Build/Base.pm  view on Meta::CPAN

  my ($self, $type, $dir) = @_;

  if (my $files = $self->{properties}{"${type}_files"}) {
    # Always given as a Unix file spec
    return { map $self->localize_file_path($_), %$files };
  }

  return {} unless -d $dir;
  return { map {$_, $_}
           map $self->localize_file_path($_),
           grep !/\.\#/,
           @{ $self->rscan_dir($dir, $self->file_qr("\\.$type\$")) } };
}

sub localize_file_path {
  my ($self, $path) = @_;
  return File::Spec->catfile( split m{/}, $path );
}

sub localize_dir_path {
  my ($self, $path) = @_;
  return File::Spec->catdir( split m{/}, $path );
}

sub fix_shebang_line { # Adapted from fixin() in ExtUtils::MM_Unix 1.35
  my ($self, @files) = @_;
  my $c = ref($self) ? $self->{config} : 'Module::Build::Config';

  my ($does_shbang) = $c->get('sharpbang') =~ /^\s*\#\!/;
  for my $file (@files) {
    my $FIXIN = IO::File->new($file) or die "Can't process '$file': $!";
    local $/ = "\n";
    chomp(my $line = <$FIXIN>);
    next unless $line =~ s/^\s*\#!\s*//;     # Not a shbang file.

    my ($cmd, $arg) = (split(' ', $line, 2), '');
    next unless $cmd =~ /perl/i;
    my $interpreter = $self->{properties}{perl};

    $self->log_verbose("Changing sharpbang in $file to $interpreter\n");
    my $shb = '';
    $shb .= $c->get('sharpbang')."$interpreter $arg\n" if $does_shbang;

    # I'm not smart enough to know the ramifications of changing the
    # embedded newlines here to \n, so I leave 'em in.
    $shb .= qq{
eval 'exec $interpreter $arg -S \$0 \${1+"\$\@"}'
    if 0; # not running under some shell
} unless $self->is_windowsish; # this won't work on win32, so don't

    my $FIXOUT = IO::File->new(">$file.new")
      or die "Can't create new $file: $!\n";

    # Print out the new #! line (or equivalent).
    local $\;
    undef $/; # Was localized above
    print $FIXOUT $shb, <$FIXIN>;
    close $FIXIN;
    close $FIXOUT;

    rename($file, "$file.bak")
      or die "Can't rename $file to $file.bak: $!";

    rename("$file.new", $file)
      or die "Can't rename $file.new to $file: $!";

    $self->delete_filetree("$file.bak")
      or $self->log_warn("Couldn't clean up $file.bak, leaving it there");

    $self->do_system($c->get('eunicefix'), $file) if $c->get('eunicefix') ne ':';
  }
}


sub ACTION_testpod {
  my $self = shift;
  $self->depends_on('docs');

  eval q{use Test::Pod 0.95; 1}
    or die "The 'testpod' action requires Test::Pod version 0.95";

  my @files = sort keys %{$self->_find_pods($self->libdoc_dirs)},
                   keys %{$self->_find_pods
                             ($self->bindoc_dirs,
                              exclude => [ $self->file_qr('\.bat$') ])}
    or die "Couldn't find any POD files to test\n";

  { package # hide from PAUSE
      Module::Build::PodTester;  # Don't want to pollute the main namespace
    Test::Pod->import( tests => scalar @files );
    pod_file_ok($_) foreach @files;
  }
}

sub ACTION_testpodcoverage {
  my $self = shift;

  $self->depends_on('docs');

  eval q{use Test::Pod::Coverage 1.00; 1}
    or die "The 'testpodcoverage' action requires ",
           "Test::Pod::Coverage version 1.00";

  # TODO this needs test coverage!

  # XXX work-around a bug in Test::Pod::Coverage previous to v1.09
  # Make sure we test the module in blib/
  local @INC = @INC;
  my $p = $self->{properties};
  unshift(@INC,
    # XXX any reason to include arch?
    File::Spec->catdir($p->{base_dir}, $self->blib, 'lib'),
    #File::Spec->catdir($p->{base_dir}, $self->blib, 'arch')
  );

  all_pod_coverage_ok();
}

sub ACTION_docs {
  my $self = shift;

  $self->depends_on('code');
  $self->depends_on('manpages', 'html');
}