#!/usr/bin/perl

# Copyright (C) 2009,2010  Xyne
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# (version 2) as published by the Free Software Foundation.
#
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.

use warnings;
use strict;

# METADATA
# Version: 3.4


# Globals

# Account name and password variables.
# These are only set when retrieved from a file.
my ($NAME, $PSWD);

# The packages to upload.
my @PKGS = ();

# URLs
my $aur_index='https://aur.archlinux.org/index.php';
my $aur_submit='https://aur.archlinux.org/pkgsubmit.php';
my $aur_edit='https://aur.archlinux.org/pkgedit.php';
my $aur_rpc='https://aur.archlinux.org/rpc.php';


# The cookie jar.
my $cookiejar;

# Whether to keep the cookie jar (1), throw it away (0), or prompt (-1)
my $keep_cookiejar = -1;

# Auto mode.
my $auto = 0;

if (exists($ENV{XDG_CONFIG_HOME}))
{
  # "standard" location
  $cookiejar=$ENV{XDG_CONFIG_HOME}.'/aurploader';
}
else
{
  # home directory otherwise
  $cookiejar=$ENV{HOME}.'/.aurploader';
}

# Variables for the package categories.
my %categories = ();
my @categories = ();


while(@ARGV)
{
  my $arg = shift;

  if ($arg =~ m/^-?-h/)
  {
    print <<"HELP";
  USAGE
    aurploader [options] [files]
        Upload passed files to the AUR.

  OPTIONS
    -h, --help
        Display this help message.

    -a, --auto
        Skip the category prompt unless a category could not be detected.

    -k, --keep-cookiejar
        Keep the cookie jar without prompting.

    -l, --login <path>
        Extract the user name and password from a file at <path>.
        The first line should contain the name and the second the password.

    -r, --remove-cookiejar
        Remove the cookie jar without prompting.

HELP
    exit;
  }
  elsif ($arg =~ m/^-?-k/)
  {
    $keep_cookiejar = 1;
  }
  elsif ($arg =~ m/^-?-a/)
  {
    $auto = 1;
  }
  elsif ($arg =~ m/^-?-l/)
  {
    my $fpath = shift(@ARGV);
    ($NAME,$PSWD) = &get_login_data($fpath);
  }
  elsif ($arg =~ m/^-?-r/)
  {
    $keep_cookiejar = 0;
  }
  else
  {
    push @PKGS, $arg;
  }
}

while (1)
{
  &login if (not -e $cookiejar);

  my $page = `curl -k -b $cookiejar $aur_submit 2>/dev/null`;
  while($page =~ m/<option value='(\d+)'>(.*?)<\/option>/g)
  {
    if ($2 ne 'Select Category')
    {
      push @categories, $2;
      $categories{$2}=$1;
    }
  }
  @categories = sort {$categories{$a} <=> $categories{$b}} @categories;

  if (scalar @categories == 0)
  {
    print "Login appears to have failed. The site may be down or have changed";
    my $question = "Would you like to try again?";
    if (-e $cookiejar)
    {
      print ", or your cookie(s) may have expired";
      $question = "Would you like to remove the cookie jar and try again?";
    }
    print ".\n";
    if (&confirm($question))
    {
      unlink $cookiejar if -e $cookiejar;
      next;
    }
    else
    {
      exit 1;
    }
  }
  last;
}

my $longnum = length(scalar @categories)+2;
my $longcat = length((sort {length($b)<=>length($a)}@categories)[0]);

my $ID;

foreach my $pkg (@PKGS)
{
  my ($pkg_name) = ($pkg =~ m/([^\/]+)$/);
  next if not $pkg_name;
  my $category = &get_category($pkg_name);
  my $cat; # meow
  if ($category and $auto)
  {
    $cat = $category;
  }
  else
  {
    print "\nSelect category for $pkg_name\n";
    print (('-' x ($longnum+$longcat))."\n");
    for(my $i=0;$i<scalar @categories;$i++)
    {
      printf("%-${longnum}s%-${longcat}s\n","$categories{$categories[$i]})",$categories[$i]);
    }
    print (('-' x ($longnum+$longcat))."\n");
    if (defined($category))
    {
      print "detected category: ";
      while (my ($key, $value) = each(%categories) )
      {
          if ($value == $category)
          {
            print $key;
            last;
          }
      }
      print "\n";
    }
    print "enter \"x\" to skip this upload\n";
    print 'enter category';
    print " [$category]" if defined($category);
    print ': ';
    $cat = <STDIN>;
    chomp $cat;
    next if ($cat eq 'x');
    $cat = $category if $cat !~ m/\S/;
    redo if not grep {$cat eq $_} values %categories;
  }
  `curl -k -# -H "Expect:" -b $cookiejar -F "pkgsubmit=1" -F "category=${cat}" -F "pfile=\@${pkg}" $aur_submit >/dev/null`;
#  print qq/curl -# -b $cookiejar -d "change_Category=1" -d "ID=${ID}" -d "category_id=${cat}" $aur_edit >/ if defined($ID);
}


unlink $cookiejar if $keep_cookiejar == 0 or (not $auto and $keep_cookiejar == -1 and not &confirm("Keep the cookie jar?"));

sub confirm
{
  my ($question) = @_;
  my $ans;
  while (not defined($ans))
  {
    print "\n$question [y/n] ";
    my $ans = lc(<STDIN>);
    chomp $ans;
    if ($ans eq 'n')
    {
      return 0
    }
    elsif ($ans eq 'y')
    {
      return 1
    }
die "did not get anwser to question";
  }
}

sub get_category
{
  my $info = &get_info(@_);
  if ($info =~ m/"CategoryID":"(\d+)"/)
  {
    return $1;
  }
  return undef;
}

sub get_info
{
  my ($pkg) = @_;
  if ($pkg =~ m/^(.+?)(?:-[^-]+-\d[^-]*?\.src)?(?:\.tar\.gz)$/)
  {
    $pkg = $1;
  }
  my $args = "type=info&arg=$pkg";
  my $info = `curl -k -s $aur_rpc -G -d "$args"`;
  if ($info =~ m/"ID":"(\d+)"/)
  {
    $ID = $1;
  }
  else
  {
    $ID = undef;
  }
  return $info;
}

sub login
{
  my $name = $NAME;
  my $pswd = $PSWD;
  if (not $name or not $pswd)
  {
    print 'AUR name: ';
    $name = <STDIN>;
    chomp $name;
    print 'password: ';
    system('stty -echo');
    $pswd = <STDIN>;
    system('stty echo');
    chomp $pswd;
  }
 `curl -k -c $cookiejar -d "user=${name}&passwd=${pswd}" $aur_index >/dev/null 2>&1`;
}

sub get_login_data
{
  open(my $fh, '<', $_[0]) or die "failed to open $_[0]: $!";
  my $name = <$fh>;
  chomp $name;
  my $pswd = <$fh>;
  chomp $pswd;
  close $fh;
  return ($name, $pswd);
}
