#! /usr/bin/perl -w
#
# Copyright (C) 2002 Amit Singh <www.kernelthread.com>. All Rights Reserved.
#
# Please  understand that  this tool is NOT  endorsed  by or  affiliated  to
# AudiWorld.com or  any of its  partner  websites. The  information in  this
# software is  subject to change  without notice and should not be construed
# as a  commitment by the  author. The author assumes no  responsibility for
# the use or reliability of the software under any circumstances.
# 
# The  program is  Copyright (C) 2002 by  Amit Singh <www.kernelthread.com>.
# This program is free software and  you can  redistribute it  and/or modify
# it under the terms of the Perl Artistic  License or the GNU General Public
# License as published by the Free Software Foundation; either  version 2 of
# the License, or (at your option) any later version.
#

# Default values: configurable
#
my %configuration = (
    'cookiejar'   => "$ENV{HOME}/.netscape/cookies",
    'deleteurl'   => "http://pictureposter.audiworld.com/delete.phtml?pid=",
    'email'       => undef,
    'listurl'     => "http://pictureposter.audiworld.com/",
    'loginurl'    => "http://account.audiworld.com/login.phtml?url=" .
                     "pictureposter.audiworld.com/",
    'logouturl'   => "http://account.audiworld.com/logout.phtml",
    'password'    => undef,
    'pictureurl'  => "http://pictureposter.audiworld.com/add.phtml",
);

# -- No user configurable data below this line --

my $PROG    = "awtool";
my $VERSION = "0.1a";
my $verbose = 0;

# kludge
#
my $OSname  = "$^O";
if ($OSname =~ /^.*win.*/i) {
    $OSname = "windows";
    $configuration{'cookiejar'} = "C:\\Program Files\\Netscape\\cookies.txt";
} else {
    $OSname = "unix";
}

my %optctl  = ();

# includes
#
use strict;
use Getopt::Long;
use LWP::UserAgent;
use HTTP::Cookies;
use HTTP::Request::Common;

GetOptions(
    \%optctl,
    "add+",
    "cookiejar=s",
    "delete+",
    "email=s",
    "help+",
    "info+",
    "list+",
    "password=s",
    "verbose+",
    "version+",
);

# 'info' overrides all other options
#
if ($optctl{'info'}) {
    do_info();
    exit 0;
}

# 'help' overrides all subsequent options
#
if ($optctl{'help'}) {
    do_help();
    exit 0;
}

# 'version' overrides all subsequent options
#
if ($optctl{'version'}) {
    do_version();
    exit 0;
}

if ($optctl{'verbose'}) {
    $verbose = "1";
}

# slurp in parameters to override defaults
#
foreach my $k (keys %optctl) {
    if (defined $optctl{$k}) {
        $configuration{$k} = $optctl{$k};
    }
}

$|++;

my $cookiejar_handle = undef;
my $login_needed = 1;

my $ua = LWP::UserAgent->new;
if (!$ua) {
    print STDERR "$PROG: failed to instantiate user agent.\n";
    exit 1;
}

if (defined $configuration{'cookiejar'}) {
    # Only Netscape cookiejars supported
    #
    eval {
        $cookiejar_handle = HTTP::Cookies::Netscape->new(
                                File     => $configuration{'cookiejar'},
                                AutoSave => 1,
                            );
    };

    if (!$cookiejar_handle) {
        print STDERR "$PROG: invalid cookie jar specified.\n";
        exit 1;
    }

    $cookiejar_handle->scan(\&chk_cookie);

} else {
    $cookiejar_handle = HTTP::Cookies->new;
}

# Hook-up the cookiejar to the user agent.
#
$ua->cookie_jar($cookiejar_handle);

if ($login_needed) {

    if (!$configuration{'email'} || !$configuration{'password'}) {
        print STDERR "$PROG: no cookie found for AudiWorld.\n";
        print STDERR "$PROG: require AudiWorld email and password to login.\n";
        exit 1;
    }

    if ($verbose) { print STDERR "Logging in to AudiWorld ... "; }
    my $login_r = $ua->simple_request(POST $configuration{'loginurl'}, {
                                         url      => '',
                                         email    => $configuration{'email'},
                                         password => $configuration{'password'},
                                        'login'  => 'Login',
                                      });

    if ($login_r->is_error) {
         # Failed to login
         #
         if ($verbose) { print STDERR "failed.\n"; }
         print STDERR "$PROG: failed to login to AudiWorld. " .
                      "Check your email and/or password.\n";

         exit 1;
    }
} else {
    if ($verbose) {
        print STDERR "Retrieving cookie for AudiWorld ... ";
    }
}

if ($verbose) { print "success.\n"; }

