Upload file | Upload file with metadata | Create album | List albums @ picasaweb via API

picasaweb2.pl

#!/usr/bin/perl
#
# *** Upload file | Upload file with metadata | Create album | List albums @ picasaweb via API ***
#
# Examples of usage
# Note: if option --printonly is present NO real action is performed
# ONLY http message is verbatim printed on STDOUT (useful in case of problems)
# -----------------
# Upload with metadata:
# picasaweb.pl -xload -title Komorowski -descr 'Komorowski w czapce' -keywords 'komorowski,prezydent' -file BK_w_czapce.jpg -album 12345
# Upload w/o metadata:
# picasaweb.pl -upload -file BK_w_czapce.jpg -album 12345
# Create album:
# picasaweb.pl -create -title Koty -descr 'Zdjęcia kotów' -keywords 'kot,cat,gato'
# List albums:
# picasaweb.pl -list
#
use strict;
use LWP::UserAgent;
use Getopt::Long;
use File::MimeInfo;
use XML::LibXML;

my $profileID="default";

### DEFAULT Album Id ##################
### Misc Stuff ###
### my $AlbumId ="5814486831826593553";
### Misc Stuff 2 ###
### my $AlbumId ="6063067742713120609";
### Misc Stuff 3 ###
## my $AlbumId ="6118749723887405297";
### Misc Stuff 4 ###
my $AlbumId ="6170354040646469009";
### ### ### ### ### ### #### ### ### ### ### ###

my $Action = 'u'; ## x| u | c | l (default action is Upload)
my $entryTitle = ''; my $entryDescription = ''; my $entryKeywords = '';
my $ActionUpload =''; my $ActionList = ''; my $ActionCreate = ''; my $ActionXload = '';
my $ImageFile = '';
my $dummyReq='';

GetOptions("xload" => \$ActionXload, "upload" => \$ActionUpload, "list" => \$ActionList, "create" => \$ActionCreate,
	   "title=s" => \$entryTitle, "description=s" => \$entryDescription, "keywords=s" => \$entryKeywords,
	   "file=s" => \$ImageFile,
	   "album=s" => \$AlbumId, ## UploadFile to Album
	   "printonly" => \$dummyReq, ) ;

## Determine action and check arguments:
if ( $ActionUpload ) {$Action = 'u'} elsif ( $ActionList ) { $Action = 'l'}
elsif ( $ActionCreate ) { $Action = 'c'}
elsif ( $ActionXload ) { $Action = 'x'}

if ( $Action eq 'x' && ($entryTitle eq '' || (! -e $ImageFile ))) { 
   print STDERR "*** USAGE: $0 -xload -title Tytuł -descr Opis -keywords Keywords -file Plik [-album AlbumId]\n" ; exit; }
if ( $Action eq 'c' && $entryTitle eq '' ) {
   print STDERR "*** USAGE: $0 -create -title Tytuł -descr Opis -keywords Keywords\n" ; exit; }
if ( $Action eq 'u' && (! -e $ImageFile )) {
   print STDERR "*** USAGE: $0 -upload -file Plik [-album AlbumId]\n" ; 
   print STDERR "*** USAGE: $0 -create -title Tytuł -descr Opis -keywords Keywords\n" ;
   print STDERR "*** USAGE: $0 -list\n" ; exit; 
 }

### Authenticate with external script (oauth2picasa.py):
my $ACCESS_TOKEN=`oauth2picasa.py`;
chomp($ACCESS_TOKEN);
print STDERR "*** AccessToken: $ACCESS_TOKEN [AlbumId: $AlbumId]\n";

my $req ; my $blog_entry ;

my $picasawebURL = "https://picasaweb.google.com/data/feed/api/user/$profileID";

