view release on metacpan or  search on metacpan

lib/App/FQStat/System.pm  view on Meta::CPAN

sub run_local {
  warnenter if ::DEBUG;
  warnline "Running '@_' locally." if ::DEBUG > 1;
  return system(@_);
}

sub run_local_capture {
  warnenter if ::DEBUG;
  warnline "Running '@_' locally, capturing." if ::DEBUG > 1;
  my $cmd = String::ShellQuote::shell_quote(@_);
  return `$cmd`;
}

sub run {
  warnenter if ::DEBUG;
  warnline "Running '@_'." if ::DEBUG > 1;
  my $cmd = _make_system_call(@_);
  return system($cmd);
}

sub run_capture {
  warnenter if ::DEBUG;
  warnline "Running '@_' capturing." if ::DEBUG > 1;
  my $cmd = _make_system_call(@_);
  return `$cmd`;
}

sub _make_system_call {
  warnenter if ::DEBUG > 1;
  my $ssh = get_config("sshcommand");

  my $cmd = String::ShellQuote::shell_quote(@_);
  if (defined $ssh and not $ssh eq '') {
    if ($ssh =~ s/!COMMAND!/$cmd/g) {
      $cmd = $ssh;
    }
    else {
      $cmd = "$ssh $cmd";
    }
  }

  warnline "Generated shell commannd '$cmd'." if ::DEBUG > 1;
  return $cmd;
}


# lifted and modified from Module::Install::Can ((c) Brian Ingerson, Audrey Tang, Adam Kennedy, et al)
# check if we can run some command
sub module_install_can_run {
  warnenter if ::DEBUG;
  my $cmd = shift;
  my $ssh = get_config("sshcommand");
  require ExtUtils::MakeMaker;
  require Config;
  require File::Spec;
  my $_cmd = $cmd;
  if (defined $ssh and $ssh ne '') {
# too slow...
    return $_cmd; # err, right!
#    my $cmd_escape = $cmd;
#    $cmd_escape =~ s/'/\\'g/; # bad
#    my $problem = run(
#      'perl', '-e',
#      q|use ExtUtils::MakeMaker; if(-x '|
#        . $cmd_escape 
#        . q|' or MM->maybe_command('|
#        . $cmd_escape
#        . q|'){exit(0)}else{exit(1)}|
#    );
#    return $_cmd unless $problem;

  }
  else {
    return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd));
    for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
      my $abs = File::Spec->catfile($dir, $cmd);
      return $abs if (-x $abs or $abs = MM->maybe_command($abs));
    }
  }

  return;
}



1;