# Operations
#
my $me = 0;
my $op = undef;
if ($optctl{'list'})   { $me++; $op = "do_list()";  }
if ($optctl{'add'})    { $me++; $op = "do_add()";   }
if ($optctl{'delete'}) { $me++; $op = "do_delete()"; }

if ($me < 1) {
    print STDERR "$PROG: nothing to do because no operation specified.\n";
    print STDERR "Try `$PROG --help' for more information.\n";
    exit 1;
}

if ($me > 1) {
    print STDERR "$PROG: ambiguous: more than one operations specified.\n";
    exit 1;
}

# @ARGV should only contain filenames now
#

eval $op;
do_logout();
exit 0;

# -- Procedures --

# list operation
#
sub do_list
{
    my $n         = 0;
    my $list_r    = $ua->request(GET $configuration{'listurl'});

    if (!$list_r->is_success) {
        print STDERR "$PROG: failed to retrieve picture list from AudiWorld.\n";
        exit 1;
    }

    my @DATA      = split(/\n/, $list_r->content);
    my $infile    = 0;
    my $cur_file  = undef;
    my $cur_pid   = undef;
    print "    Picture filename                 AudiWorld Picture ID (pid)\n";
    print "    ----------------                 --------------------------\n";
    format STDOUT =
    @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<
    $cur_file, $cur_pid
.
    foreach $_ (@DATA) {
        if (!$infile && (/^Filename: (..*)\s*$/)) {
            $infile = 1;
            $cur_file = $1;
        } else {
            if (/.*pid=(\d+)..*Delete..*/) {
                $infile = 0;
                $cur_pid = $1;
            }
        }
        if (defined $cur_file && defined $cur_pid) {
            write;
            $n++;
            $cur_file = undef;
            $cur_pid  = undef;
        }
    }

    print "\n$n pictures total.\n";
}

# upload operation
#
sub do_add
{
    my $success_ctr = 0;
    my $failure_ctr = 0;

    if ($#ARGV < 0) {
        print STDERR "$PROG: no pictures to upload.\n";
        print STDERR "Try `$PROG --help' for more information.\n";
        exit 1;
    }

    UPLOOP: foreach $_ (@ARGV) {

        my @stat = stat($_);
        if (!@stat) {
            $failure_ctr++;
            if ($verbose) {
                print STDERR "    -> uploading $_ (? bytes) ... failed.\n";
                print STDERR "       \\__ Failed to upload $_ ($!).\n";
            } else {
                print STDERR "*** Failed to upload $_ ($!).\n";
            }
            next UPLOOP;
        }

        if ($verbose) {
            print STDERR "    -> uploading $_ ($stat[7] bytes) ... ";
        }

        my $picture_r = $ua->request(POST $configuration{'pictureurl'},
                                     Content_Type => 'form-data',
                                     Content      => [
                                                         type       => 'file',
                                                         submit     => 'Upload',
                                                         uploadfile => [ $_ ],
                                                     ]
                                    );
    
        if ($picture_r->is_error) {
            $failure_ctr++;
            if ($verbose) {
                print STDERR "failed.\n";
                print STDERR "       \\__ Failed to upload $_ ($!).\n";
            } else {
                print STDERR "*** Failed to upload $_ ($!).\n";
            }
        } else {
            $success_ctr++;
            if ($verbose) {
                print STDERR "success.\n";
            }
        }
    }

    if ($verbose) {
        my $t = $success_ctr + $failure_ctr;
        print STDERR "\n$PROG: $success_ctr/$t files uploaded successfully," .
                     " $failure_ctr failed.\n";
    }
}

