# -*- perl -*-

use strict;
use warnings;

package Topbloke;

BEGIN {
    use Exporter   ();
    our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);

    $VERSION     = 1.00;
    @ISA         = qw(Exporter);
    @EXPORT      = qw(parse_branch_spec current_tb_branch run_git_1line);
    %EXPORT_TAGS = ( );
    @EXPORT_OK   = qw();
}


sub run_git_1line {
    open GIT, "-|", 'git', @_ or die $!;
    my $l = <GIT>;
    $?=0;
    close GIT or die "git @_ failed ($?)\n";
    chomp $l or die "@_ ?";
    return $l;
}

sub git_dir () {
    our $git_dir;
    if (!defined $git_dir) {
	$git_dir = run_git_1line(qw(rev-parse --git-dir));
    }
    return $git_dir;
}

sub current_tb_branch () {
    open R, git_dir().'/HEAD' or die "open HEAD $!";
    my $ref = <R>;  defined $ref or die $!;
    close R;
    chomp $ref or die;
    if ($ref !~ s#^ref: ##) {
	return {
	    Kind => 'detached',
	    Ref => $ref,
	};
    }
    if ($ref =~ m#^refs/topbloke-(tip|base)s/([^/\@]*)\@([^/\@]*)/([^/]*)/#) {
	return {
	    Kind => $1,
	    Email => $2,
	    Domain => $3,
	    Date => $4,
	    Nick => $', #',
	    Ref => $ref,
	    DepSpec => "$2\@$3/$4/$'",
	};
    } elsif ($ref =~ m#^refs/heads/#) {
	return {
	    Kind => 'foreign',
	    Ref => $ref,
	    DepSpec => "/$ref",
	};
    } else {
	return {
	    Kind => 'weird',
	    Ref => $ref,
	};
    }
}

sub parse_branch_spec ($) {
    my ($orig) = @_;
    local $_ = $orig;
    my $spec = { }; # Email Domain DatePrefix DateNear Nick
    my $set = sub {
	my ($key,$val,$whats) = @_;
	die "multiple $whats in branch spec\n" if exists $spec->{$key};
	$spec->{$key} = $val;
    };
    my $rel_levels;
    for (;;) {
	if (s#([^/\@]*)\@([^/\@]*)/##) {
	    $set->('Email', $1, "email local parts") if length $1;
	    $set->('Domain', $2, "email domains") if length $1;
	} elsif (s#([^/]*\~[^/]*)/##) {
	    my $dspec = $1;
	    $dspec =~ y/~/ /;
	    open DATE, "-|", 'date','+%s','-d',$dspec or die $!;
	    my $l = <DATE>;
	    close DATE or die "date parsing failed\n";
	    chomp $l or die;
	    $set->('DateNear', $l, 'nearby dates');
	} elsif (s#^([0-9][^/]*)/##) {
	    my $dspec = $1;
	    $dspec =~ 
      m/^\d{4}(?:-\d\d(?:-\d\d(?:T(?:\d\d(?:\d\d(?:\d\d(?:Z)?)?)?)?)?)?)?$/
		or die "bad date prefix \`$dspec'\n";
	    $set->('DatePrefix', $dspec, 'date prefixes');
	} elsif (s#^\./##) {
	    $rel_levels ||= 1;
	} elsif (s#^\.\./##) {
	    $rel_levels ||= 1;
	    $rel_levels++;
	} else {
	    last;
	}
    }
    if (defined $rel_levels) {
	my $branch = current_tb_branch();
	if (!defined $branch->{Nick}) {
	    die "relative branch spec \`$orig',".
		" but current branch not a topbloke branch\n";
	}
	my ($ceaddr,$cdate,@l) = split /\//, $branch->{Nick};
	@l >= $rel_levels or
	    die "relative branch spec \`$orig' has too many ../s\n";
	$_ = (join '/', @l[0..$#l-$rel_levels]).'/'.$_;
    }
    $spec->{Nick} = $_;
    return $spec;
}

1;
