randomfox | Flickr Pool Utilities

1. PoolCommon.pm (shared functions)

#!perl -w
use strict;

package PoolCommon;
use base 'Exporter';
use XML::Simple;
use LWP::UserAgent;
use Time::HiRes qw(usleep);
use FileHandle;

our @EXPORT = qw(FlickrRetry GenPhotoList GetViews OpenLog);

# Query Flickr with retry.
sub FlickrRetry {
    my $api = shift;
    my $method = shift;
    my $param = shift;

    my $retry_count = 0;
    my $response;
    do {
	$response = $api->execute_method($method, $param);
	usleep 250000;
    } while $retry_count++ < 5 and not $response->{success};
    $response;
}

# Generate a list of photos from the Flickr query response.
sub GenPhotoList {
    my $response = shift;

    my $xmlp = new XML::Simple;
    my $xm = $xmlp->XMLin($response->{_content}, forcearray=>['photo']);

    my $photos = $xm->{photos};
    print "Page $photos->{page} of $photos->{pages}...\n";

    my $photolist = $photos->{photo};
    my @photoarr;

    for my $id (keys %{$photolist}) {
	my $photo = $photolist->{$id};
	$photo->{id} = $id;
	$photo->{url} = "http://www.flickr.com/photos/$photo->{owner}/$photo->{id}";
	push @photoarr, $photo;
    }
    ( $photos->{pages}, \@photoarr );
}

# HTTP query with retry.
sub AgentRetry {
    my $agent = shift;
    my $url = shift;
    my $retry_count = 0;
    my $response;
    do {
	$response = $agent->get($url);
	usleep 250000;
    } while $retry_count++ < 5 and $response->is_error;
    $response;
}

# Get view counts of the photos.
sub GetViews {
    my $photolist = shift;

    my $agent = new LWP::UserAgent;
    $agent->parse_head(0);

    my $i = 0;
    for my $photo (@$photolist) {
	++$i;
	print "Getting photo $i of @{[scalar(@$photolist)]}...\n";

	my $response = AgentRetry($agent, $photo->{url});
	if ($response->is_error) {
	    warn $response->status_line, "\n";
	    next;
	}

	my $resp = $response->content;
	if ($resp =~ /<li class="Stats">\s*Viewed <b>(\d+)<\/b> times\s*<\/li>/) {
	    $photo->{views} = $1;
	}
    }
}

# Open log file.
sub OpenLog {
    my $prefix = shift;
    my $logfn = sprintf("$prefix%X.htm", time);
    my $fh = new FileHandle $logfn, "w";
    defined $fh or die "Error opening $logfn for writing: $!\n";
    $fh->autoflush(1);
    $fh;
}

1;

__END__

2. ApiKey.pm template (fill in with your Flickr API key and related information)

#!perl -w
use strict;

package ApiKey;
use base 'Exporter';
our @EXPORT = qw($api_key $shared_secret $auth_token $myid);

our $api_key = "";
our $shared_secret = "";
our $auth_token = "";
our $myid = '';

1;

__END__

3. pool.pl (Group pool cleaning script)

#!perl -w
use strict;

# Views group cleaning script.

use Flickr::API;
use Encode;
use Getopt::Long;

# Define $api_key, $shared_secret, and $auth_token in apikey.pm
use ApiKey;

use PoolCommon;

my %groups = (
    25 => {
	name => "1-25 Views",
	id => '66969363@N00',
	lbound => 0,
	ubound => 25
    },
    50 => {
	name => "25-50 Views",
	id => '55265535@N00',
	lbound => 25,
	ubound => 50
    },
    75 => {
	name => "50-75 Views",
	id => '38541060@N00',
	lbound => 50,
	ubound => 75
    },
    100 => {
	name => "75-100 Views",
	id => '45499242@N00',
	lbound => 75,
	ubound => 100
    });

# Get a list of photos in the group.
sub getphotos {
    my $groupid = shift;
    my $pagenum = shift;
    my $pagelen = shift;

    my $api = new Flickr::API({'key' => $api_key, secret => $shared_secret});

    my $response = FlickrRetry($api, "flickr.groups.pools.getPhotos",
	{
	    group_id => $groupid,
	    per_page => $pagelen,
	    page => $pagenum,
	    auth_token => $auth_token
	});
    die "Error: $response->{error_message}\n" unless $response->{success};

    GenPhotoList($response);
}

