up2flickr.pl - Using the Perl Flickr::Upload module to upload a directory of photos to Flickr

Category: Perl
Author: Sean O'Donnell
Wed, Mar. 3rd, 2010 @ 12:18:02 (MST)

Note: This script is still under development and will most likely soon support custom flags to define variables that are presently hard-coded, such as $tags.

There are many ways to upload your Flickr photo album from perfectly well-crafted GUI Clients such as Flickr-Uploadr, but not everyone likes GUI clients.

In my quest for a more autonomous way of dealing with my Flickr Uploads, which is usually a batch-process (i.e. possibly dozens of photos at a time), I've decided to automate this process by using a command-line script that can be run via cron (at some scheduled interval), and upload any images found in my image 'pool'.

This allows me to dedicate a specific directory on my machine, for outgoing uploads to Flickr. I can then copy or symlink the files that I want uploaded, and rest assured that they will be uploaded and cleaned-up from the directory pool, autonomously via perl/cron.

up2flickr.pl

#!/usr/bin/env perl
#
# up2flickr.pl
#
# Sean O'Donnell <sean@seanodonnell.com>
#

use strict;
use Flickr::Upload;

# your perl application name
my $app_title = "Flickr::Upload::SOD/1.0";

# flickr api authentication credentials
my $auth_key = '???';
my $auth_secret = '???';

# this will require application authorization to obtain a proper token. 
# Use the 'flickr_auth_token.pl' script.
my $auth_token = '???';

# directory path of files to upload
my $dir = "/photolib/eos/pool";

# optional tags
my $tags = "";

#
# We assume friends and family are OK, but you can
# define public-view permissions here.
#
# 0 = private;
# 1 = public;
#
my $public = 1;

my $ua = Flickr::Upload->new({ 'key' => $auth_key, 'secret' => $auth_secret});

$ua->agent($app_title);

upload_folder($dir,$tags,$public);

sub upload_folder($$$)
{       
        my ($dir,$tags,$public) = @_;

        if (-d $dir)
        {       
                print "\n$app_title\nUploading files from the specified directory ($dir)\n\n";
                                                                                                                                   
                opendir(DIR, $dir) || die "Cannot opendir ". $dir .":". $!;                                                        

                my $x=0;

                foreach my $image (sort readdir(DIR))
                {
                        if ($image ne "." && $image ne "..")
                        {
                                my $file = $dir ."/". $image;

                                print "Uploading: ". $image ." to Flickr...";

                                $ua->upload(
                                        'photo' => $file,
                                        'auth_token' => $auth_token,
                                        'tags' => $tags,
                                        'is_public' => $public,
                                        'is_friend' => 1,
                                        'is_family' => 1

                                ) or die "Failed to upload file (".$file.")\n";

                                print "Done!\n";

                                rm($file);

                                $x++;
                        }
                }

                close(DIR);

                print "A total of ($x) photos from $dir have been successfully uploaded and removed. Your next batch awaits.\n";
        }

        return;
}

sub rm($)
{
        my $file = shift;

        if (-e $file)
        {
                print "Removing file ($file) from directory...";
                unlink($file) unless (-d $file);
                print "Done!\n";
        }

        return;
}


Warning: This script will remove the file (or symlink) from your hard drive after it's been uploaded. This is intentional by nature of the 'batch process' approach. This too will soon be flag-able, to prevent unwitting disasters for new unsuspecting users.

In order for this script to work properly, you must first use the following script (below) to obtain a flickr authentication token ($auth_token).

flickr_auth_token.pl

I found this script somewhere on google when I was originally developing my script.

You'll need to run this script (first). Define your API Key and Secret Code in order to receive a Flickr API Authentication Token for the up2flickr.pl script.

#!/usr/bin/env perl

# get an auth_token for use with flickr_upload.
# read about the flickr API here:
# http://www.flickr.com/services/api/
use Flickr::API;
use Flickr::Upload;

# get a flickr API key here:
# http://www.flickr.com/services/api/keys/
my $flickr_key = '???';
my $flickr_secret = '???';

my $ua = Flickr::Upload->new(
{
'key' => $flickr_key,
'secret' => $flickr_secret
});
$ua->agent( "Flickr::Upload::SOD" );

# get a "frob"
my $frob = getFrob( $ua );
print "FROB:$frob;\n";

my $url = $ua->request_auth_url('write', $frob);
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 when finished.\n\n";

<>;

my $auth_token = getToken( $ua, $frob );
die "Failed to get authentication token!" unless defined $auth_token;

print "Token is $auth_token\n";

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 ,
'perms' => 'write'} );
return undef unless defined $res and $res->{success};

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


Once you've successfully run the script above, it will print your auth token. You should then use that auth token value to define the $auth_token variable within the up2flickr.pl script.

This is a painless one-time-only procedure, and from then - on, you can upload at will.