File Coverage

blib/lib/Net/Flickr/Simile/Exhibit.pm

Criterion	Covered	Total	%
statement	6	6	100.0
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	8	8	100.0

# $Id: Exhibit.pm,v 1.7 2007/09/03 05:30:37 asc Exp $

use strict;

package Net::Flickr::Simile::Exhibit;
use base qw (Net::Flickr::Simile);

$Net::Flickr::Simile::Exhibit::VERSION = '0.1';

=head1 NAME

Net::Flickr::Simile::Exhbit - OOP for generating Simile Exhibit files using the Flickr API

=head1 SYNOPSIS

 use Getopt::Std;
 use Config::Simple;
 use Net::Flickr::Simile::Exhibit;

 my %opts = ();
 getopts('c:j:h:t:', \%opts);

 my $cfg = Config::Simple->new($opts{'c'});

 my %args = ('exhibit_json' => $opts{'j'},
             'exhibit_html' => $opts{'h'},
             'tags' => $opts{'t'});

 my $fl = Net::Flickr::Simile::Exhibit->new($cfg);
 $fl->search(\%args);

 # So then you might do :
 # perl ./myscript -c /my/flickr.cfg -h ./mystuff.html -j ./mystuff.js -t kittens

=head1 DESCRIPTION

OOP for generating Simile Exhibit files using the Flickr API.

=head1 OPTIONS

Options are passed to Net::Flickr::Backup using a Config::Simple object or
a valid Config::Simple config file. Options are grouped by "block".

=head2 flick

=over 4

=item * B

String. I

A valid Flickr API key.

=item * B

String. I

A valid Flickr Auth API secret key.

=item * B

String. I

A valid Flickr Auth API token.

=item * B

String. I

The B defines which XML/XPath handler to use to process API responses.

=over 4

=item * B

Use XML::LibXML.

=item * B

Use XML::XPath.

=back

=back

=head2 reporting

=over

=item * B

Boolean.

Default is false.

=item * B

String.

The default handler is B, as in C

=item * B

For example, the following :

 reporting_handler_args=name:foobar;min_level=info

Would be converted as :

 (name      => "foobar",
  min_level => "info");

The default B argument is "__report". The default B argument
is "info".

=back

=cut

use JSON::Any;
use IO::AtomicFile;
use File::Basename;

=head1 PACKAGE METHODS

=cut

=head2 __PACKAGE__->new($cfg)

Where B<$cfg> is either a valid I object or the path
to a file that can be parsed by I.

Returns a I object.

=cut

=head1 OBJECT METHODS YOU SHOULD CARE ABOUT

Net::Flickr::Simile::Exhibit subclasses Net::Flickr::Simile and Net::Flickr::API so
all of those methods are available to your object. The following methods are also
defined.

=cut

=head2 $obj->getRecentPhotos(\%args)

Valid arguments are anything you would (need to) pass to the I
API method and :

=over 4

=item * B

String. I

The path where Exhbit JSON data should be written to disk.

=item * B

String. I

The path where Exhbit HTML data should be written to disk. It will contain
a relative pointer to I.

=back

The user_id bound to the Flickr Auth token defined in the object's config file
will automatically be added to the method arguments and used to scope the query.

Returns true or false.

=cut

sub getRecentPhotos {
        my $self = shift;
        my $args = shift;
        $args ||= {};

        my $nsid = $self->get_auth_nsid()
                || return 0;

        $args->{'user_id'} = $nsid;

        use Data::Dumper;
        print Dumper($args);

        return $self->search($args);
}

=head2 $obj->search(\%args)

Valid arguments are anything you would (need to) pass to the I
API method and :

=over 4

=item * B

String. I

The path where Exhbit JSON data should be written to disk.

=item * B

String. I

The path where Exhbit HTML data should be written to disk. It will contain
a relative pointer to I.

=back

Returns true or false.

=cut

