#!/usr/bin/perl
#
# install debian package to local archive tree.
#     written by Tastuki Sugiura <sugi@nemui.org>
#
# License: GPL
#

use strict;
use warnings;
use File::Copy;
use IO::File;
use Getopt::Long;
Getopt::Long::Configure qw( no_ignore_case );

### config
my $archivedir = "/var/local/debian-arege";
my @all_arch   = qw(i386 amd64 mipsel arm);

### init
my $VERSION = 0.3;
$0 =~ m|([^/]+)$|;
my $MYNAME = $1;
my $ERR    = 0;

### main
my %opt;
my $getopt_result = GetOptions(\%opt,
			   qw(help|h version|V silent|s delete|d setenv|e=s) );
my $changes = shift;

if ( !$getopt_result || $opt{help} || !defined($changes) ) {
    &usage;
    exit(1) if ( !$getopt_result || !defined($changes) ) ;
    exit(0);
}

if ( $opt{version} ) {
    print "$MYNAME version $VERSION\n";
    exit;
}

my $detail  = &parse_changes($changes);
unless ( $detail ) {
    die "changes file '$changes' seems broken. abort!\n";
}

my $sourcedir = shift || ($changes =~ m|^(.*)/[^/]+$| ? $1 : '.');
my $targetdir = join "/", $archivedir, "dists", $detail->{dist}, $detail->{sname};
&printstat("Target: $targetdir\n");
&printstat("Source: $sourcedir\n");

unless (-e $targetdir ) {
    &printstat("mkdir $targetdir: ");
    unless ( mkdir $targetdir ) {
	die "Can't mkdir '$targetdir': $!\n";
    }
    &printstat("done\n");
}
foreach my $dir ( map { /^source$/
			    ? "${targetdir}/${_}"
			    : "${targetdir}/binary-${_}" }
				@{$detail->{arch}}, @all_arch ) {
    unless ( -d $dir ) {
	&printstat("mkdir $dir: ");
	unless ( mkdir $dir ) {
	    die "Can't mkdir '$dir': $!\n";
	}
	&printstat("done\n");
    }
}

foreach my $file ( @{$detail->{files}} ) {
    my $archdir;
    my $copy_ok = 1;
    if ( $file =~ /(tar\.gz|dsc|diff\.gz)$/ ) {
	$archdir = "source";
    }
    elsif ( $file =~ /_([^_]+)\.u?deb$/ ) {
	$archdir = "binary-$1";
    }

    &printstat("copy $sourcedir/$file: ");
    unless ( copy("$sourcedir/$file", "$targetdir/$archdir/$file") ){
	warn "Can't copy $sourcedir/$file -> $targetdir/$archdir/$file: $!\n";
	$ERR = 1;
	$copy_ok = 0;
	next;
    }
    &printstat("done\n");
    unlink("$sourcedir/$file") if $opt{delete} && $copy_ok;

    if ( $archdir eq "binary-all" ) {
	my @arch = grep { ! /^(all|source)$/ } @{$detail->{arch}}, @all_arch;
	my %arch; @arch{@arch} = ( ); @arch = keys %arch; undef %arch; # uniq!!
	&printstat("symlink for each: [");
	foreach ( @arch ) {
	    &printstat(" $_");
	    if ( -l "$targetdir/binary-${_}/$file" ) {
	    	if ( readlink("$targetdir/binary-${_}/$file" ) eq
		     "../binary-all/$file") {
		     &printstat("(skip)");
		     next;
		}
		unlink("$targetdir/binary-${_}/$file");
	    }
	    unless ( symlink("../binary-all/$file",
			     "$targetdir/binary-${_}/$file") ) {
		&printstat("(FAILURE!)");
		$ERR = 1;
	    }
	}
	&printstat(" ] done\n");
    }
}

unlink($changes) if ($opt{delete} && $changes ne "-");

exit($ERR);

### sub
sub parse_changes {
    my $changes = shift;
    my %detail;
    my $fh = IO::File->new("<$changes");
    unless ( $fh ) {
	warn "Can't open changes file '$changes': $!\n";
	return undef;
    }
    while ( <$fh> ) { # read header
	/^Source: (.+)/  and   $detail{sname}   = $1 and next;
	/^Version: (.+)/ and   $detail{version} = $1 and next;
	/^Binary: (.+)/
	    and $detail{bname} = [ split /\s+/, $1 ] and next;
	/^Architecture: (.+)/
	    and $detail{arch}  = [ split /\s+/, $1 ] and next;
	/^Distribution: (.+)/ and $detail{dist} = $1 and next;
	/^Maintainer: (.+)/  and $detail{maint} = $1 and next;
	/^Changed-by: (.+)/ and $detail{changed}= $1 and next;
	/^Files:/ and last;
    }
    $detail{files} = [ ];
    while ( <$fh> ) { # read files
    	/^$/ and last; # end of file section
	# format: " md5sum size section priority file_name"
	/^\s+([\d\w]+)\s+(\d+)\s+([\w\d\/\-]+)\s+(\w+)\s+(.+)/
	    and push @{$detail{files}}, $5;
    }

    undef $fh;
    if ( exists $detail{version} ) {
	return { %detail };
    }
    else { undef }
    # return value sample:
    #   {
    #     'version' => '0.9.4-1'
    #     'changed' => 'Tatsuki Sugiura <sugi@nemui.org>',
    #     'maint' => 'Tatsuki Sugiura <sugi@nemui.org>',
    #     'sname' => 'sng',
    #     'bname' => [
    #                 'sng',
    #                ],
    #     'dist'  => 'unstable',
    #     'files' => [
    #                  'sng_0.9.4-1.dsc',
    #                  'sng_0.9.4.orig.tar.gz',
    #                  'sng_0.9.4-1.diff.gz',
    #                  'sng_0.9.4-1_i386.deb'
    #                ],
    #     'arch' => [
    #                 'source',
    #                 'i386'
    #               ],
    #   };
}

sub printstat {
    print @_ unless $opt{silent};
}

sub usage {
    print <<EOU;
Usage:
  $MYNAME <option> changes_file <source_dir>

Arguments:
  changes_file           debian .changes file.
  source_dir             copy .deb, .dsc, .diff.gz... file from this directory.
                         (default: same as .changes)
Options:
  -h,  --help            show this message
  -V,  --version         show version
  -s,  --silent          silent mode
  -d,  --delete          delete each file after copy
EOU
}