if ( $Action eq 'c' ) {## Action: create album
  $req = HTTP::Request->new(POST => $picasawebURL );
  $req->header( 'Content-Type' => 'application/atom+xml' );

  $blog_entry = "<entry xmlns='http://www.w3.org/2005/Atom'
     xmlns:media='http://search.yahoo.com/mrss/'
     xmlns:gphoto='http://schemas.google.com/photos/2007'>"
  . "<title type='text'>$entryTitle</title>"
  . "<summary type='text'>$entryDescription</summary>"
  . "<media:group><media:keywords>$entryKeywords</media:keywords></media:group>"
  . "<category scheme='http://schemas.google.com/g/2005#kind'
    term='http://schemas.google.com/photos/2007#album'></category></entry>";

  $req->content($blog_entry);
} 
elsif ( $Action eq 'l' ) {## Action: list albums
  $req = HTTP::Request->new(GET => $picasawebURL );

} 
elsif ( $Action eq 'u' ) {## Action: Upload 1 photo
  my $mimeType = mimetype($ImageFile);

  ## https://developers.google.com/picasa-web/docs/2.0/developers_guide_protocol
  ## 
  $req = HTTP::Request->new(POST => "$picasawebURL/albumid/$AlbumId" );
  $req->header( 'Content-Type' => "$mimeType" );
  ##$req->header( 'Content-Length' => $imageLength ); ## pakiet liczy sam
  $req->header( 'Slug' => "$ImageFile" );

  ## http://www.perlmonks.org/?node_id=131584
  open(FILE, $ImageFile);
  $req->content(join('',<FILE>));
  close(FILE);
}
###
elsif ( $Action eq 'x' ) {## Action: Upload 1 photo with metadata
  # https://groups.google.com/forum/#!topic/google-picasa-data-api/2qRfP0EIFhk
  my $mimeType = mimetype($ImageFile);

  ## https://developers.google.com/picasa-web/docs/2.0/developers_guide_protocol
  $req = HTTP::Request->new(POST => "$picasawebURL/albumid/$AlbumId" );
  $req->header( 'Content-Type' => "multipart/related" );

  open(FILE, $ImageFile);

  my $add_photo_metadata = "<entry xmlns='http://www.w3.org/2005/Atom' xmlns:media='http://search.yahoo.com/mrss/'>"
  . "<title type='text'>$entryTitle</title>"
  . "<summary type='text'>$entryDescription</summary>"
  . "<media:group><media:keywords>$entryKeywords</media:keywords></media:group>"
  . "<category scheme='http://schemas.google.com/g/2005#kind' term='http://schemas.google.com/photos/2007#photo'></category></entry>";

  my $add_photo_data = join('',<FILE>);
  close(FILE);

  ## http://www.perlmonks.org/?node_id=131584
  $req->add_part(HTTP::Message->new(['Content-Type' => 'application/atom+xml'], $add_photo_metadata));
  $req->add_part(HTTP::Message->new(['Content-Type' => "$mimeType"], $add_photo_data));

}

$req->header( 'Authorization' => "Bearer $ACCESS_TOKEN" );
$req->header( 'GData-Version' => '2' );

## ### ###
my $res ;
my $ua = LWP::UserAgent->new;

if ($dummyReq) {
  # Print message verbatim in case of problems 
  # http://www.perlmonks.org/bare/?node_id=464442
  $ua->prepare_request($req); print($req->as_string); my $res; exit;
}
else {
  $res = $ua->request($req);
}

if ($res->is_success) {
     my $decoded_response = $res->decoded_content;  # or whatever

     my $parser = XML::LibXML->new();
     my $doc ;  eval { $doc    = $parser->parse_string($decoded_response) };
     if ($@) { print STDERR "*** Error parsing XML $decoded_response\n"; next ;}

     if ( $Action eq 'u' || $Action eq 'x') {

       my $xpc = XML::LibXML::XPathContext->new( $doc->documentElement() );
       ## http://stackoverflow.com/questions/4083550/why-does-xmllibxml-find-no-nodes-for-this-xpath-query-when-using-a-namespace
       $xpc->registerNs( 'media', 'http://search.yahoo.com/mrss/');

       foreach my $node ( $xpc->findnodes('//media:title') ) { print "Title: " . $node->textContent() . " (uploaded)\n"; }
       foreach my $node ( $xpc->findnodes('(//media:content|//media:thumbnail)') ) { 
          print "Url: " . $node->getAttribute('url') . "\n"; }
     }
     elsif ( $Action eq 'l' ) {### ListAlbums
       ##use open ':std', ':encoding(UTF-8)'; ### Ew problem z inną akcję niż list??
       ##print "*** OK *** $decoded_response\n";

       my $xpc = XML::LibXML::XPathContext->new( $doc->documentElement() );
       $xpc->registerNs( 'dfl', 'http://www.w3.org/2005/Atom');

       print "******* WARNING: Only meaningfull titles are listed: *********\n";

       foreach my $node ( $xpc->findnodes('//dfl:entry') ) {
          my $xpe = XML::LibXML::XPathContext->new( $node );
          $xpe->registerNs( 'dfl', 'http://www.w3.org/2005/Atom');

          my $title = ($xpe->findnodes('./dfl:title'))[0]->textContent();

          if ($title =~ /[^0-9\-\.]/ ) {
           print ">> Album title: $title ## ";

           foreach my $entry ( $xpe->findnodes('dfl:link') ) {
              if ($entry->getAttribute('rel') eq 'self') { print $entry->getAttribute('href') . "\n"; }
         } }
       }
     #############
     }
     else {
       print "*** OK *** $decoded_response\n";
     }
}
else { die $res->status_line; }

## // koniec //