# Remove photos that don't belong from the group.
sub rejectphotos {
    my $logfh = shift;
    my $groupid = shift;
    my $photolist = shift;
    my $lowerbound = shift;
    my $upperbound = shift;
    my $testmode = shift;

    my $api = new Flickr::API({'key' => $api_key, secret => $shared_secret});

    $testmode and print "Test mode. Photos will not be removed.\n";

    my $i = 0;
    for my $photo (@$photolist) {
	defined $photo->{views} or next;
	if ($photo->{views} < $lowerbound or $photo->{views} > $upperbound) {

	    # Need to encode because there could be wide characters.
	    my $title = encode("iso-8859-1", $photo->{title});
	    my $ownername = encode("iso-8859-1", $photo->{ownername});

	    ++$i;
	    print $logfh <<EOM;
$i. <a href="$photo->{url}">$photo->{id}</a>: $title by $ownername, <b>$photo->{views}</b> views<br>
EOM

	    print "$i. Rejecting photo $photo->{id}...\n";

	    next if $testmode;

	    my $response = FlickrRetry($api, "flickr.groups.pools.remove",
		{
		    group_id => $groupid,
		    photo_id => $photo->{id},
		    auth_token => $auth_token
		});
	    $response->{success} or 
		print "Error rejecting photo $photo->{id}: $response->{error_message}\n";
	}
    }
}

# Process one page in the group.
sub processpage {
    my $pagenum = shift;
    my $pagelen = shift;
    my $group = shift;
    my $testmode = shift;

    my ($totalpages, $photolist) = getphotos($group->{id}, $pagenum, $pagelen);
    GetViews($photolist);

    my $logfh = OpenLog("p");
    print $logfh <<EOM;
<html>
<head>
<title>Rejected photos from $group->{name}: Page $pagenum of $totalpages</title>
</head>
<body>
<h1>Rejected photos from $group->{name}: Page $pagenum of $totalpages</h1>
EOM

    rejectphotos($logfh, $group->{id}, $photolist, 
	$group->{lbound}, $group->{ubound}, $testmode);

    print $logfh <<EOM;
</body>
</html>
EOM

    $logfh->close;
}

sub usage {
    print <<EOM;
pool.pl [-test] [-pagelen=n] [-group=n] pagenum

-test: Test mode. Don't remove photos from pool.

-pagelen=n: 
	Set the page length to n. 
	n must be at least 1. 
	Default n is 100.

-group=n:
	Specify the group to scan. 
	n=25: 1-25 views group.
	n=50: 25-50 views group.
	n=75: 50-75 views group.
	n=100: 75-100 views group.
	Default n is 100.

pagenum:
	Page # to scan. 
	First page is 1.
	Default is the first page.
EOM
    exit 1;
}

my $groupkey = 100;
my $pagelen = 100;
my $test = '';
Getopt::Long::Configure("bundling_override");
GetOptions('test' => \$test, 
    'pagelen=s' => \$pagelen, 
    'group=s' => 
    sub {
	my $optname = shift;
	my $optval = shift;
	defined $groups{$optval} or die "Invalid group $optval\n";
	$groupkey = $optval;
    }) or usage();
die "Page length must be at least 1\n" if $pagelen < 1;

my $group = $groups{$groupkey};

my $pagenum = shift;
defined $pagenum or $pagenum = 1;

processpage($pagenum, $pagelen, $group, $test);

__END__

4. self.pl (Group suggestions for photos in photostream)

#!perl -w
use strict;

# Scans my photostream to check for photos that haven't been placed into
# their correct views groups.

use Flickr::API;
use XML::Simple;
use Encode;
use Getopt::Long;

# Define $api_key and $myid in apikey.pm
use ApiKey;

use PoolCommon;

my @groups = (
    {
	name => "1-25 Views",
	id => '66969363@N00',
	lbound => 1,
	ubound => 24
    },
    {
	name => "25-50 Views",
	id => '55265535@N00',
	lbound => 25,
	ubound => 49
    },
    {
	name => "50-75 Views",
	id => '38541060@N00',
	lbound => 50,
	ubound => 74
    },
    {
	name => "75-100 Views",
	id => '45499242@N00',
	lbound => 75,
	ubound => 99
    },
    {
	name => "Centurian Club",
	id => '38475367@N00',
	lbound => 100,
	ubound => 200
    }
);

# Get a list of photos in the photostream.
sub getphotos {
    my $userid = shift;
    my $pagenum = shift;
    my $pagelen = shift;

    my $api = new Flickr::API({'key' => $api_key});

    my $response = FlickrRetry($api, "flickr.people.getPublicPhotos",
	{
	    user_id => $userid,
	    per_page => $pagelen,
	    page => $pagenum
	});
    die "Error: $response->{error_message}\n" unless $response->{success};

    GenPhotoList($response);
}

