1################################################################################
2#
3#  devtools.pl -- various utility functions
4#
5################################################################################
6#
7#  Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz.
8#  Version 2.x, Copyright (C) 2001, Paul Marquess.
9#  Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
10#
11#  This program is free software; you can redistribute it and/or
12#  modify it under the same terms as Perl itself.
13#
14################################################################################
15
16use IO::File;
17
18eval "use Term::ANSIColor";
19$@ and eval "sub colored { pop; @_ }";
20
21my @argvcopy = @ARGV;
22
23sub verbose
24{
25  if ($opt{verbose}) {
26    my @out = @_;
27    s/^(.*)/colored("($0) ", 'bold blue').colored($1, 'blue')/eg for @out;
28    print STDERR @out;
29  }
30}
31
32sub ddverbose
33{
34  return $opt{verbose} ? ('--verbose') : ();
35}
36
37sub runtool
38{
39  my $opt = ref $_[0] ? shift @_ : {};
40  my($prog, @args) = @_;
41  my $sysstr = join ' ', map { "'$_'" } $prog, @args;
42  $sysstr .= " >$opt->{'out'}"  if exists $opt->{'out'};
43  $sysstr .= " 2>$opt->{'err'}" if exists $opt->{'err'};
44  verbose("running $sysstr\n");
45  my $rv = system $sysstr;
46  verbose("$prog => exit code $rv\n");
47  return not $rv;
48}
49
50sub runperl
51{
52  my $opt = ref $_[0] ? shift @_ : {};
53  runtool($opt, $^X, @_);
54}
55
56sub run
57{
58  my $prog = shift;
59  my @args = @_;
60
61  runtool({ 'out' => 'tmp.out', 'err' => 'tmp.err' }, $prog, @args);
62
63  my $out = IO::File->new("tmp.out") or die "tmp.out: $!\n";
64  my $err = IO::File->new("tmp.err") or die "tmp.err: $!\n";
65
66  my %rval = (
67    status    => $? >> 8,
68    stdout    => [<$out>],
69    stderr    => [<$err>],
70    didnotrun => 0,
71  );
72
73  unlink "tmp.out", "tmp.err";
74
75  $? & 128 and $rval{core}   = 1;
76  $? & 127 and $rval{signal} = $? & 127;
77
78  return \%rval;
79}
80
81sub ident_str
82{
83  return "$^X $0 @argvcopy";
84}
85
86sub identify
87{
88  verbose(ident_str() . "\n");
89}
90
91sub ask($)
92{
93  my $q = shift;
94  my $a;
95  local $| = 1;
96  print "\n$q [y/n] ";
97  do { $a = <>; } while ($a !~ /^\s*([yn])\s*$/i);
98  return lc $1 eq 'y';
99}
100
101sub quit_now
102{
103  print "\nSorry, cannot continue.\n\n";
104  exit 1;
105}
106
107sub ask_or_quit
108{
109  quit_now unless &ask;
110}
111
112sub eta
113{
114  my($start, $i, $n) = @_;
115  return "--:--:--" if $i < 3;
116  my $elapsed = tv_interval($start);
117  my $h = int($elapsed*($n-$i)/$i);
118  my $s = $h % 60; $h /= 60;
119  my $m = $h % 60; $h /= 60;
120  return sprintf "%02d:%02d:%02d", $h, $m, $s;
121}
122
1231;
124