X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=blobdiff_plain;f=Debian%2FDgit.pm;h=2b9479db58d9b4e5f07c0301033657d449475c75;hb=835d5026fd4c39a5012d1a0d64c85a2481a2c686;hp=3fe0309304feb8b8d8dd8d47b311b4c4fd0318ec;hpb=850c5e51043c2eb3a9804877314edefb6156e816;p=dgit.git

diff --git a/Debian/Dgit.pm b/Debian/Dgit.pm
index 3fe03093..2b9479db 100644
--- a/Debian/Dgit.pm
+++ b/Debian/Dgit.pm
@@ -1,25 +1,41 @@
-#
+# -*- perl -*-
 
 package Debian::Dgit;
 
 use strict;
 use warnings;
 
+use POSIX;
+use IO::Handle;
+
 BEGIN {
     use Exporter   ();
     our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
 
     $VERSION     = 1.00;
     @ISA         = qw(Exporter);
-    @EXPORT      = qw(debiantag
-                      $package_re);
-    %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
-    @EXPORT_OK   = qw();
+    @EXPORT      = qw(debiantag server_branch server_ref
+                      stat_exists git_for_each_ref
+                      $package_re $component_re $branchprefix
+                      initdebug enabledebug printdebug debugcmd
+                      $debugprefix $debug
+                      shellquote printcmd);
+    %EXPORT_TAGS = ( policyflags => [qw(NOFFCHECK FRESHREPO)] );
+    @EXPORT_OK   = @{ $EXPORT_TAGS{policyflags} };
 }
 
 our @EXPORT_OK;
 
 our $package_re = '[0-9a-z][-+.0-9a-z]*';
+our $component_re = '[0-9a-zA-Z][-+.0-9a-zA-Z]*';
+our $branchprefix = 'dgit';
+
+# policy hook exit status bits
+# see dgit-repos-server head comment for documentation
+# 1 is reserved in case something fails with `exit 1'
+sub NOFFCHECK () { return 0x2; }
+sub FRESHREPO () { return 0x4; }
+# 0x80 is reserved
 
 sub debiantag ($) { 
     my ($v) = @_;
@@ -27,4 +43,84 @@ sub debiantag ($) {
     return "debian/$v";
 }
 
+sub server_branch ($) { return "$branchprefix/$_[0]"; }
+sub server_ref ($) { return "refs/".server_branch($_[0]); }
+
+sub stat_exists ($) {
+    my ($f) = @_;
+    return 1 if stat $f;
+    return 0 if $!==&ENOENT;
+    die "stat $f: $!";
+}
+
+sub git_for_each_ref ($$) {
+    my ($pattern,$func) = @_;
+    # calls $func->($objid,$objtype,$fullrefname,$reftail);
+    # $reftail is RHS of ref after refs/\w+/
+    # breaks if $pattern matches any ref `refs/blah' where blah has no `/'
+    my $fh = new IO::File "-|", qw(git for-each-ref), $pattern or die $!;
+    while (<$fh>) {
+	m#^(\w+)\s+(\w+)\s+(refs/\w+/(\S+))\s# or die "$_ ?";
+	$func->($1,$2,$3,$4);
+    }
+    $!=0; $?=0; close $fh or die "$pattern $? $!";
+}
+
+sub git_for_each_tag_referring ($$) {
+    my ($objreferring, $func) = @_;
+    # calls $func->($objid,$fullrefname,$tagname);
+    git_for_each_ref('refs/tags', sub {
+	my ($objid,$objtype,$fullrefname,$tagname) = @_;
+	next unless $objtype eq 'tag';
+	next if defined $objreferring and $objid ne $objreferring;
+	$func->($objid,$fullrefname,$tagname);
+    });
+}
+
+our $debugprefix;
+our $debug = 0;
+
+sub initdebug ($) { 
+    ($debugprefix) = @_;
+    open ::DEBUG, ">/dev/null" or die $!;
+}
+
+sub enabledebug () {
+    open ::DEBUG, ">&STDERR" or die $!;
+    ::DEBUG->autoflush(1);
+    $debug ||= 1;
+}
+    
+sub printdebug {
+    print ::DEBUG $debugprefix, @_ or die $!;
+}
+
+sub shellquote {
+    my @out;
+    local $_;
+    foreach my $a (@_) {
+	$_ = $a;
+	if (m{[^-=_./0-9a-z]}i) {
+	    s{['\\]}{'\\$&'}g;
+	    push @out, "'$_'";
+	} else {
+	    push @out, $_;
+	}
+    }
+    return join ' ', @out;
+}
+
+sub printcmd {
+    my $fh = shift @_;
+    my $intro = shift @_;
+    print $fh $intro," " or die $!;
+    print $fh shellquote @_ or die $!;
+    print $fh "\n" or die $!;
+}
+
+sub debugcmd {
+    my $extraprefix = shift @_;
+    printcmd(\*::DEBUG,$debugprefix.$extraprefix,@_) if $debug>0;
+}
+
 1;