view release on metacpan or  search on metacpan

lib/Module/Build/Base.pm  view on Meta::CPAN

sub expand_test_dir {
  my ($self, $dir) = @_;
  my $exts = $self->{properties}{test_file_exts};

  return sort map { @{$self->rscan_dir($dir, qr{^[^.].*\Q$_\E$})} } @$exts
    if $self->recursive_test_files;

  return sort map { glob File::Spec->catfile($dir, "*$_") } @$exts;
}

sub ACTION_testdb {
  my ($self) = @_;
  local $self->{properties}{debugger} = 1;
  $self->depends_on('test');
}

sub ACTION_testcover {
  my ($self) = @_;

  unless (Module::Metadata->find_module_by_name('Devel::Cover')) {
    warn("Cannot run testcover action unless Devel::Cover is installed.\n");
    return;
  }

  $self->add_to_cleanup('coverage', 'cover_db');
  $self->depends_on('code');

  # See whether any of the *.pm files have changed since last time
  # testcover was run.  If so, start over.
  if (-e 'cover_db') {
    my $pm_files = $self->rscan_dir
        (File::Spec->catdir($self->blib, 'lib'), $self->file_qr('\.pm$') );
    my $cover_files = $self->rscan_dir('cover_db', sub {-f $_ and not /\.html$/});

    $self->do_system(qw(cover -delete))
      unless $self->up_to_date($pm_files,         $cover_files)
          && $self->up_to_date($self->test_files, $cover_files);
  }

  local $self->{properties}{cover} = 1;
  $self->depends_on('test');
  $self->do_system('cover');
}

sub ACTION_code {
  my ($self) = @_;

  # All installable stuff gets created in blib/ .
  # Create blib/arch to keep blib.pm happy
  my $blib = $self->blib;
  $self->add_to_cleanup($blib);
  File::Path::mkpath( File::Spec->catdir($blib, 'arch') );

  if (my $split = $self->autosplit) {
    $self->autosplit_file($_, $blib) for ref($split) ? @$split : ($split);
  }

  foreach my $element (@{$self->build_elements}) {
    my $method = "process_${element}_files";
    $method = "process_files_by_extension" unless $self->can($method);
    $self->$method($element);
  }

  $self->depends_on('config_data');
}

sub ACTION_build {
  my $self = shift;
  $self->log_info("Building " . $self->dist_name . "\n");
  $self->depends_on('code');
  $self->depends_on('docs');
}

sub process_files_by_extension {
  my ($self, $ext) = @_;

  my $method = "find_${ext}_files";
  my $files = $self->can($method) ? $self->$method() : $self->_find_file_by_type($ext,  'lib');

  foreach my $file (sort keys %$files) {
    $self->copy_if_modified(from => $file, to => File::Spec->catfile($self->blib, $files->{$file}) );
  }
}

sub process_support_files {
  my $self = shift;
  my $p = $self->{properties};
  return unless $p->{c_source};
  return if $self->pureperl_only && $self->allow_pureperl;

  my $files;
  if (ref($p->{c_source}) eq "ARRAY") {
      push @{$p->{include_dirs}}, @{$p->{c_source}};
      for my $path (@{$p->{c_source}}) {
          push @$files, @{ $self->rscan_dir($path, $self->file_qr('\.c(c|p|pp|xx|\+\+)?$')) };
      }
  } else {
      push @{$p->{include_dirs}}, $p->{c_source};
      $files = $self->rscan_dir($p->{c_source}, $self->file_qr('\.c(c|p|pp|xx|\+\+)?$'));
  }

  foreach my $file (@$files) {
      push @{$p->{objects}}, $self->compile_c($file);
  }
}

sub process_share_dir_files {
  my $self = shift;
  my $files = $self->_find_share_dir_files;
  return unless $files;

  # root for all File::ShareDir paths
  my $share_prefix = File::Spec->catdir($self->blib, qw/lib auto share/);

  # copy all share files to blib
  foreach my $file (sort keys %$files) {
    $self->copy_if_modified(
      from => $file, to => File::Spec->catfile( $share_prefix, $files->{$file} )
    );
  }
}

