# -*- 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 server_branch server_ref
                      stat_exists git_for_each_ref
                      git_for_each_tag_referring
                      $package_re $component_re $deliberately_re
                      $branchprefix
                      initdebug enabledebug enabledebuglevel
                      printdebug debugcmd
                      $debugprefix *debuglevel *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 $deliberately_re = "(?:TEST-)?$package_re";
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' and to spot
# dynamic loader, runtime, etc., failures, which report 127 or 255
sub NOFFCHECK () { return 0x2; }
sub FRESHREPO () { return 0x4; }

our $debugprefix;
our $debuglevel = 0;

sub initdebug ($) { 
    ($debugprefix) = @_;
    open DEBUG, ">/dev/null" or die $!;
}

sub enabledebug () {
    open DEBUG, ">&STDERR" or die $!;
    DEBUG->autoflush(1);
    $debuglevel ||= 1;
}
    
sub enabledebuglevel ($) {
    my ($newlevel) = @_; # may be undef (eg from env var)
    die if $debuglevel;
    $newlevel //= 0;
    $newlevel += 0;
    return unless $newlevel;
    $debuglevel = $newlevel;
    enabledebug();
}
    
sub printdebug {
    print DEBUG $debugprefix, @_ or die $! if $debuglevel>0;
}

sub shellquote {
    my @out;
    local $_;
    foreach my $a (@_) {
	$_ = $a;
	if (!length || 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 $debuglevel>0;
}

sub debiantag ($) { 
    my ($v) = @_;
    $v =~ y/~:/_%/;
    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 @cmd = (qw(git for-each-ref), $pattern);
    open GFER, "-|", @cmd or die $!;
    debugcmd "|", @cmd;
    while (<GFER>) {
	chomp or die "$_ ?";
	printdebug "|> ", $_, "\n";
	m#^(\w+)\s+(\w+)\s+(refs/\w+/(\S+))$# or die "$_ ?";
	$func->($1,$2,$3,$4);
    }
    $!=0; $?=0; close GFER or die "$pattern $? $!";
}

sub git_for_each_tag_referring ($$) {
    my ($objreferring, $func) = @_;
    # calls $func->($objid,$fullrefname,$tagname);
    printdebug "git_for_each_tag_referring ",
        ($objreferring // 'UNDEF'),"\n";
    git_for_each_ref('refs/tags', sub {
	my ($objid,$objtype,$fullrefname,$tagname) = @_;
	return unless $objtype eq 'tag';
	return if defined $objreferring and $objid ne $objreferring;
	$func->($objid,$fullrefname,$tagname);
    });
}

1;
