From: Ian Jackson Date: Sun, 17 May 2015 13:45:04 +0000 (+0100) Subject: Move various useful functions into Dgit.pm. Necessitates some slightly fancy footwor... X-Git-Tag: debian/0.30~143 X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=commitdiff_plain;h=e6ce71a87a1ca14ce90fc78023725d9f3bec54ee;hp=8007c2b1326e7deffa1c71d2d51ebca08107084a Move various useful functions into Dgit.pm. Necessitates some slightly fancy footwork with $::us --- diff --git a/Debian/Dgit.pm b/Debian/Dgit.pm index b21a431e..00b4aa54 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 =

; } + 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); diff --git a/dgit b/dgit index 3d362809..4f0329a4 100755 --- a/dgit +++ b/dgit @@ -32,7 +32,6 @@ use POSIX; use IPC::Open2; use Digest::SHA; use Digest::MD5; -use Config; use Debian::Dgit; @@ -140,30 +139,6 @@ END { } }; -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 fail { - my $s = "@_\n"; - my $prefix = $us.($we_are_responder ? " (build host)" : "").": "; - $s =~ s/^/$prefix/gm; - die $s; -} - sub badcfg { print STDERR "$us: invalid configuration: @_\n"; exit 12; } sub no_such_package () { @@ -375,17 +350,6 @@ sub url_get { our ($dscdata,$dscurl,$dsc,$dsc_checked,$skew_warning_vsn); -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 runcmd { debugcmd "+",@_; $!=0; $?=0; @@ -403,27 +367,6 @@ sub printdone { } } -sub cmdoutput_errok { - die Dumper(\@_)." ?" if grep { !defined } @_; - debugcmd "|",@_; - open P, "-|", @_ or die $!; - my $d; - $!=0; $?=0; - { local $/ = undef; $d =

; } - 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 dryrun_report { printcmd(\*STDERR,$debugprefix."#",@_); } @@ -1912,9 +1855,9 @@ sub cmd_push { } else { fail "dgit push: HEAD is not a descendant". " of the archive's version.\n". - "$us: To overwrite its contents,". + "dgit: To overwrite its contents,". " use git merge -s ours ".lrref().".\n". - "$us: To rewind history, if permitted by the archive,". + "dgit: To rewind history, if permitted by the archive,". " use --deliberately-not-fast-forward"; } } else { @@ -1938,6 +1881,7 @@ sub cmd_remote_push_build_host { # offered several) $debugprefix = ' '; $we_are_responder = 1; + $us .= " (build host)"; open PI, "<&STDIN" or die $!; open STDIN, "/dev/null" or die $!;