Net-DPAP-Client-0.26/0000755000175100001440000000000010510013706014203 5ustar acmeusers00000000000000Net-DPAP-Client-0.26/lib/0000755000175100001440000000000010510013706014751 5ustar acmeusers00000000000000Net-DPAP-Client-0.26/lib/Net/0000755000175100001440000000000010510013706015477 5ustar acmeusers00000000000000Net-DPAP-Client-0.26/lib/Net/DPAP/0000755000175100001440000000000010510013706016223 5ustar acmeusers00000000000000Net-DPAP-Client-0.26/lib/Net/DPAP/Client.pm0000644000175100001440000001555510510013706020012 0ustar acmeusers00000000000000package Net::DPAP::Client; use strict; use warnings; use Carp::Assert; use Net::DAAP::DMAP qw(:all); use Net::DPAP::Client::Album; use Net::DPAP::Client::Image; use LWP::UserAgent; use URI; use base qw(Class::Accessor::Fast); our $VERSION = '0.26'; __PACKAGE__->mk_accessors(qw(hostname port ua server databases_count item_name login_required dmap_protocol_version dpap_protocol_version session_id containers)); sub new { my $class = shift; my $self = {}; bless $self, $class; $self->port(8770); # Let's look like an iPhoto client my $ua = LWP::UserAgent->new(keep_alive => 1); $ua->agent('iPhoto/4.01 (Macintosh; PPC)'); $ua->default_headers->push_header('Client-DMAP-Version', '1.0'); $ua->default_headers->push_header('Client-DPAP-Version', '1.0'); $self->ua($ua); return $self; } sub connect { my $self = shift; # Get server info my $response = $self->_do_get("server-info"); $self->server($response->header('DPAP-Server')); assert($response->header('Content-Type') eq 'application/x-dmap-tagged'); my $dmap = dmap_unpack($response->content); assert($dmap->[0]->[0] eq 'dmap.serverinforesponse'); foreach my $tuple (@{$dmap->[0]->[1]}) { my $key = $tuple->[0]; my $value = $tuple->[1]; assert($value == 200) if $key eq 'dmap.status'; $self->item_name($value) if $key eq 'dmap.itemname'; $self->databases_count($value) if $key eq 'dmap.databasescount'; $self->login_required($value) if $key eq 'dmap.loginrequired'; $self->dmap_protocol_version($value) if $key eq 'dmap.protocolversion'; $self->dpap_protocol_version($value) if $key eq 'dpap.protocolversion'; } # Login (get session id) $response = $self->_do_get("login"); $dmap = dmap_unpack($response->content); assert($dmap->[0]->[0] eq 'dmap.loginresponse'); foreach my $tuple (@{$dmap->[0]->[1]}) { my $key = $tuple->[0]; my $value = $tuple->[1]; assert($value == 200) if $key eq 'dmap.status'; $self->session_id($value) if $key eq 'dmap.sessionid'; } # See how many containers there are $response = $self->_do_get("databases"); $dmap = dmap_unpack($response->content); assert($dmap->[0]->[0] eq 'daap.serverdatabases'); foreach my $tuple (@{$dmap->[0]->[1]}) { my $key = $tuple->[0]; my $value = $tuple->[1]; assert($value == 200) if $key eq 'dmap.status'; next unless $key eq 'dmap.listing'; foreach my $subtuple (@{$value->[0]->[1]}) { my $subkey = $subtuple->[0]; my $subvalue = $subtuple->[1]; $self->containers($subvalue) if $subkey eq 'dmap.containercount'; } } # Get album info my @albums; $response = $self->_do_get("databases/1/containers"); $dmap = dmap_unpack($response->content); assert($dmap->[0]->[0] eq 'daap.databaseplaylists'); foreach my $tuple (@{$dmap->[0]->[1]}) { my $key = $tuple->[0]; my $value = $tuple->[1]; assert($value == 200) if $key eq 'dmap.status'; next unless $key eq 'dmap.listing'; foreach my $subtuple (@$value) { assert($subtuple->[0] eq 'dmap.listingitem'); my $album = Net::DPAP::Client::Album->new(); foreach my $subsubtuple (@{$subtuple->[1]}) { my $subsubkey = $subsubtuple->[0]; my $subsubvalue = $subsubtuple->[1]; next unless $subsubkey =~ s/dmap.item//; $album->$subsubkey($subsubvalue); } # Skip the main library # next if $album->name eq 'Photo Library'; push @albums, $album; } } # Get image info for each album foreach my $album (@albums) { my $albumid = $album->id; my @images; $response = $self->_do_get("databases/1/containers/$albumid/items", meta => 'dpap.aspectratio,dpap.imagefilesize,dpap.creationdate', type => 'photo'); $dmap = dmap_unpack($response->content); assert($dmap->[0]->[0] eq 'daap.playlistsongs'); foreach my $tuple (@{$dmap->[0]->[1]}) { my $key = $tuple->[0]; my $value = $tuple->[1]; assert($value == 200) if $key eq 'dmap.status'; next unless $key eq 'dmap.listing'; foreach my $subtuple (@$value) { assert($subtuple->[0] eq 'dmap.listingitem'); my $image = Net::DPAP::Client::Image->new(); my $ua = $self->ua; $image->ua($ua); foreach my $subsubtuple (@{$subtuple->[1]}) { my $subsubkey = $subsubtuple->[0]; my $subsubvalue = $subsubtuple->[1]; $subsubkey =~ s/^.+\.(item)?//; $image->$subsubkey($subsubvalue); } my $imageid = $image->id; my $thumbnail_url = $self->_construct_uri('databases/1/items', meta => 'dpap.thumb', query => "('dmap.itemid:$imageid')"); $image->thumbnail_url($thumbnail_url); my $hires_url = $self->_construct_uri('databases/1/items', meta => 'dpap.hires', query => "('dmap.itemid:$imageid')"); $image->hires_url($hires_url); push @images, $image; } } $album->images(\@images); } return @albums; } sub _do_get { my $self = shift; my ($path, @form) = @_; my $ua = $self->ua; my $uri = $self->_construct_uri($path, @form); my $response = $ua->get($uri); die "Error when fetching $uri" unless $response->is_success; assert($response->header('Content-Type') eq 'application/x-dmap-tagged'); return $response; } # Using URI module for URI parsing & constructing is more hassle than simply # storing & passing URI components separately sub _construct_uri { my $self = shift; my ($path, @form) = @_; my $host = $self->hostname; my $port = $self->port; my $uri = "http://$host:$port/$path"; my $session_id = $self->session_id; if (defined $session_id) { unshift @form, 'session-id' => $session_id; } if ($#form > 0) { my ($key, $value, @form) = @form; $uri .= "?$key=$value"; while ($#form > 0) { ($key, $value, @form) = @form; $uri .= "&$key=$value"; } } return $uri; } 1; __END__ =head1 NAME Net::DPAP::Client - Connect to iPhoto shares (DPAP) =head1 SYNOPSIS use Net::DPAP::Client; my $client = Net::DPAP::Client->new; $client->hostname($hostname); my @albums = $client->connect; foreach my $album (@albums) { print $album->name, "\n"; foreach my $image (@{$album->images}) { print " ", $image->name, "\n"; my $thumbnail = $image->thumbnail; my $hires = $image->hires; } } =head1 DESCRIPTION This module provides a DPAP client. DPAP is the Digital Photo Access Protocol and is the protocol that Apple iPhoto uses to share photos. This allows you to browse shared albums, and download thumbnail and hires versions of shared photos. It currently doesn't support password-protected shares. =head1 METHODS =head2 new The constructor: my $client = Net::DPAP::Client->new; $client->hostname($hostname); =head2 connect Connect to the hostname: my @albums = $client->connect; =head1 SEE ALSO Net::DPAP::Client::Album, Net::DPAP::Client::Image. =head1 AUTHOR Leon Brocard =head1 COPYRIGHT Copyright (C) 2004-6, Leon Brocard This module is free software; you can redistribute it or modify it under the same terms as Perl itself. Net-DPAP-Client-0.26/lib/Net/DPAP/Client/0000755000175100001440000000000010510013706017441 5ustar acmeusers00000000000000Net-DPAP-Client-0.26/lib/Net/DPAP/Client/Image.pm0000644000175100001440000000416510510013706021027 0ustar acmeusers00000000000000package Net::DPAP::Client::Image; use strict; use warnings; use base qw(Class::Accessor::Fast); use Carp::Assert; use Net::DAAP::DMAP qw(:all); __PACKAGE__->mk_accessors(qw(ua kind id name aspectratio creationdate imagefilename thumbnail_url hires_url)); sub thumbnail { my $self = shift; my $ua = $self->ua; my $url = $self->thumbnail_url; return $self->_decode($ua->get($url)->content); } sub hires { my $self = shift; my $ua = $self->ua; my $url = $self->hires_url; return $self->_decode($ua->get($url)->content); } sub _decode { my $self = shift; my $data = shift; my $dmap = dmap_unpack($data); assert($dmap->[0]->[0] eq 'daap.databasesongs'); foreach my $tuple (@{$dmap->[0]->[1]}) { my $key = $tuple->[0]; my $value = $tuple->[1]; assert($value == 200) if $key eq 'dmap.status'; next unless $key eq 'dmap.listing'; my $list = $value->[0]->[1]; foreach my $subtuple (@$list) { my $subsubkey = $subtuple->[0]; my $subsubvalue = $subtuple->[1]; return $subsubvalue if $subsubkey eq 'dpap.picturedata'; } } } 1; __END__ =head1 NAME Net::DPAP::Client::Image - Remote DPAP image =head1 DESCRIPTION This module represents a remote iPhoto shared image. =head1 METHODS =head2 aspectratio This returns the aspect ratio of the image. =head2 creationdate This returns the creation date of the image as a UNIX timestamp. =head2 id This returns the internal iPhoto ID for the image. You probably don't need to worry about this. =head2 imagefilename This returns the filename of the image. =head2 kind This returns the kind of file of the image. Currently an incomprehensible number. =head2 name This returns the name of the image. =head2 thumbnail_url This returns the URL of the image thumbnail. =head2 thumbnail This returns the thumbnail binary. =head2 hires_url This returns the URL of the image hires. =head2 hires This returns the hires binary. =head1 AUTHOR Leon Brocard =head1 COPYRIGHT Copyright (C) 2004-6, Leon Brocard This module is free software; you can redistribute it or modify it under the same terms as Perl itself. Net-DPAP-Client-0.26/lib/Net/DPAP/Client/Album.pm0000644000175100001440000000205310510013706021037 0ustar acmeusers00000000000000package Net::DPAP::Client::Album; use strict; use warnings; use base qw(Class::Accessor::Fast); __PACKAGE__->mk_accessors(qw(count id name images)); 1; __END__ =head1 NAME Net::DPAP::Client::Album - Remote DPAP album =head1 DESCRIPTION This module represents a remote iPhoto shared album. =head1 METHODS =head2 count The returns the number of images in the album. =head2 id This returns the internal iPhoto ID for the album. You probably don't need to worry about this. =head2 images This returns an arrayref of Net::DPAP::Client::Image objects, representing the images in the album. =head2 name This returns the name of the album. Note that if you are sharing individual albums, iPhoto tends to share all the images in the collection in an album named "Photo album", as well as in the individual albums. So you may see photos twice in that case. =head1 AUTHOR Leon Brocard =head1 COPYRIGHT Copyright (C) 2004, Leon Brocard This module is free software; you can redistribute it or modify it under the same terms as Perl itself. Net-DPAP-Client-0.26/CHANGES0000644000175100001440000000054110510013706015176 0ustar acmeusers00000000000000CHANGES file for Net::DPAP::Client 0.26 Sun Oct 1 20:22:00 BST 2006 - add pod coverage test 0.25 Wed Mar 9 18:15:58 EST 2005 - work with iPhoto 5 (thanks to Jack/ms419) 0.24 Mon Jul 19 19:18:01 CEST 2004 - more documentation (as requested by Mark Fowler) - added a test to check the Pod 0.22 Mon Jul 12 14:54:28 IST 2004 - first release Net-DPAP-Client-0.26/META.yml0000644000175100001440000000032110510013706015450 0ustar acmeusers00000000000000--- #YAML:1.0 name: Net-DPAP-Client version: 0.26 author: - Leon Brocard abstract: Connect to iPhoto shares (DPAP) license: perl generated_by: Module::Build version 0.2612, without YAML.pm Net-DPAP-Client-0.26/MANIFEST0000644000175100001440000000024410510013706015334 0ustar acmeusers00000000000000Build.PL CHANGES lib/Net/DPAP/Client.pm lib/Net/DPAP/Client/Album.pm lib/Net/DPAP/Client/Image.pm Makefile.PL MANIFEST This list of files META.yml README t/pod.t Net-DPAP-Client-0.26/t/0000755000175100001440000000000010510013706014446 5ustar acmeusers00000000000000Net-DPAP-Client-0.26/t/pod.t0000644000175100001440000000021410510013706015412 0ustar acmeusers00000000000000#!perl -T use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); Net-DPAP-Client-0.26/Build.PL0000644000175100001440000000054210510013706015500 0ustar acmeusers00000000000000use Module::Build; use strict; my $build = Module::Build->new( create_makefile_pl => 'traditional', license => 'perl', module_name => 'Net::DPAP::Client', requires => { 'Carp::Assert' => 0, 'Class::Accessor::Fast' => 0, 'LWP::Simple' => 0, 'Net::DAAP::DMAP' => "1.20", 'URI' => 0, }, ); $build->create_build_script; Net-DPAP-Client-0.26/Makefile.PL0000644000175100001440000000112210510013706016151 0ustar acmeusers00000000000000# Note: this file was auto-generated by Module::Build::Compat version 0.03 use ExtUtils::MakeMaker; WriteMakefile ( 'NAME' => 'Net::DPAP::Client', 'VERSION_FROM' => 'lib/Net/DPAP/Client.pm', 'PREREQ_PM' => { 'Carp::Assert' => '0', 'Class::Accessor::Fast' => '0', 'LWP::Simple' => '0', 'Net::DAAP::DMAP' => '1.20', 'URI' => '0' }, 'INSTALLDIRS' => 'site', 'PL_FILES' => {} ) ; Net-DPAP-Client-0.26/README0000644000175100001440000000237110510013706015066 0ustar acmeusers00000000000000NAME Net::DPAP::Client - Connect to iPhoto shares (DPAP) SYNOPSIS use Net::DPAP::Client; my $client = Net::DPAP::Client->new; $client->hostname($hostname); my @albums = $client->connect; foreach my $album (@albums) { print $album->name, "\n"; foreach my $image (@{$album->images}) { print " ", $image->name, "\n"; my $thumbnail = $image->thumbnail; my $hires = $image->hires; } } DESCRIPTION This module provides a DPAP client. DPAP is the Digital Photo Access Protocol and is the protocol that Apple iPhoto uses to share photos. This allows you to browse shared albums, and download thumbnail and hires versions of shared photos. It currently doesn't support password-protected shares. METHODS new The constructor: my $client = Net::DPAP::Client->new; $client->hostname($hostname); connect Connect to the hostname: my @albums = $client->connect; SEE ALSO Net::DPAP::Client::Album, Net::DPAP::Client::Image. AUTHOR Leon Brocard COPYRIGHT Copyright (C) 2004-6, Leon Brocard This module is free software; you can redistribute it or modify it under the same terms as Perl itself.