diff options
author | Ian Jackson <ijackson@chiark.greenend.org.uk> | 2015-05-17 14:45:04 +0100 |
---|---|---|
committer | Ian Jackson <ijackson@chiark.greenend.org.uk> | 2015-05-31 11:54:15 +0100 |
commit | e6ce71a87a1ca14ce90fc78023725d9f3bec54ee (patch) | |
tree | f4203a394788948e70a413a3bd65e3d491d990c1 /Debian/Dgit.pm | |
parent | 8007c2b1326e7deffa1c71d2d51ebca08107084a (diff) |
Move various useful functions into Dgit.pm. Necessitates some slightly fancy footwork with $::us
Diffstat (limited to 'Debian/Dgit.pm')
-rw-r--r-- | Debian/Dgit.pm | 66 |
1 files changed, 65 insertions, 1 deletions
diff --git a/Debian/Dgit.pm b/Debian/Dgit.pm index b21a431..00b4aa5 100644 --- a/Debian/Dgit.pm +++ b/Debian/Dgit.pm @@ -7,6 +7,7 @@ use warnings; use POSIX; use IO::Handle; +use Config; BEGIN { use Exporter (); @@ -15,7 +16,9 @@ BEGIN { $VERSION = 1.00; @ISA = qw(Exporter); @EXPORT = qw(debiantag server_branch server_ref - stat_exists git_for_each_ref + stat_exists fail waitstatusmsg failedcmd + cmdoutput cmdoutput_errok + git_for_each_ref git_for_each_tag_referring $package_re $component_re $deliberately_re $branchprefix @@ -23,6 +26,7 @@ BEGIN { printdebug debugcmd $debugprefix *debuglevel *DEBUG shellquote printcmd); + # implicitly uses $main::us %EXPORT_TAGS = ( policyflags => [qw(NOFFCHECK FRESHREPO)] ); @EXPORT_OK = @{ $EXPORT_TAGS{policyflags} }; } @@ -113,6 +117,66 @@ sub stat_exists ($) { die "stat $f: $!"; } +sub _us () { + $::us // ($0 =~ m#[^/]*$#, $&); +} + +sub fail { + my $s = "@_\n"; + my $prefix = _us().": "; + $s =~ s/^/$prefix/gm; + die $s; +} + +our @signames = split / /, $Config{sig_name}; + +sub waitstatusmsg () { + if (!$?) { + return "terminated, reporting successful completion"; + } elsif (!($? & 255)) { + return "failed with error exit status ".WEXITSTATUS($?); + } elsif (WIFSIGNALED($?)) { + my $signum=WTERMSIG($?); + return "died due to fatal signal ". + ($signames[$signum] // "number $signum"). + ($? & 128 ? " (core dumped)" : ""); # POSIX(3pm) has no WCOREDUMP + } else { + return "failed with unknown wait status ".$?; + } +} + +sub failedcmd { + { local ($!); printcmd \*STDERR, _us().": failed command:", @_ or die $!; }; + if ($!) { + fail "failed to fork/exec: $!"; + } elsif ($?) { + fail "subprocess ".waitstatusmsg(); + } else { + fail "subprocess produced invalid output"; + } +} + +sub cmdoutput_errok { + die Dumper(\@_)." ?" if grep { !defined } @_; + debugcmd "|",@_; + open P, "-|", @_ or die $!; + my $d; + $!=0; $?=0; + { local $/ = undef; $d = <P>; } + die $! if P->error; + if (!close P) { printdebug "=>!$?\n"; return undef; } + chomp $d; + $d =~ m/^.*/; + printdebug "=> \`$&'",(length $' ? '...' : ''),"\n" if $debuglevel>0; #'; + return $d; +} + +sub cmdoutput { + my $d = cmdoutput_errok @_; + defined $d or failedcmd @_; + return $d; +} + sub git_for_each_ref ($$) { my ($pattern,$func) = @_; # calls $func->($objid,$objtype,$fullrefname,$reftail); |