#!/usr/bin/perl

use strict;
use warnings;

use Flickr::Upload qw(upload_request make_upload_request check_upload);
use Getopt::Long;
use Pod::Usage;
use File::Basename;
use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);

use Tk;
use Tk::JPEG;
use Tk::PNG;
use Tk::FileSelect;
use Tk::DropSite;

use IO::Handle;
use IO::Pipe;
use POSIX qw(:errno_h);
use LWP::UserAgent;

our $VERSION = qw($Revision: 1.2 $)[1];

#########################################################################
my $preview_height = 128;

my %args = (
	'is_public' => 1,
	'is_friend' => 1,
	'is_family' => 1,
	'async' => 1,
);
my @tags = ();
my $help = 0;
my $man = 0;

if( open CONFIG, "< $ENV{HOME}/.flickrrc" ) {
	while( <CONFIG> ) {
		chomp;
		s/#.*$//;	# strip comments
		$args{$1} = $2 if m/^\s*([a-z]+)=(.+)\s*$/io;
	}
	close CONFIG;
}

GetOptions(
	'help|?' => \$help,
	'man' => \$man,
	'tag=s' => \@tags,
	'uri=s' => sub { $args{$_[0]} = $_[1] },
	'email=s' => sub { $args{$_[0]} = $_[1] },
	'password=s' => sub { $args{$_[0]} = $_[1] },
	'public=i' => sub { $args{is_public} = $_[1] },
	'friend=i' => sub { $args{is_friend} = $_[1] },
	'family=i' => sub { $args{is_family} = $_[1] },
	'title=s' => sub { $args{$_[0]} = $_[1] },
	'description=s' => sub { $args{$_[0]} = $_[1] },
) or pod2usage(2);
pod2usage(1) if $help;
pod2usage(-exitstatus => 0, -verbose => 2) if $man;

######################################################################
# seed the photo list with whatever is left on command line
my @photos = @ARGV;

my $desc;	# description widget
my $tags;	# tags widget
my $statusmsg = "$0 $VERSION";
my $preview;
my $logoimage;

# list of widgets which are only sensitive when there's photos in the list
my @photo_widgets;

# make widgets look good, sets up current photo info, etc
sub update_photo_widgets() {
	# for every file, try to load it into the preview...
	my $image = $desc->Photo();
	while( @photos and not eval {$image->read($photos[0]); 1}) {
		shift @photos;
	}

	if( @photos ) {
		$_->configure( -state => 'normal' ) for @photo_widgets;
		$args{photo} = $photos[0];
		$args{title} = basename $args{photo};
		$args{title} =~ s/\.[a-z0-9]{3,4}$//io;	# strip extension

		# need to shrink the input image down to fit the preview
		my $smaller = $preview->Photo();
		$smaller->copy( $image,
			-subsample => $image->height/$preview_height );
		$preview->configure( -image => $smaller );
	} else {
		$args{photo} = '';
		$preview->configure( -image => $logoimage );
		$_->configure( -state => 'disabled' ) for @photo_widgets;
	}

	$image->delete;
}

sub add_photo {
	# put the new photo(s) at the front of the list
	unshift @photos, @_;
	update_photo_widgets();
}

#######################################################################
my $toplevel = new MainWindow();
my $menubar = $toplevel->Menu();

my $filemenu = $menubar->cascade( -label => '~File' );
my $start = '.';
$filemenu->command( -label => 'Open',
	-command => sub {
		my $images = [
			['Image Files', [qw(.jpg .jpeg .gif .png .tif .tiff)]],
			['All Files', '*' ],
		];
		my $files = $toplevel->getOpenFile( -filetypes => $images,
			-multiple => 1, -title => "Open Photo(s)" );
		return unless defined $files;
		if( ref $files ) {
			add_photo( (grep { -f $_ } @{$files}) );
		} elsif( -f $files ) {
			add_photo( $files );
		}
	}
);
$filemenu->separator();
$filemenu->command( -label => 'Quit',
	-command => sub {
		# FIXME: warn user about uploads in progress/queued
		$toplevel->destroy()
	}
);

my $helpmenu = $menubar->cascade( -label => '~Help',);
$helpmenu->command( -label => 'About',
	-command => sub {
		my $msg = $toplevel->messageBox( 
			-title => 'About thickr_upload',
			-type => 'Ok',
			-message => 'thickr_upload ' . qw($Revision: 1.2 $)[1]
				. "\npart of Flickr::Upload"
				. "\n\ncpb\@cpan.org" );
	}
);

