X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=Debian%2FDgit.pm;h=bfa76cc70de127d66e1e235db79c0b83e2f2a16e;hp=aa0c5a3d675cbf1d7418c222a2e5a9f7a6819182;hb=509af629e19c6c9d973d9fc8cd1739bd8de2d9d9;hpb=0658281163715a24c940509ebb8b0a7493e33787 diff --git a/Debian/Dgit.pm b/Debian/Dgit.pm index aa0c5a3d..bfa76cc7 100644 --- a/Debian/Dgit.pm +++ b/Debian/Dgit.pm @@ -5,10 +5,12 @@ package Debian::Dgit; use strict; use warnings; +use Carp; use POSIX; use IO::Handle; use Config; use Digest::SHA; +use Data::Dumper; BEGIN { use Exporter (); @@ -17,7 +19,8 @@ BEGIN { $VERSION = 1.00; @ISA = qw(Exporter); @EXPORT = qw(setup_sigwarn - debiantag server_branch server_ref + debiantags debiantag_old debiantag_new + server_branch server_ref stat_exists link_ltarget hashfile fail ensuredir executable_on_path @@ -123,12 +126,23 @@ sub debugcmd { printcmd(\*DEBUG,$debugprefix.$extraprefix,@_) if $debuglevel>0; } -sub debiantag ($$) { +sub debiantag_old ($$) { my ($v,$distro) = @_; $v =~ y/~:/_%/; return "$distro/$v"; } +sub debiantag_new ($$) { + my ($v,$distro) = @_; + $v =~ y/~:/_%/; + return "archive/$distro/$v"; +} + +sub debiantags ($$) { + my ($version,$distro) = @_; + map { $_->($version, $distro) } (\&debiantag_new, \&debiantag_old); +} + sub server_branch ($) { return "$branchprefix/$_[0]"; } sub server_ref ($) { return "refs/".server_branch($_[0]); } @@ -208,7 +222,7 @@ sub failedcmd { } sub cmdoutput_errok { - die Dumper(\@_)." ?" if grep { !defined } @_; + confess Dumper(\@_)." ?" if grep { !defined } @_; debugcmd "|",@_; open P, "-|", @_ or die "$_[0] $!"; my $d; @@ -258,7 +272,9 @@ sub git_for_each_ref ($$;$) { # calls $func->($objid,$objtype,$fullrefname,$reftail); # $reftail is RHS of ref after refs/[^/]+/ # breaks if $pattern matches any ref `refs/blah' where blah has no `/' - my @cmd = (qw(git for-each-ref), $pattern); + # $pattern may be an array ref to mean multiple patterns + $pattern = [ $pattern ] unless ref $pattern; + my @cmd = (qw(git for-each-ref), @$pattern); if (defined $gitdir) { @cmd = ('sh','-ec','cd "$1"; shift; exec "$@"','x', $gitdir, @cmd); }