glob results from the CPAN

glob

Alien-ROOT

view release on metacpan or search on metacpan

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

  }

  die ("Can't determine distribution version, must supply either 'dist_version',\n".
       "'dist_version_from', or 'module_name' parameter")
    unless defined $p->{dist_version};

  return $p->{dist_version};
}

sub _is_dev_version {
  my ($self) = @_;
  my $dist_version = $self->dist_version;
  my $version_obj = eval { Module::Build::Version->new( $dist_version ) };
  # assume it's normal if the version string is fatal -- in this case
  # the author might be doing something weird so should play along and
  # assume they'll specify all necessary behavior
  return $@ ? 0 : $version_obj->is_alpha;
}

sub dist_author   { shift->_pod_parse('author')   }
sub dist_abstract { shift->_pod_parse('abstract') }

sub _pod_parse {
  my ($self, $part) = @_;
  my $p = $self->{properties};
  my $member = "dist_$part";
  return $p->{$member} if defined $p->{$member};

  my $docfile = $self->_main_docfile
    or return;
  my $fh = IO::File->new($docfile)
    or return;

  require Module::Build::PodParser;
  my $parser = Module::Build::PodParser->new(fh => $fh);
  my $method = "get_$part";
  return $p->{$member} = $parser->$method();
}

sub version_from_file { # Method provided for backwards compatibility
  return Module::Build::ModuleInfo->new_from_file($_[1])->version();
}

sub find_module_by_name { # Method provided for backwards compatibility
  return Module::Build::ModuleInfo->find_module_by_name(@_[1,2]);
}

{
  # $unlink_list_for_pid{$$} = [ ... ]
  my %unlink_list_for_pid;

  sub _unlink_on_exit {
    my $self = shift;
    for my $f ( @_ ) {
      push @{$unlink_list_for_pid{$$}}, $f if -f $f;
    }
    return 1;
  }

  END {
    for my $f ( map glob($_), @{ $unlink_list_for_pid{$$} || [] } ) {
      next unless -e $f;
      File::Path::rmtree($f, 0, 0);
    }
  }
}

sub add_to_cleanup {
  my $self = shift;
  my %files = map {$self->localize_file_path($_), 1} @_;
  $self->{phash}{cleanup}->write(\%files);
}

sub cleanup {
  my $self = shift;
  my $all = $self->{phash}{cleanup}->read;
  return keys %$all;
}

sub config_file {
  my $self = shift;
  return unless -d $self->config_dir;
  return File::Spec->catfile($self->config_dir, @_);
}

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

  my $file = $self->config_file('build_params')
    or die "Can't find 'build_params' in " . $self->config_dir;
  my $fh = IO::File->new($file) or die "Can't read '$file': $!";
  my $ref = eval do {local $/; <$fh>};
  die if $@;
  my $c;
  ($self->{args}, $c, $self->{properties}) = @$ref;
  $self->{config} = Module::Build::Config->new(values => $c);
  close $fh;
}

sub has_config_data {
  my $self = shift;
  return scalar grep $self->{phash}{$_}->has_data(), qw(config_data features auto_features);
}

sub _write_data {
  my ($self, $filename, $data) = @_;

  my $file = $self->config_file($filename);
  my $fh = IO::File->new("> $file") or die "Can't create '$file': $!";
  unless (ref($data)) {  # e.g. magicnum
    print $fh $data;
    return;
  }

  print {$fh} Module::Build::Dumper->_data_dump($data);
}

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

  File::Path::mkpath($self->{properties}{config_dir});

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

    %args = (%args, Module::Build::Compat->makefile_to_build_macros);
  }

  return \%args, $action;
}

# Default: do nothing.  Overridden for Unix & Windows.
sub _detildefy {}


# merge Module::Build argument lists that have already been parsed
# by read_args(). Takes two references to option hashes and merges
# the contents, giving priority to the first.
sub _merge_arglist {
  my( $self, $opts1, $opts2 ) = @_;

  $opts1 ||= {};
  $opts2 ||= {};
  my %new_opts = %$opts1;
  while (my ($key, $val) = each %$opts2) {
    if ( exists( $opts1->{$key} ) ) {
      if ( ref( $val ) eq 'HASH' ) {
        while (my ($k, $v) = each %$val) {
          $new_opts{$key}{$k} = $v unless exists( $opts1->{$key}{$k} );
        }
      }
    } else {
      $new_opts{$key} = $val
    }
  }

  return %new_opts;
}