# Check the list of photos against one group.
sub checkgroup {
    my $logfh = shift;
    my $photolist = shift;
    my $counter = shift;
    my $lbound = shift;
    my $ubound = shift;
    my $groupid = shift;

    my $i = 0;
    my $nphotos = scalar(@$photolist);

    my $api = new Flickr::API({'key' => $api_key});

    for my $photo (@$photolist) {
	defined $photo->{views} or next;
	if ($photo->{views} >= $lbound and
	    $photo->{views} <= $ubound) {

	    ++$$counter;
	    print "Checking photo $$counter of $nphotos...\n";

	    my $response = FlickrRetry($api, "flickr.photos.getAllContexts",
		{ photo_id => $photo->{id} });
	    unless ($response->{success}) {
		warn "Error getting groups for photo $photo->{id}: $response->{error_message}\n";
		next;
	    }

	    my $xmlp = new XML::Simple;
	    my $xm = $xmlp->XMLin($response->{_content}, forcearray=>['pool']);

	    my $pool = $xm->{pool};
	    unless (defined $pool->{$groupid}) {
		my $title = encode("iso-8859-1", $photo->{title});
		++$i;
		print $logfh <<EOM;
$i. <a href="$photo->{url}">$photo->{id}</a>: $title, <b>$photo->{views}</b> views<br>
EOM
	    }
	}
    }
}

# Check each photo's views group membership. Report the photos that have
# not been placed into their correct views groups.
sub checkgroups {
    my $logfh = shift;
    my $photolist = shift;

    my $n = 0;
    for my $group (@groups) {
	print $logfh "<h2>Move these to $group->{name}</h2>\n";

	print "Checking group $group->{name}\n";

	checkgroup($logfh, $photolist, \$n,
	    $group->{lbound}, $group->{ubound}, $group->{id});
    }
}

# Process one page in the photostream.
sub processpage {
    my $pagenum = shift;
    my $pagelen = shift;

    my ($totalpages, $photolist) = getphotos($myid, $pagenum, $pagelen);
    GetViews($photolist);

    my $logfh = OpenLog("r");
    print $logfh <<EOM;
<html>
<head>
<title>Page $pagenum of $totalpages</title>
</head>
<body>
<h1>Page $pagenum of $totalpages</h1>
EOM

    checkgroups($logfh, $photolist);

    print $logfh <<EOM;
</body>
</html>
EOM
    $logfh->close;
}

sub usage {
    print <<EOM;
self.pl [-pagelen=n] pagenum

-pagelen=n: 
	Set the page length to n. 
	n must be at least 1. 
	Default n is 100.

pagenum:
	Page # to scan. 
	First page is 1.
	Default is the first page.
EOM
    exit 1;
}

my $pagelen = 100;
Getopt::Long::Configure("bundling_override");
GetOptions('pagelen=s' => \$pagelen) or usage();
die "Page length must be at least 1\n" if $pagelen < 1;

my $pagenum = shift;
defined $pagenum or $pagenum = 1;

processpage($pagenum, $pagelen);

__END__

5. proself.pl (Groups and sorts output from self.pl)

#!perl -w
use strict;

use FileHandle;
use File::DosGlob;

sub glob_args {
    map { File::DosGlob::glob $_ } @_;
}

sub write_file {
    my ($fname, $lbound, $ubound, $allviews) = @_;

    my $fh = new FileHandle $fname, "w";
    defined $fh or die "Can't open $fname for writing: $!\n";

    my $lineno = 0;

    for (grep {$_->{views}>=$lbound and $_->{views}<=$ubound} @$allviews) {
	++$lineno;
	local $_ = $_->{line};
	s/^\d+\./$lineno./;
	print $fh $_;
    }

    close $fh;
}

@ARGV = glob_args @ARGV;

my @allviews;

while (<>) {
    /<b>(\d+)<\/b> views/ or next;
    push @allviews, { views=>$1, line=>$_ };
}

@allviews = sort { $a->{views} <=> $b->{views} } @allviews;

write_file "1to25.htm", 1, 24, \@allviews;
write_file "25to50.htm", 25, 49, \@allviews;
write_file "50to75.htm", 50, 74, \@allviews;
write_file "75to100.htm", 75, 99, \@allviews;
write_file "centurian.htm", 100, 199, \@allviews;

__END__