sub _find_share_dir_files {
  my $self = shift;
  my $share_dir = $self->share_dir;
  return unless $share_dir;

  my @file_map;
  if ( $share_dir->{dist} ) {
    my $prefix = "dist/".$self->dist_name;
    push @file_map, $self->_share_dir_map( $prefix, $share_dir->{dist} );
  }

  if ( $share_dir->{module} ) {
    for my $mod ( sort keys %{ $share_dir->{module} } ) {
      (my $altmod = $mod) =~ s{::}{-}g;
      my $prefix = "module/$altmod";
      push @file_map, $self->_share_dir_map($prefix, $share_dir->{module}{$mod});
    }
  }

  return { @file_map };
}

sub _share_dir_map {
  my ($self, $prefix, $list) = @_;
  my %files;
  for my $dir ( @$list ) {
    for my $f ( @{ $self->rscan_dir( $dir, sub {-f} )} ) {
      $f =~ s{\A.*?\Q$dir\E/}{};
      $files{"$dir/$f"} = "$prefix/$f";
    }
  }
  return %files;
}

sub process_PL_files {
  my ($self) = @_;
  my $files = $self->find_PL_files;

  foreach my $file (sort keys %$files) {
    my $to = $files->{$file};
    unless ($self->up_to_date( $file, $to )) {
      $self->run_perl_script($file, [], [@$to]) or die "$file failed";
      $self->add_to_cleanup(@$to);
    }
  }
}

sub process_xs_files {
  my $self = shift;
  return if $self->pureperl_only && $self->allow_pureperl;
  my $files = $self->find_xs_files;
  croak 'Can\'t build xs files under --pureperl-only' if %$files && $self->pureperl_only;
  foreach my $from (sort keys %$files) {
    my $to = $files->{$from};
    unless ($from eq $to) {
      $self->add_to_cleanup($to);
      $self->copy_if_modified( from => $from, to => $to );
    }
    $self->process_xs($to);
  }
}

sub process_pod_files { shift()->process_files_by_extension(shift()) }
sub process_pm_files  { shift()->process_files_by_extension(shift()) }

sub process_script_files {
  my $self = shift;
  my $files = $self->find_script_files;
  return unless keys %$files;

  my $script_dir = File::Spec->catdir($self->blib, 'script');
  File::Path::mkpath( $script_dir );

  foreach my $file (sort keys %$files) {
    my $result = $self->copy_if_modified($file, $script_dir, 'flatten') or next;
    $self->fix_shebang_line($result) unless $self->is_vmsish;
    $self->make_executable($result);
  }
}

sub find_PL_files {
  my $self = shift;
  if (my $files = $self->{properties}{PL_files}) {
    # 'PL_files' is given as a Unix file spec, so we localize_file_path().

    if (ref $files eq 'ARRAY') {
      return { map {$_, [/^(.*)\.PL$/]}
               map $self->localize_file_path($_),
               @$files };

    } elsif (ref $files eq 'HASH') {
      my %out;
      while (my ($file, $to) = each %$files) {
        $out{ $self->localize_file_path($file) } = [ map $self->localize_file_path($_),
                                                     ref $to ? @$to : ($to) ];
      }
      return \%out;

    } else {
      die "'PL_files' must be a hash reference or array reference";
    }
  }

  return unless -d 'lib';
  return {
    map {$_, [/^(.*)\.PL$/i ]}
    @{ $self->rscan_dir('lib', $self->file_qr('\.PL$')) }
  };
}

sub find_pm_files  { shift->_find_file_by_type('pm',  'lib') }
sub find_pod_files { shift->_find_file_by_type('pod', 'lib') }
sub find_xs_files  { shift->_find_file_by_type('xs',  'lib') }

sub find_script_files {
  my $self = shift;
  if (my $files = $self->script_files) {
    # Always given as a Unix file spec.  Values in the hash are
    # meaningless, but we preserve if present.
    return { map {$self->localize_file_path($_), $files->{$_}} keys %$files };
  }

  # No default location for script files
  return {};
}

sub find_test_files {
  my $self = shift;
  my $p = $self->{properties};

  if (my $files = $p->{test_files}) {
    $files = [sort keys %$files] if ref $files eq 'HASH';
    $files = [map { -d $_ ? $self->expand_test_dir($_) : $_ }
              map glob,
              $self->split_like_shell($files)];