$toplevel->configure( -menu => $menubar );

my $appframe = $toplevel->Frame()->pack(
	-anchor => 'nw', -side => 'top', -fill => 'x' );

my $frame = $appframe->Frame()->pack( -anchor => 'nw', -side => 'top',
	-fill => 'x' );
$frame->Label( -text => 'E-Mail:' )->pack( -anchor => 'nw', -side => 'left');
$frame->Entry(-textvariable => \$args{email})->pack(
	-side => 'top', -fill => 'x' );

$frame = $appframe->Frame()->pack( -anchor => 'nw', -side => 'top',
	-fill => 'x' );
$frame->Label( -text => 'Password:' )->pack( -anchor => 'nw', -side => 'left');
$frame->Entry(-textvariable => \$args{password},-show => '*')->pack(
	-side => 'top', -fill => 'x' );

$frame = $appframe->Frame()->pack( -anchor => 'nw', -side => 'top',
	-fill => 'x' );
push @photo_widgets, $frame->Label( -text => 'Photo:'
	)->pack( -anchor => 'nw', -side => 'left');
$frame->Entry(-textvariable => \$args{photo}, -state => 'readonly')->pack(
	-side => 'top', -fill => 'x' );

$frame = $appframe->Frame()->pack( -anchor => 'nw', -side => 'top',
	-fill => 'x' );
push @photo_widgets, $frame->Label( -text => 'Title:'
	)->pack( -anchor => 'nw', -side => 'left');
push @photo_widgets, $frame->Entry(-textvariable => \$args{title})->pack(
	-side => 'top', -fill => 'x' );

$frame = $appframe->Frame()->pack( -anchor => 'nw', -side => 'top',
	-fill => 'x' );
push @photo_widgets, $frame->Label( -text => 'Description:'
	)->pack( -anchor => 'nw',
	-side => 'top');
$desc = $frame->Text( -wrap => 'word',
	-height => 3, -width => 40,
)->pack( -side => 'top', -fill => 'x', -expand => 1 );
$desc->Contents( $args{description} );
push @photo_widgets, $desc;

$frame = $appframe->Frame()->pack( -anchor => 'nw', -side => 'top',
	-fill => 'x' );
push @photo_widgets, $frame->Label( -text => 'Tags:'
	)->pack( -anchor => 'nw', -side => 'top');
$tags = $frame->Text( -wrap => 'word',
	-height => 3, -width => 40,
)->pack( -side => 'top', -fill => 'x', -expand => 1 );
$tags->Contents( join(' ',@tags) );
push @photo_widgets, $tags;

$frame = $appframe->Frame()->pack( -anchor => 'nw', -side => 'top',
   -fill => 'x' );
my %flags = (
	Friends => 'is_friend',
	Family => 'is_family',
	Public => 'is_public',
);
for( qw(Friends Family Public) ) {
	push @photo_widgets, $frame->Checkbutton( -text => $_,
		-variable => \$args{$flags{$_}} )->pack( -side => 'left' );
}

# we coule create our own or use the flickr logo. Or just have an empty
# one.
$logoimage = $toplevel->Photo();

$preview = $appframe->Label( -image => $logoimage, -height => 128
)->pack( -side => 'top', -fill => 'x' );

# configure the preview as a drag 'n drop target
$preview->DropSite(
	-dropcommand => sub {
		print STDERR "Got drop ", join(',',@_), "\n";
		my $selection = shift;
		my $filename;
		eval {
			if ($^O eq 'MSWin32') {
				$filename = $preview->SelectionGet(-selection => $selection,
					'STRING');
			} else {
				$filename = $preview->SelectionGet(-selection => $selection,
					'FILE_NAME');
			}
		};
		unless( defined $filename ) {
			$filename = $preview->SelectionGet(-selection => $selection,
				'STRING');
			# HACK for Konqueror
			$filename =~ s/^file://o if defined $filename;
		}
		add_photo( $filename ) if defined $filename and -f $filename;
	},
	-droptypes => ($^O eq 'MSWin32' ? 'Win32' : ['XDND', 'Sun'])
);

$frame = $toplevel->Frame()->pack( -side => 'top', -fill => 'x' );
push @photo_widgets, $frame->Button( -text => 'Upload',
	-command => sub {
		# upload the current photo with the current variables. We need to get
		# description and tags separately from the Text widgets. Everything
		# else has already been placed in %args.
		$args{description} = $desc->Contents();
		$args{tags} = $tags->Contents();

		$statusmsg = "Queueing $args{photo}...";
		upload_photo(); # add to upload queue
		shift @photos if @photos;	 # remove current photo from list
		update_photo_widgets();
	} )->pack( -side => 'left' );
