Blame devel/devtools.pl

Packit 7d6a7d
################################################################################
Packit 7d6a7d
#
Packit 7d6a7d
#  devtools.pl -- various utility functions
Packit 7d6a7d
#
Packit 7d6a7d
################################################################################
Packit 7d6a7d
#
Packit 7d6a7d
#  Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz.
Packit 7d6a7d
#  Version 2.x, Copyright (C) 2001, Paul Marquess.
Packit 7d6a7d
#  Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
Packit 7d6a7d
#
Packit 7d6a7d
#  This program is free software; you can redistribute it and/or
Packit 7d6a7d
#  modify it under the same terms as Perl itself.
Packit 7d6a7d
#
Packit 7d6a7d
################################################################################
Packit 7d6a7d
Packit 7d6a7d
use IO::File;
Packit 7d6a7d
Packit 7d6a7d
eval "use Term::ANSIColor";
Packit 7d6a7d
$@ and eval "sub colored { pop; @_ }";
Packit 7d6a7d
Packit 7d6a7d
my @argvcopy = @ARGV;
Packit 7d6a7d
Packit 7d6a7d
sub verbose
Packit 7d6a7d
{
Packit 7d6a7d
  if ($opt{verbose}) {
Packit 7d6a7d
    my @out = @_;
Packit 7d6a7d
    s/^(.*)/colored("($0) ", 'bold blue').colored($1, 'blue')/eg for @out;
Packit 7d6a7d
    print STDERR @out;
Packit 7d6a7d
  }
Packit 7d6a7d
}
Packit 7d6a7d
Packit 7d6a7d
sub ddverbose
Packit 7d6a7d
{
Packit 7d6a7d
  return $opt{verbose} ? ('--verbose') : ();
Packit 7d6a7d
}
Packit 7d6a7d
Packit 7d6a7d
sub runtool
Packit 7d6a7d
{
Packit 7d6a7d
  my $opt = ref $_[0] ? shift @_ : {};
Packit 7d6a7d
  my($prog, @args) = @_;
Packit 7d6a7d
  my $sysstr = join ' ', map { "'$_'" } $prog, @args;
Packit 7d6a7d
  $sysstr .= " >$opt->{'out'}"  if exists $opt->{'out'};
Packit 7d6a7d
  $sysstr .= " 2>$opt->{'err'}" if exists $opt->{'err'};
Packit 7d6a7d
  verbose("running $sysstr\n");
Packit 7d6a7d
  my $rv = system $sysstr;
Packit 7d6a7d
  verbose("$prog => exit code $rv\n");
Packit 7d6a7d
  return not $rv;
Packit 7d6a7d
}
Packit 7d6a7d
Packit 7d6a7d
sub runperl
Packit 7d6a7d
{
Packit 7d6a7d
  my $opt = ref $_[0] ? shift @_ : {};
Packit 7d6a7d
  runtool($opt, $^X, @_);
Packit 7d6a7d
}
Packit 7d6a7d
Packit 7d6a7d
sub run
Packit 7d6a7d
{
Packit 7d6a7d
  my $prog = shift;
Packit 7d6a7d
  my @args = @_;
Packit 7d6a7d
Packit 7d6a7d
  runtool({ 'out' => 'tmp.out', 'err' => 'tmp.err' }, $prog, @args);
Packit 7d6a7d
Packit 7d6a7d
  my $out = IO::File->new("tmp.out") or die "tmp.out: $!\n";
Packit 7d6a7d
  my $err = IO::File->new("tmp.err") or die "tmp.err: $!\n";
Packit 7d6a7d
Packit 7d6a7d
  my %rval = (
Packit 7d6a7d
    status    => $? >> 8,
Packit 7d6a7d
    stdout    => [<$out>],
Packit 7d6a7d
    stderr    => [<$err>],
Packit 7d6a7d
    didnotrun => 0,
Packit 7d6a7d
  );
Packit 7d6a7d
Packit 7d6a7d
  unlink "tmp.out", "tmp.err";
Packit 7d6a7d
Packit 7d6a7d
  $? & 128 and $rval{core}   = 1;
Packit 7d6a7d
  $? & 127 and $rval{signal} = $? & 127;
Packit 7d6a7d
Packit 7d6a7d
  return \%rval;
Packit 7d6a7d
}
Packit 7d6a7d
Packit 7d6a7d
sub ident_str
Packit 7d6a7d
{
Packit 7d6a7d
  return "$^X $0 @argvcopy";
Packit 7d6a7d
}
Packit 7d6a7d
Packit 7d6a7d
sub identify
Packit 7d6a7d
{
Packit 7d6a7d
  verbose(ident_str() . "\n");
Packit 7d6a7d
}
Packit 7d6a7d
Packit 7d6a7d
sub ask($)
Packit 7d6a7d
{
Packit 7d6a7d
  my $q = shift;
Packit 7d6a7d
  my $a;
Packit 7d6a7d
  local $| = 1;
Packit 7d6a7d
  print "\n$q [y/n] ";
Packit 7d6a7d
  do { $a = <>; } while ($a !~ /^\s*([yn])\s*$/i);
Packit 7d6a7d
  return lc $1 eq 'y';
Packit 7d6a7d
}
Packit 7d6a7d
Packit 7d6a7d
sub quit_now
Packit 7d6a7d
{
Packit 7d6a7d
  print "\nSorry, cannot continue.\n\n";
Packit 7d6a7d
  exit 1;
Packit 7d6a7d
}
Packit 7d6a7d
Packit 7d6a7d
sub ask_or_quit
Packit 7d6a7d
{
Packit 7d6a7d
  quit_now unless &ask;
Packit 7d6a7d
}
Packit 7d6a7d
Packit 7d6a7d
sub eta
Packit 7d6a7d
{
Packit 7d6a7d
  my($start, $i, $n) = @_;
Packit 7d6a7d
  return "--:--:--" if $i < 3;
Packit 7d6a7d
  my $elapsed = tv_interval($start);
Packit 7d6a7d
  my $h = int($elapsed*($n-$i)/$i);
Packit 7d6a7d
  my $s = $h % 60; $h /= 60;
Packit 7d6a7d
  my $m = $h % 60; $h /= 60;
Packit 7d6a7d
  return sprintf "%02d:%02d:%02d", $h, $m, $s;
Packit 7d6a7d
}
Packit 7d6a7d
Packit 7d6a7d
1;