Skip Menu |
 

This queue is for tickets about the Net-DPAP-Client CPAN distribution.

Report information
The Basics
Id: 11826
Status: resolved
Priority: 0/
Queue: Net-DPAP-Client

People
Owner: Nobody in particular
Requestors: ms419 [...] freezone.co.uk
Cc:
AdminCc:

Bug Information
Severity: Normal
Broken in: 0.24
Fixed in: (no value)

Attachments


Subject: [PATCH] iPhoto 5, imagefilesize, URI encoding
Download (untitled) / with headers
text/plain 320b
Some changes I had to make to get Net::DPAP::Client working - * iPhoto 5 no longer tolerates LWP::Simple getting thumb & hires * Net::DAAP::DMAP now returns imagefilesize (bug #11806) * "meta" values must be comma delineated - but URI module encodes these as "%2C" Thanks for Net::DPAP::Client - it's way rad! Jack
Download dpap-client.patch
text/x-diff 4.2k
--- Client/Image.pm 2005/03/08 18:38:11 1.2 +++ Client/Image.pm 2005/03/08 19:00:50 @@ -3,7 +3,6 @@ use warnings; use base qw(Class::Accessor::Fast); use Carp::Assert; -use LWP::Simple; use Net::DAAP::DMAP qw(:all); __PACKAGE__->mk_accessors(qw(ua kind id name aspectratio creationdate @@ -11,14 +10,20 @@ sub thumbnail { my $self = shift; + + my $ua = $self->ua; my $url = $self->thumbnail_url; - return $self->decode(get($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(get($url)); + + return $self->decode($ua->get($url)->content); } sub decode { @@ -26,7 +31,6 @@ 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]; --- Client.pm 2005/03/08 18:07:01 1.3 +++ Client.pm 2005/03/08 18:53:53 @@ -23,7 +23,7 @@ # Let's look like an iPhoto client my $ua = LWP::UserAgent->new(keep_alive => 1); - $ua->agent("iPhoto/4.01 (Macintosh; PPC)"); + $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); @@ -114,8 +114,7 @@ my $albumid = $album->id; my @images; - my $uri = URI->new("http://www.example.com:8770/databases/1/containers/$albumid/items?meta=dpap.aspectratio,dpap.imagefilesize,dpap.creationdate&type=photo"); - $response = $self->do_get($uri); + $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'); @@ -128,6 +127,10 @@ 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]; @@ -137,10 +140,10 @@ my $imageid = $image->id; - my $thumbnail_url = $self->construct_uri("http://www.example.com:8770/databases/1/items?meta=dpap.thumb&query=('dmap.itemid:$imageid')"); + 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("http://www.example.com:8770/databases/1/items?meta=dpap.hires&query=('dmap.itemid:$imageid')"); + my $hires_url = $self->construct_uri('databases/1/items', meta => 'dpap.hires', query => "('dmap.itemid:$imageid')"); $image->hires_url($hires_url); push @images, $image; @@ -155,9 +158,10 @@ sub do_get { my $self = shift; - my $path = shift; + my ($path, @form) = @_; + my $ua = $self->ua; - my $uri = $self->construct_uri($path); + my $uri = $self->construct_uri($path, @form); my $response = $ua->get($uri); die "Error when fetching $uri" unless $response->is_success; @@ -165,29 +169,32 @@ 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 = shift; - my $uri; - if ($path =~ /http/) { - $uri = URI->new($path); - } else { - $uri = URI->new('http://www.foo.com/'); - $uri->path($path); - } + my ($path, @form) = @_; - my $hostname = $self->hostname; + 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"; - $uri->host($hostname); + while ($#form > 0) { + ($key, $value, @form) = @form; + $uri .= "&$key=$value"; + } + } - $uri->port($port); - my %form = $uri->query_form; - $form{'session-id'} = $session_id if $session_id; - $uri->query_form(%form) if $session_id; - $uri =~ s/%3A/:/g; # mmm, non-standard-compliant - $uri =~ s/%2C/,/g; return $uri; }
Download (untitled) / with headers
text/plain 117b
Thanks for the great patch! I've just released Net::DPAP::Client 0.25 which includes it. Mirroring around CPAN now...


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.