X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=Debian%2FDgit.pm;h=ec402e4d270598e3f7f6ec725812ab7582c8c7a4;hp=abcf123652e6db4917b9305cbdb5245d8802499e;hb=ca03bca3d0443c539de63050693de56c9b2e0c03;hpb=e07f113726f46b8ab921ceecd4e282d93b39c2a2 diff --git a/Debian/Dgit.pm b/Debian/Dgit.pm index abcf1236..ec402e4d 100644 --- a/Debian/Dgit.pm +++ b/Debian/Dgit.pm @@ -49,11 +49,15 @@ BEGIN { failedcmd_report_cmd failedcmd runcmd cmdoutput cmdoutput_errok git_rev_parse git_cat_file - git_get_ref git_for_each_ref + git_get_ref git_get_symref git_for_each_ref git_for_each_tag_referring is_fast_fwd + git_check_unmodified $package_re $component_re $deliberately_re $distro_re $versiontag_re $series_filename_re + $extra_orig_namepart_re + $git_null_obj $branchprefix + $ffq_refprefix initdebug enabledebug enabledebuglevel printdebug debugcmd $debugprefix *debuglevel *DEBUG @@ -80,6 +84,9 @@ our $distro_re = $component_re; our $versiontag_re = qr{[-+.\%_0-9a-zA-Z/]+}; our $branchprefix = 'dgit'; our $series_filename_re = qr{(?:^|\.)series(?!\n)$}s; +our $extra_orig_namepart_re = qr{[-0-9a-z]+}; +our $git_null_obj = '0' x 40; +our $ffq_refprefix = 'ffq-prev'; # policy hook exit status bits # see dgit-repos-server head comment for documentation @@ -108,7 +115,7 @@ sub forkcheck_mainprocess () { sub setup_sigwarn () { forkcheck_setup(); $SIG{__WARN__} = sub { - die $_[0] if forkcheck_mainprocess; + confess $_[0] if forkcheck_mainprocess; }; } @@ -381,6 +388,19 @@ sub git_cat_file ($;$) { return $chk->($type, $data); } +sub git_get_symref (;$) { + my ($symref) = @_; $symref //= 'HEAD'; + # => undef if not a symref, otherwise refs/... + my @cmd = (qw(git symbolic-ref -q HEAD)); + my $branch = cmdoutput_errok @cmd; + if (!defined $branch) { + $?==256 or failedcmd @cmd; + } else { + chomp $branch; + } + return $branch; +} + sub git_for_each_ref ($$;$) { my ($pattern,$func,$gitdir) = @_; # calls $func->($objid,$objtype,$fullrefname,$reftail); @@ -428,6 +448,25 @@ sub git_for_each_tag_referring ($$) { }); } +sub git_check_unmodified () { + foreach my $cached (qw(0 1)) { + my @cmd = qw(git diff --quiet); + push @cmd, qw(--cached) if $cached; + push @cmd, qw(HEAD); + debugcmd "+",@cmd; + $!=0; $?=-1; system @cmd; + return if !$?; + if ($?==256) { + fail + $cached + ? "git index contains changes (does not match HEAD)" + : "working tree is dirty (does not match HEAD)"; + } else { + failedcmd @cmd; + } + } +} + sub is_fast_fwd ($$) { my ($ancestor,$child) = @_; my @cmd = (qw(git merge-base), $ancestor, $child);