#!/usr/bin/perl

use 5.006;
use strict;
use warnings;

use File::Spec;
use File::Path;
use File::stat;
use Getopt::Long qw/:config bundling require_order pass_through/;

sub usage
  {
    print STDERR <<END;
Usage: arch-import [OPTIONS]... tarball [package] [version]

Where OPTIONS can be:
 --no-act, -n
             Show the configurations, but don't save them
 --help
             Show this text

Imports a new upstream tarball, renaming it if appropriate (or copying
if it is located in a different directory). Currently this only works
for tarballs which contain arch metadata. Debian and upstream
configurations and project trees are created.

If no package or version is specified, then an attempt is made to
extract them from the name of the tarball.
END
    exit 0;
  }

my ($no_act);
GetOptions('no-act|n' => \$no_act,
           'help' => \&usage,
          );

usage unless scalar @ARGV >= 1;
usage if scalar @ARGV > 3;

my $tarball = shift;

unless (-e $tarball)
  {
    print "$tarball does not appear to exist\n";
    exit 1;
  }

unless ($tarball =~ /\.tar\.gz$/)
  {
    print "$tarball does not appear to be a tarball (not ending in .tar.gz)\n";
    exit 1;
  }

my $tree_root = `tla tree-root` or exit 1;
chomp $tree_root;

my ($package, $version);

if (scalar @ARGV == 2)
  {
    $package = shift;
    $version = shift;
  }
elsif (scalar @ARGV == 1)
  {
    my $arg = shift;
    if ($arg =~ /^\d+\.[0-9A-Za-z:.+-]+$/)
      {
        # Looks like a version
        $version = $arg;
      }
    elsif ($arg =~ /^[a-z0-9][a-z0-9.+-]+$/)
      {
        # Valid package name
        $package = $arg;
      }
    else
      {
        print "Can't understand $arg: package name or version?\n";
        exit 1;
      }
  }

sub analyse_tarball_name
  {
    my $tarball = shift;
    if ($tarball =~ /^([a-z0-9][a-z0-9.+-]+)_([0-9A-Za-z:.+-]+)\.orig\.tar\.gz$/)
      {
        # We have a debian .orig.tar.gz
        return (lc $1, $2);
      }
    elsif ($tarball =~ /^([a-z0-9]+)-(\d+\.[0-9A-Za-z.+-]+)\.tar.gz$/)
      {
        # Looks like a traditional .tar.gz
        return (lc $1, $2);
      }
    else
      {
        return;
      }
  }

my (undef, $tarball_dir, $tarball_name) = File::Spec->splitpath($tarball);

my ($tarball_package, $tarball_version) = analyse_tarball_name($tarball_name);

$package ||= $tarball_package;
$version ||= $tarball_version;

unless (defined $package)
  {
    print "Can't figure out the package name\n";
    exit 1;
  }
unless (defined $version)
  {
    print "Can't figure out the version\n";
    exit 1;
  }

if ($package ne $tarball_package)
  {
    print "Package is $package, but tarball is named for $tarball_package; aborting\n";
    exit 1;
  }
if ($version ne $tarball_version)
  {
    print "Version is $version, but tarball is named for $tarball_version; aborting\n";
    exit 1;
  }

my $package_dir = File::Spec->catdir($tree_root, $package);

print "Working on $package $version\n";
print "Target directory is $package_dir\n";

unless (-d $package_dir)
  {
    print "Target directory $package_dir does not exist\n";
    exit 1;
  }

my $debian_project_tree = File::Spec->catdir($package_dir, "${package}-${version}");
my $upstream_project_tree = File::Spec->catdir($package_dir, "upstream", "${package}-${version}");

if (-d $debian_project_tree)
  {
    print "$debian_project_tree already exists; aborting\n";
    exit 1;
  }

if (-d $upstream_project_tree)
  {
    print "$upstream_project_tree already exists; aborting\n";
    exit 1;
  }

# Get the tarball where we want it
my $target_tarball_name = "${package}_${version}.orig.tar.gz";
my $target_tarball_path = File::Spec->catfile($package_dir, $target_tarball_name);

my $tarball_dir_stat = stat $tarball_dir;
my $package_dir_stat = stat $package_dir;
if ($tarball_dir_stat->dev != $package_dir_stat->dev or
    $tarball_dir_stat->ino != $package_dir_stat->ino)
  {
    # They're in different directories
    copy $tarball, $target_tarball_path or die "Failed to copy $tarball to $target_tarball_path";
  }
else
  {
    # Same directory, so rename it
    rename $tarball, $target_tarball_path or die "Failed to rename $tarball to $target_tarball_path";
  }

chdir $package_dir;
$tarball = $target_tarball_name;

print "Tarball is now $tarball\n";

sub unpack_tarball
  {
    my $tarball = shift;
    my $target = shift;

    # Borrow a trick from dpkg-source: unpack into a temporary
    # directory. If there is precisely one thing in the directory when
    # we're done, and that is a directory, rename it to our target and
    # remove the temporary directory. Otherwise rename the temporary
    # directory to our target.
    #
    # By doing this, we eliminate any reliance on the layout of the
    # contents of the tarball - if it has a top-level directory, as is
    # normal, we discard it and use our own, so the name doesn't matter.

    my $tmp_dir = $target . ".tmp";
    rmtree($tmp_dir);
    mkpath($tmp_dir) or die "mkpath failed: $!";
    system("tar",
           "--directory", $tmp_dir,
           "--gzip", "--extract",
           "--file", $tarball) == 0
      or die "tar failed: $!";

    opendir DIR, $tmp_dir or die "opendir $tmp_dir failed: $!";
    my @contents = grep {$_ ne '.' and $_ ne '..'} readdir DIR;
    closedir DIR;
    if (scalar @contents == 1 and -d File::Spec->catdir($tmp_dir, $contents[0]))
      {
        # There is precisely one real member and it is a directory
        my $member = File::Spec->catdir($tmp_dir, $contents[0]);
        rename $member, $target or die "Failed to rename $member to $target";
        rmtree $tmp_dir;
      }
    else
      {
        rename $tmp_dir, $target or die "Failed to rename $tmp_dir to $target";
      }
  }

print "Creating Debian project tree...\n";
unpack_tarball $tarball, $debian_project_tree;
print "WARNING: The Debian project tree is a clone of the upstream one.\n";
print "         This feature is not finished yet.\n";

print "Creating upstream project tree...\n";
unpack_tarball $tarball, $upstream_project_tree;
print "Done\n";
