diff options
Diffstat (limited to 'Debian/Dgit.pm')
| -rw-r--r-- | Debian/Dgit.pm | 121 |
1 files changed, 113 insertions, 8 deletions
diff --git a/Debian/Dgit.pm b/Debian/Dgit.pm index 1cd765d..91d4c71 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 (); @@ -57,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 @@ -66,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 @@ -100,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 @@ -156,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 ($) { @@ -195,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 ($) { @@ -266,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; @@ -362,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; @@ -414,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) { @@ -667,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 <<END; +tree $tree +parent $value +author $authline +committer $authline + +Dummy commit - do not use +END + runcmd qw(git update-ref -m), _us()." - dummy", $ref, $dummy; + } + runcmd qw(git update-ref -m), $cachekey, $ref, $value; +} + +sub reflog_cache_lookup ($$) { + my ($ref, $cachekey) = @_; + # you may call this in $maindir or in a playtree + # you must have called record_maindir + my @cmd = (qw(git log -g), '--pretty=format:%H %gs', $ref); + debugcmd "|(probably)",@cmd; + my $child = open GC, "-|"; defined $child or die $!; + if (!$child) { + chdir $maindir or die $!; + if (!stat "$maindir_gitcommon/logs/$ref") { + $! == ENOENT or die $!; + printdebug ">(no reflog)\n"; + finish 0; + } + exec @cmd; die $!; + } + while (<GC>) { + 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: @@ -715,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 () { |