#!/usr/bin/perl -w

# Copyright (c) 2010 Ilmari Karonen <vyznev@toolserver.org>.
#
# Permission to use, copy, modify, and/or distribute this
# software for any purpose with or without fee is hereby granted,
# provided that the above copyright notice and this permission
# notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
# WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
# WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL
# THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
# CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
# LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
# NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
# CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

use utf8;
use strict;
use LWP::UserAgent;
use HTTP::Request::Common qw'POST $DYNAMIC_FILE_UPLOAD';
$DYNAMIC_FILE_UPLOAD = 1;
use XML::Simple;
use Data::Dumper 'Dumper';
use Getopt::Long 'GetOptions';
use Term::ReadKey 'ReadMode';
use POSIX 'strftime';

binmode $_, ":utf8" for \*STDIN, \*STDOUT, \*STDERR;
utf8::decode($_) for @ARGV;

my $unicode = "Üñıç∅∂\x{3F5}";

# Default options:

my $username = "Ilmari Karonen";
my $server = "commons.wikimedia.org";
my $name;
my $desc;
my $comment;
my $verbose;
my $watch;
my $eval;

# Usage instructions:

my $usage = <<"USAGE";
Usage: $0 [options] <file(s)>
Options:
    -u, --user, --username=<name>
        User name to log in as (default: $username).
    -s, --server=<hostname>
        Hostname of wiki server (default: $server).
    -n, --name=<filename>
        Target filename (if specified, only one input file allowed).
    -d, --description=<text>
        Initial file description (also used as summary if -c is not given).
    -c, --comment, --summary=<text>
        Upload summary (also used as description if -d is not given).
    -e, --eval
        Evaluate description and summary as Perl strings, with \$_ set to target file name.
    -v, --verbose
        Dump out response HTML.
    -w, --watch
        Automatically add target page to watchlist.
USAGE
# '

# Parse options, print usage message if failed:

GetOptions( 'username|u=s' => \$username,
            'server|s=s' => \$server,
            'name|n=s' => \$name,
            'description|d=s' => \$desc,
            'summary|comment|c=s' => \$comment,
	    'eval|e' => \$eval,
	    'verbose|v' => \$verbose,
	    'watch|w' => \$watch,
          ) and (@ARGV) or die $usage;

die "Only one input file allowed with -n option.\n" if $name and @ARGV > 1;
die "Either description or summary must be given.\n" unless defined($desc) or defined($comment);

$desc = $comment unless defined $desc;
$comment = $desc unless defined $comment;

# Set up user agent, define subroutine for API queries:

my $ua = LWP::UserAgent->new(
                             agent => "Mozilla/4.0 (compatible; $0)",
                             from => 'vyznev@toolserver.org',
                             cookie_jar => {},
                             parse_head => 0,
                            );

my $apiURI = "http://$server/w/api.php";

sub apireq {
    my $query = [format => 'xml', @_];
    my $sleep = 5;
    grep utf8::encode($_), (ref $_ ? @$_ : $_) for @$query;
    while (1) {
        my $res = $ua->post($apiURI, $query, Content_Type => 'form-data');
        my $err = $res->header('MediaWiki-API-Error') || "";

        return XMLin( $res->content ) if $res->is_success and $err ne 'maxlag';

        print STDERR "API request failed, ", ($err || $res->status_line), "...";
        if ($sleep > 3*60*60) {
            warn "giving up\n";
            return XMLin( $res->content );
        }
        warn "sleeping $sleep seconds\n";
        sleep $sleep;
        $sleep *= 2;
    }
}

# Read password from stdin and log in:

ReadMode 'noecho';
print STDERR "Password for $username \@ $server: ";
my $pass = <STDIN>;
chomp $pass;
print STDERR "\n";
ReadMode 'restore';

warn "Logging in to $server as $username...\n";
my $login = apireq( action => 'login', lgname => $username, lgpassword => $pass );
$login = apireq( action => 'login', lgname => $username, lgpassword => $pass, lgtoken => $login->{login}{token} )
    if ($login->{login}{result} || '') eq 'NeedToken';
$login->{error} and die "Login as $username failed ($login->{error}{code}): $login->{error}{info}\n";
$login->{login}{result} eq 'Success' or die "Login as $username failed: $login->{login}{result}\n";

# Do the uploads:

foreach my $file (@ARGV) {
    my $size = -s $file or warn "$file does not exist or is empty!\n" and next;
    my $dest = ($name || $file);
    $dest =~ s!^.*/!!;
    $dest =~ tr/ /_/;

    my ($mydesc, $mycomment) = ($desc, $comment);
    if ($eval) {
	for my $text ($mydesc, $mycomment) {
	    local $_ = $dest;
	    tr/_/ /;
	    my $eot = "END_OF_TEXT_" . int(2**31 * rand());
	    $text = eval qq(<<"$eot";\n$text\n$eot\n);
	    die if $@;
	}
    }

    my $data = apireq(
		      maxlag => 5,
		      action => 'query',
		      prop => 'info',
		      intoken => 'edit',
		      titles => $dest,
		      requestid => $unicode,
		     );
    $data->{requestid} eq $unicode or die "Unicode round trip failed: expected \"$unicode\", got \"$data->{requestid}\".\n";
    my $token = $data->{query}{pages}{page}{edittoken}
        or die "Failed to get token, got:\n", Dumper($data), "\n";

    print STDERR "Uploading $file ($size bytes) as $dest... ";

    my $upload = apireq(
			action => 'upload',
			file => [$file],
			filename => $dest,
			comment => $mycomment,
			text => $mydesc,
			watch => $watch,
			ignorewarnings => 1,
			token => $token
		       );

    if (ref $upload ne 'HASH') {
	warn "Got unexpected result:\n", Dumper($upload), "\n";
    } elsif ($upload->{error}) {
	warn "Uploading $file failed ($upload->{error}{code}): $upload->{error}{info}\n";
    } elsif ($upload->{upload}{result} ne 'Success') {
	warn "Uploading $file did not succeed ($upload->{upload}{result}):\n", Dumper($upload), "\n";
    } else {
	warn "OK\n";
    }
}

__END__