sub do_delete
{
    my $success_ctr = 0;
    my $failure_ctr = 0;

    if ($#ARGV < 0) {
        print STDERR "$PROG: no pictures to delete.\n";
        print STDERR "Try `$PROG --help' for more information.\n";
        exit 1;
    }

    my $list_r    = $ua->request(GET $configuration{'listurl'});
    if (!$list_r->is_success) {
        print STDERR "$PROG: failed to retrieve picture list from AudiWorld.\n";
        exit 1;
    }

    my @DATA      = split(/\n/, $list_r->content);
    my $infile    = 0;
    my $cur_file  = undef;
    my $cur_pid   = undef;

    my %fphash    = ();

    foreach $_ (@DATA) {
        if (!$infile && (/^Filename: (..*)\s*$/)) {
            $infile = 1;
            $cur_file = $1;
        } else {
            if (/.*pid=(\d+)..*Delete..*/) {
                $infile = 0;
                $cur_pid = $1;
            }
        }
        if (defined $cur_file && defined $cur_pid) {
            $fphash{$cur_file} = $cur_pid;
            $cur_file = undef;
            $cur_pid  = undef;
        }
    }

    DLOOP: foreach $_ (@ARGV) {
        if ($verbose) {
            print STDERR "    -> deleting $_ (pid = $fphash{$_}) ... ";
        }

        my $du = $configuration{'deleteurl'} . $fphash{$_};
        my $delete_r = $ua->request(POST $du,
                                    Content => [
                                                   pid => $fphash{$_},
                                                   yes => 'Yes',
                                               ]
                                   );

        if ($delete_r->is_error) {
            $failure_ctr++;
            if ($verbose) {
                print STDERR "failed.\n";
                print STDERR "       \\__ Failed to delete $_ ($!).\n";
            } else {
                print STDERR "*** Failed to delete $_ ($!).\n";
            }
        } else {
            $success_ctr++;
            if ($verbose) {
                print STDERR "success.\n";
            }
        }
    }

    if ($verbose) {
        my $t = $success_ctr + $failure_ctr;
        print STDERR "\n$PROG: $success_ctr/$t files deleted successfully," .
                     " $failure_ctr failed.\n";
    }
}

# logout operation
#
sub do_logout
{
    # Attempt to logout if we logged in ourselves
    #
    if ($login_needed) {
        if ($verbose) {
            print STDERR "Logging out of AudiWorld ... ";
        }
    
        my $ret = undef;
        eval {
            $ret = $ua->request(GET $configuration{'logouturl'});
        };
    
        if ($verbose) {
            if (!$ret) {
                print STDERR "failed.\n";
            } else {
                print STDERR "success.\n";
            }
        }
    }
}

sub chk_cookie
{
    my ($version, $key, $val, $path, $domain,
        $port, $path_spec, $secure, $expires, $discard, $hash) = @_;

    if ("$domain" eq ".audiworld.com") {
        $login_needed = 0;
    }
}

sub do_version
{
    print "$VERSION\n";
    return 0;
}

sub do_info
{
    print <<ENDNOTES;
$PROG $VERSION
                               LEGALESE

This program is a command  line utility for adding,  delete, and listing
one or more pictures on the AudiWorld picture poster website.

Please  understand that  this tool is NOT  endorsed  by or affiliated to
AudiWorld.com or any of its partner  websites. The  information in  this
software is subject to change without notice and should not be construed
as a commitment by the author. The author assumes no  responsibility for
the use or reliability of the software under any circumstances.

The  program is Copyright (C) 2002 by  Amit Singh.                   This
program is free  software and  you can  redistribute it and/or modify it
under the terms of the Perl  Artistic  License or the GNU General Public
License as  published by the  Free Software Foundation; either version 2
of the License, or (at your option) any later version.

                               USAGE
                               
awtool allows you to  upload pictures to the  AudiWorld "Picture Poster".
Its utility lies in the fact that this  operation can be  performed from
the command line (both on Microsoft Windows and Un*x), and more than one
pictures can be uploaded at once.

The program either needs your AudiWorld email and password as arguments,
or if you already  have an  AudiWorld cookie stored  on your computer by
your browser (currently only Netscape cookie file format is  supported),
then awtool attempts  to use it. You  can either specify the location of
the cookie file on the command line, or have the program use the default
Netscape location on Un*x (~/.netscape/cookies).

If you choose to use your AudiWorld email and  password, please  realize
that this information is sent to AudiWorld only at the  beginning of the
upload session, and is not saved anywhere, not even on your machine.

Some examples of typical usage of this tool would look like:

  % $PROG --add file1.jpg file2.jpg
  % $PROG --cookiejar /tmp/cookies --add file1.jpg
  % $PROG --email <youremail> --password <yourpassword> --add file1.jpg
  % $PROG --list
  % $PROG --delete file1.jpg

ENDNOTES
}

sub do_help
{
    print "$PROG version $VERSION\n";
    print "Picture poster command line tool for AudiWorld.\n";
    print "Usage: awpost [OPTION]... FILE...\n\n";
    print "  --add         add picture(s) to AudiWorld\n";
    print "  --cookiejar   location of a Netscape cookies file\n";
    print "  --delete      delete picture(s) from AudiWorld\n";
    print "  --email       AudiWorld email address\n";
    print "  --help        print this help message and exit\n";
    print "  --info        detailed usage information and legalese\n";
    print "  --list        list your existing pictures on AudiWorld\n";
    print "  --password    AudiWorld password\n";
    print "  --verbose     be verbose while uploading\n";
    print "  --version     print version information and exit\n";
    print "\n";
    print "Report bugs to http://www.kernelthread.com/contact/\n";
    return 0;
}

__END__