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