X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=Debian%2FDgit.pm;h=314bd8c712c6159fe031bfe8073a62f902666f84;hp=1bac97bde55d02a5cc00e0ba388348f7f8537012;hb=e9a3ab8ab115a663975026c84332a1d0bdc7264b;hpb=f93eae496d1ab8aebe85d9080c4e372ebe9b3715 diff --git a/Debian/Dgit.pm b/Debian/Dgit.pm index 1bac97bd..314bd8c7 100644 --- a/Debian/Dgit.pm +++ b/Debian/Dgit.pm @@ -28,6 +28,7 @@ use IO::Handle; use Config; use Digest::SHA; use Data::Dumper; +use IPC::Open2; BEGIN { use Exporter (); @@ -45,7 +46,8 @@ BEGIN { waitstatusmsg failedcmd_waitstatus failedcmd_report_cmd failedcmd cmdoutput cmdoutput_errok - git_rev_parse git_get_ref git_for_each_ref + git_rev_parse git_cat_file + git_get_ref git_for_each_ref git_for_each_tag_referring is_fast_fwd $package_re $component_re $deliberately_re $branchprefix @@ -54,7 +56,7 @@ BEGIN { $debugprefix *debuglevel *DEBUG shellquote printcmd messagequote); # implicitly uses $main::us - %EXPORT_TAGS = ( policyflags => [qw(NOFFCHECK FRESHREPO)] ); + %EXPORT_TAGS = ( policyflags => [qw(NOFFCHECK FRESHREPO NOCOMMITCHECK)] ); @EXPORT_OK = @{ $EXPORT_TAGS{policyflags} }; } @@ -71,6 +73,7 @@ our $branchprefix = 'dgit'; # dynamic loader, runtime, etc., failures, which report 127 or 255 sub NOFFCHECK () { return 0x2; } sub FRESHREPO () { return 0x4; } +sub NOCOMMITCHECK () { return 0x8; } our $debugprefix; our $debuglevel = 0; @@ -289,7 +292,9 @@ sub link_ltarget ($$) { if (-l _) { $old = cmdoutput qw(realpath --), $old; } - link $old, $new or die "link $old $new: $!"; + my $r = link $old, $new; + $r = symlink $old, $new if !$r && $!==EXDEV; + $r or die "(sym)link $old $new: $!"; } sub hashfile ($) { @@ -303,6 +308,28 @@ sub git_rev_parse ($) { return cmdoutput qw(git rev-parse), "$_[0]~0"; } +sub git_cat_file ($) { + my ($objname) = @_; + # => ($type, $data) or ('missing', undef) + our ($gcf_pid, $gcf_i, $gcf_o); + if (!$gcf_pid) { + my @cmd = qw(git cat-file --batch); + debugcmd "GCF|", @cmd; + $gcf_pid = open2 $gcf_o, $gcf_i, @cmd or die $!; + } + printdebug "GCF>| ", $objname, "\n"; + print $gcf_i $objname, "\n" or die $!; + my $x = <$gcf_o>; + printdebug "GCF<| ", $x; + if ($x =~ m/ (missing)$/) { return ($1, undef); } + my ($type, $size) = $x =~ m/^.* (\w+) (\d+)\n/ or die "$objname ?"; + my $data; + (read $gcf_o, $data, $size) == $size or die "$objname $!"; + $x = <$gcf_o>; + $x eq "\n" or die "$objname ($_) $!"; + return ($type, $data); +} + sub git_for_each_ref ($$;$) { my ($pattern,$func,$gitdir) = @_; # calls $func->($objid,$objtype,$fullrefname,$reftail);