#!/usr/bin/perl -w

# automated submission client for slackbuilds.org web form.
# by B. Watson <yalhcru@gmail.com>.
# Licensed under the WTFPL. See http://www.wtfpl.net/txt/copying/ for details.
# run with no arguments for usage instructions.

# requires perl/perl-LWP-Protocol-https (and all its deps including libwwwperl)

use LWP;
use Getopt::Std;

@categories = qw/
Academic
Accessibility
Audio
Business
Desktop
Development
Games
Graphics
Haskell
Libraries
Misc
Multimedia
Network
Office
Perl
Python
Ruby
System
/;

sub usage {
	my $cats = join("\n", @categories);
	warn <<EOF;

Usage: $0 -c <category> [-e <email>] [-C <comment>] [-k <keywords>] file

If no -e option is given, the contents of ~/.sbo_email is used as the
email address (and it's a fatal error if the file's missing).

The categories for -c are:

$cats

The -c argument is case-insensitive, and category names may be abbreviated
to the shortest unique prefix (e.g. "gr" for Graphics is OK, but "g"
is an error because it matches both Graphics and Games).

No checking is done on the file before it's uploaded (other than its
existence).

After the file is uploaded, the server's response is displayed via
"links -dump". $0's exit status does NOT reflect success/failure: it
will be zero if an upload was done, or non-zero if there's an error in
the arguments (in which case no upload is done).
EOF
	exit($_[0] || 0);
}

sub die_usage {
	warn $_ . "\n" for @_;
	usage(1);
}

sub get_category {
	my $in = shift;
	my $orig = $in;
	my @got;

	$in =~ s/[^A-Za-z]//g;
	for(@categories) {
		push @got, $_ if /^$in/i;
	}

	if(!@got) {
		die_usage("Invalid category '$orig'");
	} elsif(@got > 1) {
		die_usage("Ambiguous category '$orig', matches: " . join(" ", @got));
	} else {
		return $got[0];
	}
}

if(!@ARGV || $ARGV[0] =~ /--?h(?:elp)?/i) {
	usage;
}

getopts('c:e:C:k:', \%opts);
($userfile, $junk) = @ARGV;

die_usage("Unknown junk on command line: '$junk'") if $junk;
die_usage("No category (missing required -c arg)") unless $opts{c};
$category = get_category($opts{c});
$submail = $opts{e} || $ENV{SBO_EMAIL};
die_usage("No email address (use -e or else create ~/.sbostuff.cfg)") unless $submail;
$comments = $opts{C} || "";
$tags = $opts{k} || "";

if(! -e $userfile) {
	die_usage("File not found: $userfile");
}

print STDERR "Uploading...";

$ua = LWP::UserAgent->new;
$ua->agent('Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)');
$resp = $ua->post(
		'https://slackbuilds.org/process_submit/',
		[ MAX_FILE_SIZE => '100000',
		  userfile => [ $userfile ],
		  category => $category,
		  tags => $tags,
		  submail => $submail,
		  comments => $comments,
		  submit => 'Upload File' ],
		Content_Type => 'form-data',
		Referer => 'https://slackbuilds.org/submit/',
		);

print STDERR "\n";

$tmpfile = "/tmp/sboul.$$." . int(rand(10 ** 10)) . ".html";
open RESULT, ">$tmpfile" or die "$tmpfile: $!";
print RESULT $resp->content;
close RESULT;
system("links -dump $tmpfile | sed -n '/Upload Results/,/Home.*Change Log/p'");
unlink $tmpfile;

warn "*** HTTP response code is " . $resp->code . "\n" unless $resp->code == 200;