#!/usr/bin/perl

use 5.006;
use strict;
use warnings;

use File::Path;
use Getopt::Long qw/:config bundling require_order pass_through/;
use Config::General;

my $rcfile;
foreach ("$ENV{HOME}/.archdeb.conf", "/etc/archdeb.conf")
  {
    if (-f $_)
      {
        $rcfile = $_;
        last;
      }
  }

my @rcdata = defined $rcfile ? (-ConfigFile => $rcfile) : (-String => '');

my $config_obj = new Config::General (@rcdata,
                                      -AllowMultiOptions => "no",
                                      -LowerCaseNames => "yes",
                                      -UseApacheInclude => "yes",
                                      -IncludeRelative => "yes",
                                      -MergeDuplicateBlocks => "yes",
                                      -AutoTrue => "yes",
                                      -InterPolateVars => "yes",
                                     );

my %config = $config_obj->getall();

my $tla = $config{commands}{tla} || "tla";

sub usage
  {
    print STDERR <<'END';
Usage: arch-recordpackage [OPTIONS]... [--upstream | --both] package [version]
 --upstream
             Create an upstream config, not a debian one
 --both
             Create both an upstream config and a debian one

Where OPTIONS can be:
 --no-act, -n
             Show the configuration, but don't save it
 --no-revision
             Don't include the revision components in the configuration
 --no-version
             Don't include the version components in the configuration
 --native
             Assume the package is Debian-native
 --output=file, -o file
             Save the configuration to the named file, instead of
             the default location for this package/version
 --config-name=name, -c name
             Set the filename part of the output file, but put it in
             the default directory
 --help
             Show this text

Records a configuration for the current state of the give package and
upstream version (a Debian version suffix will be stripped if present).

If $package/$package-$version does not exist or no version is
specified, but $package/$package does and is Debian-native, that
project tree is used.

If no version is specified, and the package is not Debian-native, then
--no-revision is assumed.

END
    exit 0;
  }

sub changelog_version
  {
    my $tree = shift;
    my $parsechangelog = `dpkg-parsechangelog -l$tree/debian/changelog`;
    unless ($parsechangelog =~ /^Version: (.*)$/m)
      {
        die "Failed to get version from changelog";
      }
    return $1;
  }

my ($debian, $both, $upstream, $no_act, $no_revision, $no_version, $output, $config, $native);
GetOptions('arch=s' => \$tla,
           'upstream' => \$upstream,
           'both' => \$both,
           'no-act|n' => \$no_act,
           'no-revision' => \$no_revision,
           'no-version' => \$no_version,
           'output|o=s' => \$output,
           'config-name|c=s' => \$config,
           'native' => \$native,
           'help' => \&usage,
          );
usage if $both and $upstream;
usage unless scalar @ARGV >= 1;
$debian = 0 if defined $upstream;

if (my $tree_root = `$tla tree-root --silent`)
  {
    chomp $tree_root;
    chdir $tree_root or die "Couldn't chdir to $tree_root";
  }

if (! -d "configs")
  {
    print "No configs directory found - is this really the right tree?\n";
    exit 1;
  }

my $package = shift;
my $version = shift;
my $upstreamversion = $version;
$upstreamversion =~ s/^[^:]+:// if defined $upstreamversion;
$upstreamversion =~ s/-[^-]+$// if defined $upstreamversion;

# If we're in Debian-native mode, or we don't have a version, or the
# tree for our upstream version isn't where we expect...
if ($native or not $version or not -d "$package/$package-$upstreamversion")
  {
    # ...and we have an unversioned tree...
    if (-d "$package/$package")
      {
        my $changelog_version = changelog_version("$package/$package");
        # ...and it's a Debian-native version, or we're forced into native mode
        if ($native or $changelog_version !~ /-/)
          {
            # Then we're native, and should use the version from the changelog
            $native = 1;
            die "Debian version from changelog ($changelog_version) does not match $version"
              if defined $version and $version ne $changelog_version;
            $version = $changelog_version;
          }
      }
  }

$no_revision = 1 unless defined $version;
$no_revision = 1 if $no_version and not $native;

$debian = 1 unless defined $debian;
$debian = 1 if $both;
$upstream = 1 if $both;

die "Can't specify an output file while recording both configs" if $debian and $upstream and $output;

sub find_nested
  {
    my $tree = shift;
    my @nested = `$tla inventory -t --nested '$tree'`;
    chomp $_ foreach @nested;
    unshift @nested, $tree;
    return @nested;
  }

sub find_version
  {
    my $tree = shift;
    my $version = `cd $tree && $tla tree-version`;
    chomp $version;

    if ($no_version)
      {
        $version =~ s/--[^-]+$//
          or die "Failed to remove version component from $version";
      }

    return $version;
  }

sub find_revision
  {
    my $tree = shift;
    my @logs = `$tla logs -d '$tree'`;
    die "No patch logs found for current tree-version in $tree" unless scalar @logs;
    my $revision = $logs[-1];
    chomp $revision;
    return $revision;
  }

if ($upstream)
  {
    die "Can't record an upstream config for a Debian-native package" if $native;

    my $tree = $version ? "$package/upstream/$package-$version"
                        : "$package/upstream/$package";

    die "Upstream source tree $tree not found" unless -d $tree;

    print "Upstream config:\n" if $both;

    my @config;
    foreach my $nested (find_nested($tree))
      {
        my $tree_version = find_version($nested);
        my $revision = $no_revision ? "" : ("--" . find_revision($nested));
        my $line = "./$nested $tree_version$revision\n";
        print $line;
        push @config, $line;
      }

    unless ($no_act)
      {
        mkpath("configs/$package/upstream");
        my $config = $output
          || ($config  ? "configs/$package/upstream/$config" : undef)
          || ($version ? "configs/$package/upstream/$package-$version"
                       : "configs/$package/upstream/$package");
        open CONFIG, ">", $config or die "Couldn't open $config for writing: $!";
        print CONFIG $_ foreach @config;
        close CONFIG;
      }
  }

print "\n" if $both;

if ($debian)
  {
    my $tree = "$package/$package";
    if (defined $upstreamversion)
      {
        if ($native)
          {
            # Fall back to the non-native style if appropriate
            $tree = "$package/$package-$upstreamversion" unless -d $tree;
          }
        else
          {
            # Parse the changelog to get the Debian version suffix
            $tree = "$package/$package-$upstreamversion";
            $version = changelog_version($tree);
            if ($version ne $upstreamversion and $version !~ /^(\d+:)?\Q$upstreamversion\E-/)
              {
                die "Debian version from changelog ($version) does not match $upstreamversion";
              }
          }
      }

    die "Debian source tree $tree not found" unless -d $tree;

    print "Debian config:\n" if $both;

    my @config;
    foreach my $nested (find_nested($tree))
      {
        my $tree_version = find_version($nested);
        my $revision = $no_revision ? "" : ("--" . find_revision($nested));
        my $line = "./$nested $tree_version$revision\n";
        print $line;
        push @config, $line;
      }

    unless ($no_act)
      {
        mkpath("configs/$package/debian");
        my $config = $output
          || ($config  ? "configs/$package/debian/$config" : undef)
          || ($version ? "configs/$package/debian/$package-$version"
                       : "configs/$package/debian/$package");
        open CONFIG, ">", $config or die "Couldn't open $config for writing: $!";
        print CONFIG $_ foreach @config;
        close CONFIG;
      }
  }

exit 0;