# Look for a home directory on various systems.
sub _home_dir {
  my @home_dirs;
  push( @home_dirs, $ENV{HOME} ) if $ENV{HOME};

  push( @home_dirs, File::Spec->catpath($ENV{HOMEDRIVE}, $ENV{HOMEPATH}, '') )
      if $ENV{HOMEDRIVE} && $ENV{HOMEPATH};

  my @other_home_envs = qw( USERPROFILE APPDATA WINDIR SYS$LOGIN );
  push( @home_dirs, map $ENV{$_}, grep $ENV{$_}, @other_home_envs );

  my @real_home_dirs = grep -d, @home_dirs;

  return wantarray ? @real_home_dirs : shift( @real_home_dirs );
}

sub _find_user_config {
  my $self = shift;
  my $file = shift;
  foreach my $dir ( $self->_home_dir ) {
    my $path = File::Spec->catfile( $dir, $file );
    return $path if -e $path;
  }
  return undef;
}

# read ~/.modulebuildrc returning global options '*' and
# options specific to the currently executing $action.
sub read_modulebuildrc {
  my( $self, $action ) = @_;

  return () unless $self->use_rcfile;

  my $modulebuildrc;
  if ( exists($ENV{MODULEBUILDRC}) && $ENV{MODULEBUILDRC} eq 'NONE' ) {
    return ();
  } elsif ( exists($ENV{MODULEBUILDRC}) && -e $ENV{MODULEBUILDRC} ) {
    $modulebuildrc = $ENV{MODULEBUILDRC};
  } elsif ( exists($ENV{MODULEBUILDRC}) ) {
    $self->log_warn("WARNING: Can't find resource file " .
                    "'$ENV{MODULEBUILDRC}' defined in environment.\n" .
                    "No options loaded\n");
    return ();
  } else {
    $modulebuildrc = $self->_find_user_config( '.modulebuildrc' );
    return () unless $modulebuildrc;
  }

  my $fh = IO::File->new( $modulebuildrc )
      or die "Can't open $modulebuildrc: $!";

  my %options; my $buffer = '';
  while (defined( my $line = <$fh> )) {
    chomp( $line );
    $line =~ s/#.*$//;
    next unless length( $line );

    if ( $line =~ /^\S/ ) {
      if ( $buffer ) {
        my( $action, $options ) = split( /\s+/, $buffer, 2 );
        $options{$action} .= $options . ' ';
        $buffer = '';
      }
      $buffer = $line;
    } else {
      $buffer .= $line;
    }
  }

  if ( $buffer ) { # anything left in $buffer ?
    my( $action, $options ) = split( /\s+/, $buffer, 2 );
    $options{$action} .= $options . ' '; # merge if more than one line
  }

  my ($global_opts) =
    $self->read_args( $self->split_like_shell( $options{'*'} || '' ) );

  # let fakeinstall act like install if not provided
  if ( $action eq 'fakeinstall' && ! exists $options{fakeinstall} ) {
    $action = 'install';
  }
  my ($action_opts) =
    $self->read_args( $self->split_like_shell( $options{$action} || '' ) );

  # specific $action options take priority over global options '*'
  return $self->_merge_arglist( $action_opts, $global_opts );
}

# merge the relevant options in ~/.modulebuildrc into Module::Build's
# option list where they do not conflict with commandline options.
sub merge_modulebuildrc {
  my( $self, $action, %cmdline_opts ) = @_;
  my %rc_opts = $self->read_modulebuildrc( $action || $self->{action} || 'build' );
  my %new_opts = $self->_merge_arglist( \%cmdline_opts, \%rc_opts );
  $self->merge_args( $action, %new_opts );
}

sub merge_args {
  my ($self, $action, %args) = @_;
  $self->{action} = $action if defined $action;

  my %additive = map { $_ => 1 } $self->hash_properties;

  # Extract our 'properties' from $cmd_args, the rest are put in 'args'.
  while (my ($key, $val) = each %args) {
    $self->{phash}{runtime_params}->access( $key => $val )
      if $self->valid_property($key);

    if ($key eq 'config') {
      $self->config($_ => $val->{$_}) foreach keys %$val;
    } else {
      my $add_to = $additive{$key}             ? $self->{properties}{$key} :
                   $self->valid_property($key) ? $self->{properties}       :
                   $self->{args}               ;

      if ($additive{$key}) {
        $add_to->{$_} = $val->{$_} foreach keys %$val;
      } else {
        $add_to->{$key} = $val;
      }
    }
  }
}

sub cull_args {
  my $self = shift;
  my @arg_list = @_;
  unshift @arg_list, $self->split_like_shell($ENV{PERL_MB_OPT})
    if $ENV{PERL_MB_OPT};
  my ($args, $action) = $self->read_args(@arg_list);
  $self->merge_args($action, %$args);
  $self->merge_modulebuildrc( $action, %$args );
}

