X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=blobdiff_plain;f=Debian%2FDgit.pm;h=91d4c7111f57dc80a16943714f38fe66850e0dfb;hb=e032c0f964491a71e8918b79ad2a774993074085;hp=787e50655487ec1e672a0c06aeb642f28e17a3b9;hpb=dcdaf7a166dbf5599eefb8174a2445ed90560e23;p=dgit.git diff --git a/Debian/Dgit.pm b/Debian/Dgit.pm index 787e5065..91d4c711 100644 --- a/Debian/Dgit.pm +++ b/Debian/Dgit.pm @@ -32,6 +32,7 @@ use IPC::Open2; use File::Path; use File::Basename; use Dpkg::Control::Hash; +use Debian::Dgit::ExitStatus; BEGIN { use Exporter (); @@ -43,6 +44,7 @@ BEGIN { dep14_version_mangle debiantags debiantag_old debiantag_new debiantag_maintview + upstreamversion stripepoch source_file_leafname is_orig_file_of_p_v server_branch server_ref stat_exists link_ltarget @@ -56,6 +58,8 @@ BEGIN { git_for_each_tag_referring is_fast_fwd git_check_unmodified git_reflog_action_msg git_update_ref_cmd + make_commit_text + reflog_cache_insert reflog_cache_lookup $package_re $component_re $deliberately_re $distro_re $versiontag_re $series_filename_re $orig_f_comp_re $orig_f_sig_re $orig_f_tail_re @@ -65,6 +69,7 @@ BEGIN { $ffq_refprefix $gdrlast_refprefix initdebug enabledebug enabledebuglevel printdebug debugcmd + $printdebug_when_debuglevel $debugcmd_when_debuglevel $debugprefix *debuglevel *DEBUG shellquote printcmd messagequote $negate_harmful_gitattrs @@ -99,6 +104,13 @@ our $orig_f_tail_re = "$orig_f_comp_re\\.tar(?:\\.\\w+)?(?:$orig_f_sig_re)?"; our $git_null_obj = '0' x 40; our $ffq_refprefix = 'ffq-prev'; our $gdrlast_refprefix = 'debrebase-last'; +our $printdebug_when_debuglevel = 1; +our $debugcmd_when_debuglevel = 1; + +# these three all go together, only valid after record_maindir +our $maindir; +our $maindir_gitdir; +our $maindir_gitcommon; # policy hook exit status bits # see dgit-repos-server head comment for documentation @@ -155,7 +167,21 @@ sub enabledebuglevel ($) { } sub printdebug { - print DEBUG $debugprefix, @_ or die $! if $debuglevel>0; + # Prints a prefix, and @_, to DEBUG. @_ should normally contain + # a trailing \n. + + # With no (or only empty) arguments just prints the prefix and + # leaves the caller to do more with DEBUG. The caller should make + # sure then to call printdebug with something ending in "\n" to + # get the prefix right in subsequent calls. + + return unless $debuglevel >= $printdebug_when_debuglevel; + our $printdebug_noprefix; + print DEBUG $debugprefix unless $printdebug_noprefix; + pop @_ while @_ and !length $_[-1]; + return unless @_; + print DEBUG @_ or die $!; + $printdebug_noprefix = $_[-1] !~ m{\n$}; } sub messagequote ($) { @@ -194,7 +220,8 @@ sub printcmd { sub debugcmd { my $extraprefix = shift @_; - printcmd(\*DEBUG,$debugprefix.$extraprefix,@_) if $debuglevel>0; + printcmd(\*DEBUG,$debugprefix.$extraprefix,@_) + if $debuglevel >= $debugcmd_when_debuglevel; } sub dep14_version_mangle ($) { @@ -231,6 +258,12 @@ sub stripepoch ($) { return $vsn; } +sub upstreamversion ($) { + my ($vsn) = @_; + $vsn =~ s/-[^-]+$//; + return $vsn; +} + sub source_file_leafname ($$$) { my ($package,$vsn,$sfx) = @_; return "${package}_".(stripepoch $vsn).$sfx @@ -259,7 +292,7 @@ sub _us () { sub failmsg { my $s = "error: @_\n"; - $s =~ s/\n\n$/\n/; + $s =~ s/\n\n$/\n/g; my $prefix = _us().": "; $s =~ s/^/$prefix/gm; return "\n".$s; @@ -355,6 +388,7 @@ sub shell_cmd { sub cmdoutput_errok { confess Dumper(\@_)." ?" if grep { !defined } @_; + local $printdebug_when_debuglevel = $debugcmd_when_debuglevel; debugcmd "|",@_; open P, "-|", @_ or die "$_[0] $!"; my $d; @@ -407,6 +441,7 @@ sub git_cat_file ($;$) { # in scalar context, just the data # if $etype defined, dies unless type is $etype or in @$etype our ($gcf_pid, $gcf_i, $gcf_o); + local $printdebug_when_debuglevel = $debugcmd_when_debuglevel; my $chk = sub { my ($gtype, $data) = @_; if ($etype) { @@ -660,6 +695,88 @@ sub parsechangelog_loop ($$$) { close CLOGS or $?==SIGPIPE or failedcmd @$clogcmd; } +sub make_commit_text ($) { + my ($text) = @_; + my ($out, $in); + my @cmd = (qw(git hash-object -w -t commit --stdin)); + debugcmd "|",@cmd; + print Dumper($text) if $debuglevel > 1; + my $child = open2($out, $in, @cmd) or die $!; + my $h; + eval { + print $in $text or die $!; + close $in or die $!; + $h = <$out>; + $h =~ m/^\w+$/ or die; + $h = $&; + printdebug "=> $h\n"; + }; + close $out; + waitpid $child, 0 == $child or die "$child $!"; + $? and failedcmd @cmd; + return $h; +} + +sub reflog_cache_insert ($$$) { + my ($ref, $cachekey, $value) = @_; + # you must call this in $maindir + # you must have called record_maindir + + # When we no longer need to support squeeze, use --create-reflog + # instead of this: + my $parent = $ref; $parent =~ s{/[^/]+$}{}; + ensuredir "$maindir_gitcommon/logs/$parent"; + my $makelogfh = new IO::File "$maindir_gitcommon/logs/$ref", '>>' + or die $!; + + my $oldcache = git_get_ref $ref; + + if ($oldcache eq $value) { + my $tree = cmdoutput qw(git rev-parse), "$value:"; + # git update-ref doesn't always update, in this case. *sigh* + my $authline = (ucfirst _us()). + ' <'._us().'@example.com> 1000000000 +0000'; + my $dummy = make_commit_text <(no reflog)\n"; + finish 0; + } + exec @cmd; die $!; + } + while () { + chomp; + printdebug ">| ", $_, "\n" if $debuglevel > 1; + next unless m/^(\w+) (\S.*\S)$/ && $2 eq $cachekey; + close GC; + return $1; + } + die $! if GC->error; + failedcmd unless close GC; + return undef; +} + # ========== playground handling ========== # terminology: @@ -708,11 +825,6 @@ sub parsechangelog_loop ($$$) { # ----- maindir ----- -# these three all go together -our $maindir; -our $maindir_gitdir; -our $maindir_gitcommon; - our $local_git_cfg; sub record_maindir () {