#!/usr/bin/perl

use strict;
use warnings;

use Flickr::Upload qw(upload check_upload);
use Getopt::Long;
use Pod::Usage;
use File::Basename;

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

use LWP::UserAgent;

our $VERSION = qw($Revision: 1.1 $)[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 at the front of the list
	unshift @photos, $_[0];
	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 ) {
			for( @{$files} ) {
				add_photo( $_ ) if -f $_;
			}
		} 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.1 $)[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;

	# FIXME: this kinda sucks... Need some kinda of progress indicator.
	# fork/exec/pipe with Tk filevents is the recommended approach...

	my $ua = LWP::UserAgent->new;
	$ua->agent( "thickr_upload/$VERSION" );
	my $rc = upload( $ua, %args );
	if( defined $rc ) {
		$statusmsg = "Uploaded, ticket number $rc";
	} else {
		$statusmsg = "Upload failed";
	}
}

#########################################################################
__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