sub super_classes {
  my ($self, $class, $seen) = @_;
  $class ||= ref($self) || $self;
  $seen  ||= {};

  no strict 'refs';
  my @super = grep {not $seen->{$_}++} $class, @{ $class . '::ISA' };
  return @super, map {$self->super_classes($_,$seen)} @super;
}

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

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

  })->runtests(@$tests);

  return $aggregate;
}

sub run_test_harness {
    my ($self, $tests) = @_;
    require Test::Harness;
    my $p = $self->{properties};
    my @harness_switches = $self->harness_switches;

    # Work around a Test::Harness bug that loses the particular perl
    # we're running under.  $self->perl is trustworthy, but $^X isn't.
    local $^X = $self->perl;

    # Do everything in our power to work with all versions of Test::Harness
    local $Test::Harness::switches    = join ' ', grep defined, $Test::Harness::switches, @harness_switches;
    local $Test::Harness::Switches    = join ' ', grep defined, $Test::Harness::Switches, @harness_switches;
    local $ENV{HARNESS_PERL_SWITCHES} = join ' ', grep defined, $ENV{HARNESS_PERL_SWITCHES}, @harness_switches;

    $Test::Harness::switches = undef   unless length $Test::Harness::switches;
    $Test::Harness::Switches = undef   unless length $Test::Harness::Switches;
    delete $ENV{HARNESS_PERL_SWITCHES} unless length $ENV{HARNESS_PERL_SWITCHES};

    local ($Test::Harness::verbose,
           $Test::Harness::Verbose,
           $ENV{TEST_VERBOSE},
           $ENV{HARNESS_VERBOSE}) = ($p->{verbose} || 0) x 4;

    Test::Harness::runtests(@$tests);
}

sub run_visual_script {
    my $self = shift;
    # This will get run and the user will see the output.  It doesn't
    # emit Test::Harness-style output.
    $self->run_perl_script('visual.pl', '-Mblib='.$self->blib)
        if -e 'visual.pl';
}

sub harness_switches {
    shift->{properties}{debugger} ? qw(-w -d) : ();
}

sub test_files {
  my $self = shift;
  my $p = $self->{properties};
  if (@_) {
    return $p->{test_files} = (@_ == 1 ? shift : [@_]);
  }
  return $self->find_test_files;
}

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::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'), $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 $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');
}

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

  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', $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 = [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.
    return [ map $self->localize_file_path($_), @$files ];

  } else {
    # Find all possible tests in t/ or test.pl
    my @tests;
    push @tests, 'test.pl'                          if -e 'test.pl';
    push @tests, $self->expand_test_dir('t')        if -e 't' and -d _;
    return \@tests;
  }
}

sub _find_file_by_type {
  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.

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


  # XXX include feature prerequisites as optional prereqs?

  my $info = $self->_enum_prereqs;
  if (! $info ) {
    $self->log_info( "No prerequisites detected\n" );
    return;
  }

  my $failures = $self->prereq_failures($info);
  if ( ! $failures ) {
    $self->log_info( "All prerequisites satisfied\n" );
    return;
  }

  my @install;
  while (my ($type, $prereqs) = each %$failures) {
    if($type =~ m/^(?:\w+_)?requires$/) {
      push(@install, keys %$prereqs);
      next;
    }
    $self->log_info("Checking optional dependencies:\n");
    while (my ($module, $status) = each %$prereqs) {
      push(@install, $module) if($self->y_n("Install $module?", 'y'));
    }
  }

  return unless @install;

  my ($command, @opts) = $self->split_like_shell($self->cpan_client);

  # relative command should be relative to our active Perl
  # so we need to locate that command
  if ( ! File::Spec->file_name_is_absolute( $command ) ) {
    # prefer site to vendor to core
    my @loc = ( 'site', 'vendor', '' );
    my @bindirs = File::Basename::dirname($self->perl);
    push @bindirs,
      map {
        ($self->config->{"install${_}bin"}, $self->config->{"install${_}script"})
      } @loc;
    for my $d ( @bindirs ) {
      my $abs_cmd = $self->find_command(File::Spec->catfile( $d, $command ));
      if ( defined $abs_cmd ) {
        $command = $abs_cmd;
        last;
      }
    }
  }

  if ( ! -x $command ) {
    die "cpan_client '$command' is not executable\n";
  }

  $self->do_system($command, @opts, @install);
}

sub ACTION_clean {
  my ($self) = @_;
  $self->log_info("Cleaning up build files\n");
  foreach my $item (map glob($_), $self->cleanup) {
    $self->delete_filetree($item);
  }
}

sub ACTION_realclean {
  my ($self) = @_;
  $self->depends_on('clean');
  $self->log_info("Cleaning up configuration files\n");
  $self->delete_filetree(
    $self->config_dir, $self->mymetafile, $self->mymetafile2, $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 );

( run in 0.619 second using v1.01-cache-2.11-cpan-4991d5b9bd9 )