package 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 <acme@astray.com>
=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.