jmx4perl
2 results

 view release on metacpan or  search on metacpan

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

  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::Build::ModuleInfo->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'), 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 $Test::Harness::switches    = 
  local $Test::Harness::Switches    = 
  local $ENV{HARNESS_PERL_SWITCHES} = "-MDevel::Cover";

  $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->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');
  
  while (my ($file, $dest) = each %$files) {
    $self->copy_if_modified(from => $file, to => File::Spec->catfile($self->blib, $dest) );
  }
}

sub process_support_files {
  my $self = shift;
  my $p = $self->{properties};
  return unless $p->{c_source};
  
  push @{$p->{include_dirs}}, $p->{c_source};
  
  my $files = $self->rscan_dir($p->{c_source}, file_qr('\.c(pp)?$'));
  foreach my $file (@$files) {
    push @{$p->{objects}}, $self->compile_c($file);
  }
}

sub process_PL_files {
  my ($self) = @_;
  my $files = $self->find_PL_files;
  
  while (my ($file, $to) = each %$files) {
    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;
  my $files = $self->find_xs_files;
  while (my ($from, $to) = each %$files) {
    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 (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 (UNIVERSAL::isa($files, 'ARRAY')) {
      return { map {$_, [/^(.*)\.PL$/]}
	       map $self->localize_file_path($_),
	       @$files };

    } elsif (UNIVERSAL::isa($files, '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',
                                                          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 = [keys %$files] if UNIVERSAL::isa($files, 'HASH');
    $files = [map { -d $_ ? $self->expand_test_dir($_) : $_ }
	      map glob,
	      $self->split_like_shell($files)];
    
    # Always given as a Unix file spec.

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

}

sub ACTION_clean {
  my ($self) = @_;
  foreach my $item (map glob($_), $self->cleanup) {
    $self->delete_filetree($item);
  }
}

sub ACTION_realclean {
  my ($self) = @_;
  $self->depends_on('clean');
  $self->delete_filetree($self->config_dir, $self->build_script);
}

sub ACTION_ppd {
  my ($self) = @_;
  require Module::Build::PPMMaker;
  my $ppd = Module::Build::PPMMaker->new();
  my $file = $ppd->make_ppd(%{$self->{args}}, build => $self);
  $self->add_to_cleanup($file);
}

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

  $self->depends_on( 'build' );

  my $ppm = $self->ppm_name;
  $self->delete_filetree( $ppm );
  $self->log_info( "Creating $ppm\n" );
  $self->add_to_cleanup( $ppm, "$ppm.tar.gz" );

  my %types = ( # translate types/dirs to those expected by ppm
    lib     => 'lib',
    arch    => 'arch',
    bin     => 'bin',
    script  => 'script',
    bindoc  => 'man1',
    libdoc  => 'man3',
    binhtml => undef,
    libhtml => undef,
  );

  foreach my $type ($self->install_types) {
    next if exists( $types{$type} ) && !defined( $types{$type} );

    my $dir = File::Spec->catdir( $self->blib, $type );
    next unless -e $dir;

    my $files = $self->rscan_dir( $dir );
    foreach my $file ( @$files ) {
      next unless -f $file;
      my $rel_file =
	File::Spec->abs2rel( File::Spec->rel2abs( $file ),
			     File::Spec->rel2abs( $dir  ) );
      my $to_file  =
	File::Spec->catfile( $ppm, 'blib',
			    exists( $types{$type} ) ? $types{$type} : $type,
			    $rel_file );
      $self->copy_if_modified( from => $file, to => $to_file );
    }
  }

  foreach my $type ( qw(bin lib) ) {
    local $self->{properties}{html_css} = 'Active.css';
    $self->htmlify_pods( $type, File::Spec->catdir($ppm, 'blib', 'html') );
  }

  # create a tarball;
  # the directory tar'ed must be blib so we need to do a chdir first
  my $target = File::Spec->catfile( File::Spec->updir, $ppm );
  $self->_do_in_dir( $ppm, sub { $self->make_tarball( 'blib', $target ) } );

  $self->depends_on( 'ppd' );

  $self->delete_filetree( $ppm );
}

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

  # Need PAR::Dist
  if ( not eval { require PAR::Dist; PAR::Dist->VERSION(0.17) } ) {
    $self->log_warn(
      "In order to create .par distributions, you need to\n"
      . "install PAR::Dist first."
    );
    return();
  }
  
  $self->depends_on( 'build' );

  return PAR::Dist::blib_to_par(
    name => $self->dist_name,
    version => $self->dist_version,
  );
}

sub ACTION_dist {
  my ($self) = @_;
  
  $self->depends_on('distdir');
  
  my $dist_dir = $self->dist_dir;
  
  $self->make_tarball($dist_dir);
  $self->delete_filetree($dist_dir);
}

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

  require ExtUtils::Manifest;
  local $^W; # ExtUtils::Manifest is not warnings clean.
  my ($missing, $extra) = ExtUtils::Manifest::fullcheck();

  return unless @$missing || @$extra;

  my $msg = "MANIFEST appears to be out of sync with the distribution\n";
  if ( $self->invoked_action eq 'distcheck' ) {

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

      # when it actually only takes an input filehandle

      my $old_parse_file;
      $old_parse_file = \&{"Pod::Simple::parse_file"}
	and
      local *{"Pod::Simple::parse_file"} = sub {
	my $self = shift;
	$self->output_fh($_[1]) if $_[1];
	$self->$old_parse_file($_[0]);
      }
        if $Pod::Text::VERSION
	  == 3.01; # Split line to avoid evil version-finder

      Pod::Text::pod2text( $docfile, $fh );

      $fh->close;
    } else {
      $self->log_warn(
        "Cannot create 'README' file: Can't open file for writing\n" );
      return;
    }

  } else {
    $self->log_warn("Can't load Pod::Readme or Pod::Text to create README\n");
    return;
  }

  $self->_add_to_manifest('MANIFEST', 'README');
}

sub _main_docfile {
  my $self = shift;
  if ( my $pm_file = $self->dist_version_from ) {
    (my $pod_file = $pm_file) =~ s/.pm$/.pod/;
    return (-e $pod_file ? $pod_file : $pm_file);
  } else {
    return undef;
  }
}

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

  $self->depends_on('distmeta');

  my $dist_files = $self->_read_manifest('MANIFEST')
    or die "Can't create distdir without a MANIFEST file - run 'manifest' action first";
  delete $dist_files->{SIGNATURE};  # Don't copy, create a fresh one
  die "No files found in MANIFEST - try running 'manifest' action?\n"
    unless ($dist_files and keys %$dist_files);
  my $metafile = $self->metafile;
  $self->log_warn("*** Did you forget to add $metafile to the MANIFEST?\n")
    unless exists $dist_files->{$metafile};
  
  my $dist_dir = $self->dist_dir;
  $self->delete_filetree($dist_dir);
  $self->log_info("Creating $dist_dir\n");
  $self->add_to_cleanup($dist_dir);
  
  foreach my $file (keys %$dist_files) {
    my $new = $self->copy_if_modified(from => $file, to_dir => $dist_dir, verbose => 0);
  }
  
  $self->_sign_dir($dist_dir) if $self->{properties}{sign};
}

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

  $self->depends_on('distdir');

  $self->_do_in_dir
    ( $self->dist_dir,
      sub {
	# XXX could be different names for scripts

	$self->run_perl_script('Build.PL') # XXX Should this be run w/ --nouse-rcfile
	  or die "Error executing 'Build.PL' in dist directory: $!";
	$self->run_perl_script('Build')
	  or die "Error executing 'Build' in dist directory: $!";
	$self->run_perl_script('Build', [], ['test'])
	  or die "Error executing 'Build test' in dist directory";
      });
}


