#!/usr/bin/perl

use strict;
use warnings;
use Flickr::Upload;
use Getopt::Long;
use Pod::Usage;

my $api_key = '8dcf37880da64acfe8e30bb1091376b7';
my $not_so_secret = '2f3695d0562cdac7';

my %args;
my @tags = ();
my $help = 0;
my $man = 0;
my $auth = 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] },
	'auth_token=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] },
	'key=s' => \$api_key,
	'secret=s' => \$not_so_secret,
	'auth' => \$auth,
) or pod2usage(2);
pod2usage(1) if $help;
pod2usage(-exitstatus => 0, -verbose => 2) if $man;

my $version = qw($Revision: 1.7 $)[1];

my $ua = Flickr::Upload->new( {'key' => $api_key, 'secret' => $not_so_secret} );
$ua->agent( "flickr_upload/$version" );

if( $auth ) {
	# The user wants to authenticate. There's really no nice way to handle this.
	# So we have to spit out a URL, then hang around or something until
	# the user hits enter, then exchange the frob for a token, then tell the user what
	# the token is and hope they care enough to stick it into .flickrrc so they
	# only have to go through this crap once.

	# 1. get a frob
	my $frob = getFrob( $ua );

	# 2. get a url for the frob
	my $url = $ua->request_auth_url('write', $frob);

	# 3. tell the user what to do with it
	print "1. Enter the following URL into your browser\n\n",
	      "$url\n\n",
	      "2. Follow the instructions on the web page\n",
			"3. Hit <Enter> when finished.\n\n";
	
	# 4. wait for enter.
	<STDIN>;

	# 5. Get the token from the frob
	my $auth_token = getToken( $ua, $frob );
	die "Failed to get authentication token!" unless defined $auth_token;
	
	# 6. Tell the user what they won.
	print "You authentication token for this application is\n\t\t", $auth_token, "\n";
	
	exit 0;
}

pod2usage(1) unless exists $args{'auth_token'};
pod2usage(1) unless @ARGV;

$args{'tags'} = join( " ", @tags ) if @tags;

# pipeline things by uploading first, waiting for photo ids second.
$args{'async'} = 1;
my %tickets;

$| = 1;
while( my $photo = shift @ARGV ) {
	print 'Uploading ', $photo, '...';

	my $rc = $ua->upload( 'photo' => $photo, %args );

	# let the caller know how many images weren't uploaded
	exit (1+@ARGV) unless defined $rc;

	# check those later
	$tickets{$rc} = $photo;

	print "\n";
}

# check
print "Waiting for upload results (ctrl-C if you don't care)...\n";
do {
	sleep 1;
	my @checked = $ua->check_upload( keys %tickets );
	for( @checked ) {
		if( $_->{complete} == 0 ) {
			# not done yet, don't do anythig
		} elsif( $_->{complete} == 1 ) {
			# uploaded, got photoid
			print "$tickets{$_->{id}} is at " .
				"http://www.flickr.com/tools/uploader_edit.gne?ids=$_->{photoid}\n";
			delete $tickets{$_->{id}};
		} else {
			print "$tickets{$_->{id}} failed to get photoid\n";
			delete $tickets{$_->{id}};
		}
	}
} while( %tickets );

exit 0;

sub response_tag {
	my $t = shift;
	my $name = shift;
	my $tag = shift;

	return undef unless defined $t and exists $t->{'children'};

	for my $n ( @{$t->{'children'}} ) {
		next unless $n->{'name'} eq $name;
		next unless exists $n->{'children'};

		for my $m (@{$n->{'children'}} ) {
			next unless exists $m->{'name'}
				and $m->{'name'} eq $tag
				and exists $m->{'children'};

			return $m->{'children'}->[0]->{'content'};
		}
	}
	return undef;
}

sub getFrob {
	my $ua = shift;

	my $res = $ua->execute_method("flickr.auth.getFrob");
	return undef unless defined $res and $res->{success};

	# FIXME: error checking, please. At least look for the node named 'frob'.
	return $res->{tree}->{children}->[1]->{children}->[0]->{content};
}

sub getToken {
	my $ua = shift;
	my $frob = shift;

	my $res = $ua->execute_method("flickr.auth.getToken",
		{ 'frob' => $frob } );
	return undef unless defined $res and $res->{success};

	# FIXME: error checking, please.
	return $res->{tree}->{children}->[1]->{children}->[1]->{children}->[0]->{content};
}

__END__

=head1 NAME

flickr_upload - Upload photos to C<flickr.com>

=head1 SYNOPSIS

flickr_upload [--auth] --auth_token <auth_token> [--title <title>]
	[--description description] [--public <0|1>] [--friend <0|1>]
	[--family <0|1>] [--tag <tag>] <photos...>

=head1 DESCRIPTION

Uploads images to the L<Flickr.com> service.

=head1 OPTIONS

=over 4

=item --auth

When defined 

=item --auth_token <auth_token>

Authentication token. Required.

=item --title <title>

Title to use on all the images. Optional.

=item --description <description>

Description to use on all the images. Optional.

=item --public <0|1>

Override the default C<is_public> access control. Optional.

=item --friend <0|1>

Override the default C<is_friend> access control. Optional.

=item --family <0|1>

Override the default C<is_friend> access control. Optional.

=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 --key <api_key>

=item --secret <secret>

Your own API key and secret. This is useful if you want to use L<flickr_upload> in
auth mode as a token generator. You need both C<key> and C<secret>.

=item <photos...>

List of photos to upload. Uploading stops as soon as a failure is detected
during the upload. The script exit code will indicate the number of images
on the command line that were not uploaded. For each uploaded image, the
allocated photo identifier (currently just a number) is printed.

=head1 CONFIGURATION

To avoid having to remember authentication tokens 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
	auth_token=334455
	is_public=0
	is_friend=1
	is_family=1

=head1 BUGS

Error handling could be better.

=head1 AUTHOR

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

=head1 SEE ALSO

L<flickr.com>

L<Flickr::Upload>

=cut
