#!/home/josh/perl5.8.3/bin/perl
use strict;
use warnings;
use Mail::Internet ();
use MIME::Parser ();
use WWW::Mechanize ();
use Archive::Zip ();
use File::Spec ();
use File::Slurp ();
use IO::Handle ();
use Image::Magick::Thumbnail ();
use File::MMagic ();
use Mail::Sendmail ();
use vars qw( $PERLMONKS $PM_BROWSER $PIXELS $SENDTO $SENDFROM);
use Data::Dumper 'Dumper';

$PERLMONKS = 'http://perlmonks.org';
$PIXELS = 500;

exit main( );

sub main
{
    my $fh = slurp_to_string( \*STDIN );
    
    my ( $username, $password,
     $sendfrom, $sendto ) = match_pm_user( $fh, [ <DATA> ] );
    
    my $nm = get_sprint_image( $fh );
    
    if ( $sendfrom ne $SENDFROM )
    {
    die "$sendfrom ne $SENDFROM";
    }

    if ( $sendto ne $SENDTO )
    {
    die "$sendto ne $SENDTO";
    }

    resize_image( $nm );
    
    authenticate_to_perlmonks( username => $username,
                   password => $password )
    or die "Couldn't authenticate ($username, $password)";

    
    upload_image_to_perlmonks( username => $username,
                   filename => $nm )
    or die "Couldn't upload image ($username, $nm)";

    announce_image( $username );
    
    0;
}

sub announce_image
{
    $PM_BROWSER->get( "$PERLMONKS/?node=ad_and_talk;displaytype=raw" )
+;
    $PM_BROWSER->field( 'message', "/me just uploaded a new monkpic" )
+;
    $PM_BROWSER->submit;
}

sub resize_image
{
    my $name = shift;
    
    my $img = Image::Magick->new;
    $img->Read( $name );
    my ($thumb, $x, $y ) = Image::Magick::Thumbnail::create( $img, $PI
+XELS );
    $thumb->Write( $name );
    0;
}

sub match_pm_user
{
    my $fh = shift;
    my @users = @{ shift() };
    my $user = quotemeta mail_from( $fh );
    
    split ' ', ( grep s/^$user\s+//i, @users )[0]
}

sub mail_from
{
    my $fh = shift;
    $fh->seek( 0, Fcntl::SEEK_SET );
    my $from = Mail::Internet->new( $fh )->head->header_hashref->{'Fro
+m'}[0];
    $from =~ s/\s+//g;
    $from;
}

sub slurp_to_string
{
    my $fh = shift;
    local $/;
    local $,;
    local $;;
    my $str;
    open my $ofh, "+>:raw", \ $str or die $!;
    $ofh->print( <$fh> );
    $ofh->seek( 0, Fcntl::SEEK_SET );
    $ofh;
}

sub authenticate_to_perlmonks
{
    my %p = @_;
    $PM_BROWSER = WWW::Mechanize->new;
    $PM_BROWSER->get( $PERLMONKS );
    $PM_BROWSER->form_name( 'login' );
    $PM_BROWSER->set_fields( user =>   $p{'username'},
                 passwd => $p{'password'} );
    $PM_BROWSER->submit->content;
    
    !! $PM_BROWSER->find_link( text_regex => qr/log.+?out/ );
}

sub upload_image_to_perlmonks
{
    my %p = @_;

    my $magic = File::MMagic->new->checktype_filename( $p{'filename'} 
+);
    
    $PM_BROWSER->get( "$PERLMONKS/?node=$p{'username'};displaytype=edi
+t" );
    $PM_BROWSER->form_number( 2 );
    my $widget = $PM_BROWSER->current_form->find_input( 'imgsrc_file' 
+);
    $widget->file( $p{'filename'} );
    $widget->filename( $p{'filename'} );
    $widget->headers( 'Content-Type' => $magic );
    
    $PM_BROWSER->click->content =~ /Received \d+ bytes/;
}

sub get_sprint_image
{
    my $fh = shift;
    
    my $zfile = Archive::Zip::tempFile( File::Spec->tmpdir );
    my $ifile = Archive::Zip::tempFile( File::Spec->tmpdir );
    File::Slurp::write_file( $zfile,
                 { binmode => 1,
                   buf_ref => get_sprint_zip( $fh ) } );
    my $zip = Archive::Zip->new( $zfile );
    
    my $magic = File::MMagic->new;
    my $ok;
    for my $name ( $zip->memberNames )
    {
    $zip->extractMember( $name, $ifile );
    my $type = $magic->checktype_filename( $ifile );
    if ( $type =~ /^image\/(?:png|gif|jpeg)/ )
    {
        $ok = 1;
        last;
    }
    }
    
    unlink $zfile or die $!;
    $ok ? $ifile : ();
}

sub get_sprint_zip
{
    my $fh = shift;
    
    my $browser = WWW::Mechanize->new;
    
    # Get the URL from the text portion of the email.
    my $url = ( ${get_text_from_email( $fh )}
        =~ m((\Qhttp://pictures.sprintpcs.com/\E\S+)) )[0];
    my $page = $browser->get( $url );
    
    # Get the next URL from inside the JavaScript
    $url = unpack "N/a*",
    ( sort { $b cmp $a }
      map pack( "N/a*", $_),
      $page->content =~ m((\Qhttp://pictures.sprintpcs.com/\E[^\'\"]+)
+)g )[0];
    
    $browser->get( $url );
    
    # Authenticate that the 
    $page = $browser->follow_link( url_regex => qr/comment/ );
    $url = unpack "N/a*",
    ( sort { $b cmp $a }
      map pack( "N/a*", $_),
      $page->content =~ m((\Qhttp://pictures.sprintpcs.com/\E[^\'\"]+)
+)g )[0];
    
    $page = $browser->get( $url );
    $SENDTO = ( map +( /\bvalue\s*=\s*([\'\"])(.+?)\1/ && $2 ),
        grep /\bname\s*=\s*([\'\"]).+?\1/ && $& =~ /\bemail\b/,
        $page->content =~ m(<input[^>]+)g )[0];
    $SENDFROM = ( $page->content =~ m/addGuest\("(.+?)"/g )[0];
    $SENDFROM =~ s/\|$//;
    
    $browser->back;
    $browser->back;
    
    # Now hit the javascript:download() action which is really just
    # a document.listForm.submit(); This returns a .ZIP file containin
+g
    # a higher resolution picture image.
    $page = $browser->submit_form( form_name => 'listForm' );
    
    my $zip_file = \ $page->content;
}

sub get_text_from_email
{
    my $fh = shift;
    $fh->seek( 0, Fcntl::SEEK_SET );
    my $p = MIME::Parser->new;
    $p->output_to_core(1);
    my $e = $p->parse( $fh );
    
    \ join( '',
        map $_->stringify_body,
        grep $_->mime_type =~ m(text/plain),
        $e->parts );
}

# One line per user, each field is separated by white space.
# 1: the address to be matched against From: from the email
# 2: URI encoded perlmonks.org username
# 3: URI encoded perlmonks.org password
# 4: the address to validate on the web page - typically the same as #
+1
# 5: the address the message is expected to have been sent to

__DATA__
from@foo.bar username password from@foo.bar script@foo.bar
[download]