sub search {
        my $self = shift;
        my $args = shift;
        $args ||= {};

        my $paths = $self->_output_paths($args)
                || return 0;

        my $rsp = $self->api_call({'method' => 'flickr.photos.search',
                                 'args' => $args});

        return $self->writeExhibitFiles($paths, $rsp);
}

=head2 $obj->getContactsPhotos(\%args)

Valid arguments are anything you would (need to) pass to the I
API method and :

=over 4

=item * B

String. I

The path where Exhbit JSON data should be written to disk.

=item * B

String. I

The path where Exhbit HTML data should be written to disk. It will contain
a relative pointer to I.

=back

Returns true or false.

=cut

sub getContactsPhotos {
        my $self = shift;
        my $args = shift;
        $args ||= {};

        my $paths = $self->_output_paths($args)
                || return 0;

        my $rsp = $self->api_call({'method' => 'flickr.photos.getContactsPhotos',
                                 'args' => $args});

        return $self->writeExhibitFiles($paths, $rsp);
}

=head2 $obj->getContactsPublicPhotos(\%args)

Valid arguments are anything you would (need to) pass to the I
API method and :

=over 4

=item * B

String. I

The path where Exhbit JSON data should be written to disk.

=item * B

String. I

The path where Exhbit HTML data should be written to disk. It will contain
a relative pointer to I.

=back

Returns true or false.

=cut

sub getContactsPublicPhotos {
        my $self = shift;
        my $args = shift;
        $args ||= {};

        my $paths = $self->_output_paths($args)
                || return 0;

        my $rsp = $self->api_call({'method' => 'flickr.photos.getContactsPublicPhotos',
                                 'args' => $args});

        return $self->writeExhibitFiles($paths, $rsp);
}

=head1 OBJECT METHODS YOU MAY CARE ABOUT

=cut

=head2 $obj->rspToExhibitJson($rsp)

Where I<$rsp> is the return value of a call to Iapi_call>.

Returns a JSON string representing the data in I<$rsp> suitable for including with
a Simile Exhibit document.

=cut

sub rspToExhibitJson {
        my $self = shift;
        my $rsp = shift;

        my %data = (
                    'items' => [],
                   );

        foreach my $ph ($rsp->findnodes("/rsp/photos/photo")){


                my $res = $self->api_call({'method' => 'flickr.photos.getInfo',
                                           'args' => {'photo_id' => $ph->getAttribute('id')}});

                if (! $res) {
                        next;
                }

                my $thumb = sprintf("http://farm%s.static.flickr.com/%s/%s_%s_t.jpg",
                                    $ph->getAttribute("farm"), $ph->getAttribute("server"),
                                    $ph->getAttribute("id"), $ph->getAttribute("secret"));

                my $taken = $res->findvalue("/rsp/photo/dates/\@taken");
                $taken =~ s/\:\s{2}\:\d{2}//;

                my %info = (
                            'imageURL' => $thumb,
                            'label' => $res->findvalue("/rsp/photo/title"),
                            'description' => $res->findvalue("/rsp/photo/description"),
                            'date' => $taken,
                            'owner' => $res->findvalue("/rsp/photo/owner/\@username"),
                            'photoURL' => $res->findvalue("/rsp/photo/urls/url[\@type='photopage']"),
                           );

                foreach my $t ($res->findnodes("/rsp/photo/tags/tag")){
                        $info{'tags'} ||= [];

                        my $raw = $t->getAttribute("raw");

                        if ($t->getAttribute("machine_tag")){

                                $info{'namespaces'} ||= [];
                                $info{'predicates'} ||= [];
                                $info{'values'} ||= [];

                                if ($raw =~ /^([a-z](?:[a-z0-9_]+))\:([a-z](?:[a-z0-9_]+))=(.*)/){

                                        my $ns = $1;
                                        my $pred = $2;
                                        my $value = $3;

                                        push @{$info{'namespaces'}}, $ns;
                                        push @{$info{'predicates'}}, $pred;
                                        push @{$info{'values'}}, $value;
                                        push @{$info{'tags'}}, $value;
                                }
                        }

                        else {
                                push @{$info{'tags'}}, $raw;
                        }
                }

                if (my $geo = ($res->findnodes("/rsp/photo/location"))[0]){

                        foreach my $pl ("locality", "region", "country"){
                                $info{'places'} ||= [];

                                if (my $label = $geo->findvalue($pl)){
                                        push @{$info{'places'}}, $label;
                                }
                        }

                        my %coords = ('id' => $info{'label'});
                        $coords{'addressLatLng'} = join(",", $geo->getAttribute("latitude"), $geo->getAttribute("longitude"));
                        push @{$data{'items'}}, \%coords;
                }

                # use Data::Dumper;
                # print STDERR Dumper(\%info);

                push @{$data{'items'}}, \%info;
        }

        my $json = JSON::Any->new();
        return $json->objToJson(\%data);
}

