Quilt output: Honour and strip Gbp-pq headers

Signed-off-by: Ian Jackson <ijackson@chiark.greenend.org.uk>

1 files changed, 50 insertions, 6 deletions

diff --git a/dgit b/dgit
index 8d13d15..50011cc 100755
--- a/dgit
+++ b/dgit
@@ -3990,12 +3990,56 @@ sub quiltify ($$$$) {
 	$strip_nls->();
 
 	my $title = $1;
-	my $patchname = $title;
-	$patchname =~ s/[.:]$//;
-	$patchname =~ y/ A-Z/-a-z/;
-	$patchname =~ y/-a-z0-9_.+=~//cd;
-	$patchname =~ s/^\W/x-$&/;
-	$patchname = substr($patchname,0,40);
+	my $patchname;
+	my $patchdir;
+
+	my $gbp_check_suitable = sub {
+	    $_ = shift;
+	    my ($what) = @_;
+
+	    eval {
+		die "contains unexpected slashes\n" if m{//} || m{/$};
+		die "contains leading punctuation\n" if m{^\W} || m{/\W};
+		die "contains bad character(s)\n" if m{[^-a-z0-9_.+=~/]}i;
+		die "too long" if length > 200;
+	    };
+	    return $_ unless $@;
+	    print STDERR "quiltifying commit $cc:".
+		" ignoring/dropping Gbp-Pq $what: $@";
+	    return undef;
+	};
+
+	if ($msg =~ s/^ (?: gbp(?:-pq)? : \s* name \s+ |
+			   gbp-pq-name: \s* )
+		       (\S+) \s* \n //ixm) {
+	    $patchname = $gbp_check_suitable->($1, 'Name');
+	}
+	if ($msg =~ s/^ (?: gbp(?:-pq)? : \s* topic \s+ |
+			   gbp-pq-topic: \s* )
+		       (\S+) \s* \n //ixm) {
+	    $patchdir = $gbp_check_suitable->($1, 'Topic');
+	}
+
+	$strip_nls->();
+
+	if (!defined $patchname) {
+	    $patchname = $title;
+	    $patchname =~ s/[.:]$//;
+	    $patchname =~ y/ A-Z/-a-z/;
+	    $patchname =~ y/-a-z0-9_.+=~//cd;
+	    $patchname =~ s/^\W/x-$&/;
+	    $patchname = substr($patchname,0,40);
+	}
+	if (!defined $patchdir) {
+	    $patchdir = '';
+	}
+	if (length $patchdir) {
+	    $patchname = "$patchdir/$patchname";
+	}
+	if ($patchname =~ m{^(.*)/}) {
+	    mkpath "debian/patches/$1";
+	}
+
 	my $index;
 	for ($index='';
 	     stat "debian/patches/$patchname$index";