push @photo_widgets, $frame->Button( -text => 'Skip',
	-command => sub {
		shift @photos if @photos;	 # remove current photo from list
		update_photo_widgets();
	} )->pack( -side => 'left' );

$toplevel->Label( -textvariable => \$statusmsg )->pack(
	-side => 'top', -fill => 'x' );

#########################################################################
update_photo_widgets();

MainLoop();

exit 0;

######################################################################
sub upload_photo {
	$args{async} = 1;

	my $pipe = new IO::Pipe;

	unless( defined $pipe ) {
		$statusmsg = "Failed to open uploader process!";
		return;
	}

	my $pid = fork();
	if( $pid ) {
		# parent...
		$pipe->reader();

		# create a Tk fileevent to handle the response from the upload
		$toplevel->fileevent( $pipe, "readable" => sub {
				my $buf;
				# ordinarily getline() would be bad except we know
				# that the uploader feeds us a short line at a time.
				if( not $pipe->eof() and $buf = $pipe->getline() ) {
					$buf =~ s/\n//gso;
					$statusmsg = $buf;
					return;
				}

				# error or eof... remove the fileevent
				$toplevel->fileevent( $pipe, "readable" => undef);
				$pipe->close();
			} );
	} else {
		$pipe->writer();
		$pipe->autoflush(1);

		my $req = make_upload_request( %args );

		# replace the content generator sub with one that spits out
		# progress info. This will go out the pipe and
		# back to the uploader... It doesn't matter _what_ we spit out, so
		# newlines are handy because they implicitly flush the output
		# FIXME: this is kinda useless right now...
#		my $gen = $req->content();
#		$req->content(
#			sub {
#				my $chunk = &$gen();
#				print ".\n" if defined $chunk;
#				return $chunk;
#			}
#		);

		my $ua = LWP::UserAgent->new;
		$ua->agent( "thickr_upload/$VERSION" );

		my $rc = upload_request( $ua, $req );
		if( defined $rc ) {
			print $pipe "Uploaded $args{photo}, ticket number $rc\n";
			# FIXME: should we wait for the photoid?
		} else {
			print $pipe "Failed to upload $args{photo}\n";
		}

		CORE::exit 0;
	}
}

#########################################################################
__END__

=head1 NAME

thickr_upload - Upload photos to C<flickr.com> from a GUI

=head1 SYNOPSIS

thickr_upload --email <email> --password <password> [--title <title>]
	[--description description] [--public <0|1>] [--friend <0|1>]
	[--family <0|1>] [--tag <tag>] [<photos...>]

=head1 DESCRIPTION

GUI tool to upload images to the L<Flickr.com> service.

Photos can be added in three ways:

=item listing them on the command-line

=item loading them via the C<File|Open> menu (multiple select is supported)

=item drag and drop to the preview area (hopefully)

The user goes through the photo list updating fields and uploading images.
Additional photos can be added at any point in the process.

=head1 OPTIONS

None of the options are required. The user will be prompted to fill out
things as needed.

=over 4

=item --email <email>

Email address of L<Flickr.com> user.

=item --password <password>

Password of L<Flickr.com> user.

=item --title <title>

Title to use on all the images.

=item --description <description>

Description to use on all the images.

=item --public <0|1>

Override the default C<is_public> access control.

=item --friend <0|1>

Override the default C<is_friend> access control.

=item --family <0|1>

Override the default C<is_friend> access control.

=item --tag <tag>

Images are tagged with C<tag>. Multiple C<--tag> options can be given, or
you can just put them all into a single space-separated list.

=item <photos...>

List of photos to upload. Photos can also be added after the user interface
is launched.

=head1 CONFIGURATION

To avoid having to type email and passwords and such (or have them show up
in the process table listings), default values will
be read from C<$HOME/.flickrrc> if it exists. Any field defined there can, of
course, be overridden on the command line. For example:

	# my config at $HOME/.flickrrc
	email=me@example.com
	password=secret
	is_public=0
	is_friend=1
	is_family=1

=head1 BUGS

Plenty, no doubt.

During upload, GUI blocks. Not sure how to best handle this right now. We
do shorten the delay as much as possible by using async uploading.

=head1 AUTHOR

Christophe Beauregard, L<cpb@cpan.org>.

=head1 SEE ALSO

L<flickr.com>

L<Flickr::Upload>

L<flickr_upload>

=cut