=head2 $obj->writeExhbitFiles(\%paths, $rsp)

Returns true or false.

=cut

sub writeExhibitFiles {
        my $self = shift;
        my $paths = shift;
        my $rsp = shift;

        if (! $rsp){
                $self->log()->error("Not a valid response; can not write Exhibit files");
                return 0;
        }

        my $src_json = basename($paths->{'exhibit_json'});

        if (! $self->writeExhibitJson($paths->{'exhibit_json'}, $rsp)){
                return 0;
        }

        if (! $self->writeExhibitHtml($paths->{'exhibit_html'}, $src_json)){
                return 0;
        }

        return 1;
}

=head2 $obj->writeExhibitJson($path, $rsp)

Returns true or false

=cut

sub writeExhibitJson {
        my $self = shift;
        my $path = shift;
        my $rsp = shift;

        my $fh_json = IO::AtomicFile->open($path, "w");

        if (! $fh_json){
                $self->log()->error("Failed to open '$path' for writing, $!");
                return 0;
        }

        $fh_json->print($self->rspToExhibitJson($rsp));
        $fh_json->close();

        return 1;
}

=head2 $obj->writeExhibitHtml($path, $rsp)

Returns true or false

=cut

sub writeExhibitHtml {
        my $self = shift;
        my $path = shift;
        my $src = shift;

        my $html = $self->readExhibitHtml();
        $html =~ s/USER_JSON_DATA/$src/m;

        my $fh_html = IO::AtomicFile->open($path, "w");

        if (! $fh_html){
                $self->log()->error("Failed to open '$path' for writing, $!");
                return 0;
        }

        $fh_html->print($html);
        $fh_html->close();
        return 1;
}

sub readExhibitHtml {
        my $self = shift;

        my $html = undef;

        {
                local $/;
                undef $/;
                $html = ;
        }

        return $html;
}

sub _output_paths {
        my $self = shift;
        my $args = shift;

        my %paths = ();

        foreach my $which ("exhibit_json", "exhibit_html"){

                if (! exists($args->{$which})){
                        return undef;
                }

                $paths{$which} = $args->{$which};
                delete($args->{$which});
        }

        return \%paths;
}


=head1 VERSION

0.1

=head1 AUTHOR

Aaron Straup Cope <[e-mail]>

=head1 NOTES

=over 4

=item * B

Basically anything that returns a "standard photo response" (or /rsp/photos/photo)
from the Flickr API can be used with this package to generate Exhibit data.

As this time, however, only a handful of (API) methods have (Perl) helper methods.
There will be others.

=item * B

This package does not know how to account for pagination in the Flickr API.
That may change over time.

=item * B

This package contains a bare-bones template for generating an HTML file to
view your Exhibit data.

You may need to tweak the output after the fact or you can subclass the
I method.

=back

=head1 EXAMPLES

L

L

=head1 SEE ALSO

L

L

=head1 BUGS

Please report all bugs via http://rt.cpan.org/

=head1 LICENSE

Copyright (c) 2007 Aaron Straup Cope. All Rights Reserved.

This is free software. You may redistribute it and/or
modify it under the same terms as Perl itself.

=cut

return 1;

__DATA__