=begin private

  my $has_include = $build->_eumanifest_has_include;

Returns true if the installed version of ExtUtils::Manifest supports
#include and #include_default directives.  False otherwise.

=end private

=cut

# #!include and #!include_default were added in 1.50
sub _eumanifest_has_include {
    my $self = shift;

    require ExtUtils::Manifest;
    return ExtUtils::Manifest->VERSION >= 1.50 ? 1 : 0;
    return 0;
}


=begin private

  my $maniskip_file = $build->_default_maniskip;

Returns the location of the installed MANIFEST.SKIP file used by
default.

=end private

=cut

sub _default_maniskip {
    my $self = shift;

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

sub process_xs {
  my ($self, $file) = @_;

  my $spec = $self->_infer_xs_spec($file);

  # File name, minus the suffix
  (my $file_base = $file) =~ s/\.[^.]+$//;

  # .xs -> .c
  $self->add_to_cleanup($spec->{c_file});

  unless ($self->up_to_date($file, $spec->{c_file})) {
    $self->compile_xs($file, outfile => $spec->{c_file});
  }

  # .c -> .o
  my $v = $self->dist_version;
  $self->compile_c($spec->{c_file},
		   defines => {VERSION => qq{"$v"}, XS_VERSION => qq{"$v"}});

  # archdir
  File::Path::mkpath($spec->{archdir}, 0, oct(777)) unless -d $spec->{archdir};

  # .xs -> .bs
  $self->add_to_cleanup($spec->{bs_file});
  unless ($self->up_to_date($file, $spec->{bs_file})) {
    require ExtUtils::Mkbootstrap;
    $self->log_info("ExtUtils::Mkbootstrap::Mkbootstrap('$spec->{bs_file}')\n");
    ExtUtils::Mkbootstrap::Mkbootstrap($spec->{bs_file});  # Original had $BSLOADLIBS - what's that?
    {my $fh = IO::File->new(">> $spec->{bs_file}")}  # create
    utime((time)x2, $spec->{bs_file});  # touch
  }

  # .o -> .(a|bundle)
  $self->link_c($spec);
}

sub do_system {
  my ($self, @cmd) = @_;
  $self->log_info("@cmd\n");

  # Some systems proliferate huge PERL5LIBs, try to ameliorate:
  my %seen;
  my $sep = $self->config('path_sep');
  local $ENV{PERL5LIB} = 
    ( !exists($ENV{PERL5LIB}) ? '' :
      length($ENV{PERL5LIB}) < 500
      ? $ENV{PERL5LIB}
      : join $sep, grep { ! $seen{$_}++ and -d $_ } split($sep, $ENV{PERL5LIB})
    );

  my $status = system(@cmd);
  if ($status and $! =~ /Argument list too long/i) {
    my $env_entries = '';
    foreach (sort keys %ENV) { $env_entries .= "$_=>".length($ENV{$_})."; " }
    warn "'Argument list' was 'too long', env lengths are $env_entries";
  }
  return !$status;
}

sub copy_if_modified {
  my $self = shift;
  my %args = (@_ > 3
	      ? ( @_ )
	      : ( from => shift, to_dir => shift, flatten => shift )
	     );
  $args{verbose} = !$self->quiet
    unless exists $args{verbose};

  my $file = $args{from};
  unless (defined $file and length $file) {
    die "No 'from' parameter given to copy_if_modified";
  }
 
  # makes no sense to replicate an absolute path, so assume flatten 
  $args{flatten} = 1 if File::Spec->file_name_is_absolute( $file );

  my $to_path;
  if (defined $args{to} and length $args{to}) {
    $to_path = $args{to};
  } elsif (defined $args{to_dir} and length $args{to_dir}) {
    $to_path = File::Spec->catfile( $args{to_dir}, $args{flatten}
				    ? File::Basename::basename($file)
				    : $file );
  } else {
    die "No 'to' or 'to_dir' parameter given to copy_if_modified";
  }
  
  return if $self->up_to_date($file, $to_path); # Already fresh

  {
    local $self->{properties}{quiet} = 1;
    $self->delete_filetree($to_path); # delete destination if exists
  }

  # Create parent directories
  File::Path::mkpath(File::Basename::dirname($to_path), 0, oct(777));
  
  $self->log_info("Copying $file -> $to_path\n") if $args{verbose};
  
  if ($^O eq 'os2') {# copy will not overwrite; 0x1 = overwrite
    chmod 0666, $to_path;
    File::Copy::syscopy($file, $to_path, 0x1) or die "Can't copy('$file', '$to_path'): $!";
  } else {
    File::Copy::copy($file, $to_path) or die "Can't copy('$file', '$to_path'): $!";
  }

  # mode is read-only + (executable if source is executable)
  my $mode = oct(444) | ( $self->is_executable($file) ? oct(111) : 0 );
  chmod( $mode, $to_path );

  return $to_path;
}

sub up_to_date {
  my ($self, $source, $derived) = @_;
  $source  = [$source]  unless ref $source;
  $derived = [$derived] unless ref $derived;

  # empty $derived means $source should always run
  return 0 if @$source && !@$derived || grep {not -e} @$derived;

  my $most_recent_source = time / (24*60*60);
  foreach my $file (@$source) {
    unless (-e $file) {
      $self->log_warn("Can't find source file $file for up-to-date check");
      next;
    }
    $most_recent_source = -M _ if -M _ < $most_recent_source;
  }
  
  foreach my $derived (@$derived) {
    return 0 if -M $derived > $most_recent_source;
  }
  return 1;
}

sub dir_contains {
  my ($self, $first, $second) = @_;
  # File::Spec doesn't have an easy way to check whether one directory
  # is inside another, unfortunately.
  
  ($first, $second) = map File::Spec->canonpath($_), ($first, $second);
  my @first_dirs = File::Spec->splitdir($first);
  my @second_dirs = File::Spec->splitdir($second);



( run in 2.621 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )