git-debrebase: Make read_tree_debian global (nfc)

[dgit.git] / Debian / Dgit.pm

diff --git a/Debian/Dgit.pm b/Debian/Dgit.pm
index 5106f8517c4e08c26a67661c5e3fcbb17575cc5e..1cd765df979067bf6b3c2424dfcac0161709e794 100644 (file)
--- a/Debian/Dgit.pm
+++ b/Debian/Dgit.pm
@@ -31,6 +31,7 @@ use Data::Dumper;
 use IPC::Open2;
 use File::Path;
 use File::Basename;
+use Dpkg::Control::Hash;
 
 BEGIN {
     use Exporter   ();
@@ -41,6 +42,9 @@ BEGIN {
     @EXPORT      = qw(setup_sigwarn forkcheck_setup forkcheck_mainprocess
                      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
                      hashfile
@@ -55,6 +59,7 @@ BEGIN {
                      git_reflog_action_msg  git_update_ref_cmd
                       $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
                      $extra_orig_namepart_re
                      $git_null_obj
                       $branchprefix
@@ -66,6 +71,8 @@ BEGIN {
                       $negate_harmful_gitattrs
                      changedir git_slurp_config_src
                      gdr_ffq_prev_branchinfo
+                     parsecontrolfh parsecontrol parsechangelog
+                     getfield parsechangelog_loop
                      playtree_setup);
     # implicitly uses $main::us
     %EXPORT_TAGS = ( policyflags => [qw(NOFFCHECK FRESHREPO NOCOMMITCHECK)],
@@ -87,6 +94,9 @@ 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 $orig_f_comp_re = qr{orig(?:-$extra_orig_namepart_re)?};
+our $orig_f_sig_re = '\\.(?:asc|gpg|pgp)';
+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';
@@ -206,11 +216,40 @@ sub debiantag_new ($$) {
     return "archive/$distro/".dep14_version_mangle $v;
 }
 
+sub debiantag_maintview ($$) { 
+    my ($v,$distro) = @_;
+    return "$distro/".dep14_version_mangle $v;
+}
+
 sub debiantags ($$) {
     my ($version,$distro) = @_;
     map { $_->($version, $distro) } (\&debiantag_new, \&debiantag_old);
 }
 
+sub stripepoch ($) {
+    my ($vsn) = @_;
+    $vsn =~ s/^\d+\://;
+    return $vsn;
+}
+
+sub upstreamversion ($) {
+    my ($vsn) = @_;
+    $vsn =~ s/-[^-]+$//;
+    return $vsn;
+}
+
+sub source_file_leafname ($$$) {
+    my ($package,$vsn,$sfx) = @_;
+    return "${package}_".(stripepoch $vsn).$sfx
+}
+
+sub is_orig_file_of_p_v ($$$) {
+    my ($f, $package, $upstreamvsn) = @_;
+    my $base = source_file_leafname $package, $upstreamvsn, '';
+    return 0 unless $f =~ m/^\Q$base\E\.$orig_f_tail_re$/;
+    return 1;
+}
+
 sub server_branch ($) { return "$branchprefix/$_[0]"; }
 sub server_ref ($) { return "refs/".server_branch($_[0]); }
 
@@ -554,6 +593,80 @@ sub gdr_ffq_prev_branchinfo ($) {
     return ('branch', undef, $symref, $ffq_prev, $gdrlast);
 }
 
+sub parsecontrolfh ($$;$) {
+    my ($fh, $desc, $allowsigned) = @_;
+    our $dpkgcontrolhash_noissigned;
+    my $c;
+    for (;;) {
+       my %opts = ('name' => $desc);
+       $opts{allow_pgp}= $allowsigned || !$dpkgcontrolhash_noissigned;
+       $c = Dpkg::Control::Hash->new(%opts);
+       $c->parse($fh,$desc) or die "parsing of $desc failed";
+       last if $allowsigned;
+       last if $dpkgcontrolhash_noissigned;
+       my $issigned= $c->get_option('is_pgp_signed');
+       if (!defined $issigned) {
+           $dpkgcontrolhash_noissigned= 1;
+           seek $fh, 0,0 or die "seek $desc: $!";
+       } elsif ($issigned) {
+           fail "control file $desc is (already) PGP-signed. ".
+               " Note that dgit push needs to modify the .dsc and then".
+               " do the signature itself";
+       } else {
+           last;
+       }
+    }
+    return $c;
+}
+
+sub parsecontrol {
+    my ($file, $desc, $allowsigned) = @_;
+    my $fh = new IO::Handle;
+    open $fh, '<', $file or die "$file: $!";
+    my $c = parsecontrolfh($fh,$desc,$allowsigned);
+    $fh->error and die $!;
+    close $fh;
+    return $c;
+}
+
+sub parsechangelog {
+    my $c = Dpkg::Control::Hash->new(name => 'parsed changelog');
+    my $p = new IO::Handle;
+    my @cmd = (qw(dpkg-parsechangelog), @_);
+    open $p, '-|', @cmd or die $!;
+    $c->parse($p);
+    $?=0; $!=0; close $p or failedcmd @cmd;
+    return $c;
+}
+
+sub getfield ($$) {
+    my ($dctrl,$field) = @_;
+    my $v = $dctrl->{$field};
+    return $v if defined $v;
+    fail "missing field $field in ".$dctrl->get_option('name');
+}
+
+sub parsechangelog_loop ($$$) {
+    my ($clogcmd, $descbase, $fn) = @_;
+    # @$clogcmd is qw(dpkg-parsechangelog ...some...options...)
+    # calls $fn->($thisstanza, $desc);
+    debugcmd "|",@$clogcmd;
+    open CLOGS, "-|", @$clogcmd or die $!;
+    for (;;) {
+       my $stanzatext = do { local $/=""; <CLOGS>; };
+       printdebug "clogp stanza ".Dumper($stanzatext) if $debuglevel>1;
+       last if !defined $stanzatext;
+
+       my $desc = "$descbase, entry no.$.";
+       open my $stanzafh, "<", \$stanzatext or die;
+       my $thisstanza = parsecontrolfh $stanzafh, $desc, 1;
+
+       $fn->($thisstanza, $desc);
+    }
+    die $! if CLOGS->error;
+    close CLOGS or $?==SIGPIPE or failedcmd @$clogcmd;
+}      
+
 # ========== playground handling ==========
 
 # terminology: