www-community mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From Dirk-Willem van Gulik <di...@webweaving.org>
Subject iPhoto <-> Web bridge hack - now what we need is some apache/template wizzardry
Date Sun, 14 Mar 2004 21:51:00 GMT
Got a copy of iLive this afternoon - and iPhoto has some nice sharing!  
But it aint
accessible from a web browser :-(

So should any of you folks want to map your iPhoto 'share' into  
webserver space, see
below for some code to play with (it is for a Pinnacle Showcenter,  
rather than a web
browser- but you'll get the gist).

Just looking to see if someone more into xml, stylesheets and templates  
(and some
clean MVC) gets an itch to code. (I am now having some fun with a  
Rendezvous
client which should soon detects all iBooks with open iPhoto share's in  
the house -
so any album appears by  itself on the roster).

Dw

#!/usr/bin/perl
# (c) Copyright 2003, Dirk-Willem van Gulik, All Rights Reserved,
# See http://www.webweaving.org/LICENSE for details
# dirkx@webweaving.org
#
# strings iPhotoDPA | grep ^/
#	/containers /items /databases /server-info /login /update
#
#
use strict;
$|=1;
use LWP::UserAgent;
use Data::Dumper;
use HTTP::Daemon;
use HTTP::Status;
use Image::Magick;

my $debug = 0;
my $pinnacle = 1;
# Server/laptop running iPhoto
my $S = 'http://10.11.0.203:8770';

my $cache = '.cache';
die "Need $cache\n" unless -d $cache;

# Set up a web server:
my $server = HTTP::Daemon->new(
         LocalPort => 8081,
         ReuseAddr => 1,
         ReusePort => 1,
         Listen => 256
         ) || die;
my $url = $server->url;
print STDERR "Server: $url\n";

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

# xxxx = base64(passwd);
# GET dpap://dirkx:xxx@10.11.0.207:8770/login HTTP/1.1

my $q;
my $r;

# See http://tapjam.net/daap/draft.html for details.
#
# Init and auth with the server, get a session
# ID and then a list of albums (virtual and real).
#
$q = rq('/server-info');
$q = rq('/login');
my $sid = $q->{mlog}->[0]->{mlid}->[0];

$q = rq('/update?session-id='.$sid);
my $rid = $q->{mupd}->[0]->{musr}->[0];

# $q=rq('/databases?session-id='.$sid);
$q=rq('/databases?session-id='.$sid.'&revsion-id='.$rid);

my $dbid = $q->{avdb}->[0]->{mlcl}->[0]->{mlit}->[0]->{miid}->[0];
my $collection = $q->{avdb}->[0]->{mlcl}->[0]->{mlit}->[0]->{minm}->[0];

#  
$q=rq('/databases/'.$dbid.'/containers/'.$rid.'/items?session- 
id='.$sid);
$q=rq('/databases/1/containers?session-id='.$sid.'&revsion-id='.$rid);

my @albums=();
my %albums=();
foreach my $s (@{$q->{aply}->[0]->{mlcl}->[0]->{mlit}}) {
         my $pid = $s->{miid}->[0];
         my $name =  $s->{minm}->[0];
         push @albums, $pid;
         $albums{ $pid } = $name;
};

print STDERR "Got ".(1+$#albums)." albums - ready to serve\n";
$SIG{PIPE} = 'IGNORE';

while(my $c=$server->accept) {
         while(my $r = $c->get_request) {
                 if ($r->method ne 'GET') {
                         $c->send_error(RC_FORBIDDEN);
                         next;
                 };
                 my $path= $r->url->path;
                 my $page;
                 print STDERR "Path: $path ";
                 my $h = HTTP::Headers->new('Content-type','text/html');
                 my $res;
                 if ($path eq '/bg.jpg') {
                         open(FH,'bg.jpg');  
read(FH,$page,1024*1024*100); close(FH);
                         $res = HTTP::Response->new( 200, "Ok",
                                  
HTTP::Headers->new('Content-type','image/jpeg'),
                                 $page);
                 } elsif ($path eq '/') {
                         $page=qq|
                         <meta SYABAS-FULLSCREEN>
                         <meta SYABAS-PHOTOTITLE=1>
                         <meta syabas-keyoption="caps">
                         <meta myibox-pip="32,288,176,112,1">
                         <body background="bg.jpg">
                         <h1>Collection: $collection</h1><ul>
                         <table align=right>|;
                         my $i = 0;
                         map {
                                 $page .= '<tr><td width=40%></td>' if 

($i % 3) == 0;
                                 $page .= qq|<td width=20%><a  
href="/$_/">$albums{$_}</td>|;
                                 $page .= '</tr>' if ($i % 3) == 2;
                                 $i++;
                         } @albums;
                         $page .= '</tr>' unless ($i % 3);
                         $page .= "</table>";
                         $res = HTTP::Response->new( 200, "Ok", $h,  
$page);
                 }
                 elsif ($path =~ m|^/show/(\d+)|) {
                         my $pid = $1;
                         $page .= "100|100|Duh|$url\hires/$pid|\n";
                         $res = HTTP::Response->new( 200, "Ok",
                                  
HTTP::Headers->new('Content-type','text/plain'),
                                 $page);
                 }
                 elsif ($path =~ m|^/play/(\d+)|) {
# generate pinnacle playlists.
                         my $pid = $1;
                         my  
$qq=rq('/databases/1/containers/'.$pid.'/items?session- 
id='.$sid.'&revsion-id='.$rid);
                         my $i = 0;
                         for my $t  
(@{$qq->{apso}->[0]->{mlcl}->[0]->{mlit}}) {
                                 my $ppid = $t->{miid}->[0];
                                 my $pname =  $t->{minm}->[0];
                                 $page .=  
"3|2|$pname|$url\hires/$ppid|\n";
                         };
                         $res = HTTP::Response->new( 200, "Ok",
                                  
HTTP::Headers->new('Content-type','text/plain'),
                                 $page);
                 }
                 elsif ($path =~ m|^/(\d+)/|) {
                         my $pid = $1;
                         $page=qq|
                         <meta SYABAS-FULLSCREEN>
                         <meta SYABAS-PHOTOTITLE=1>
                         <meta syabas-keyoption="caps">
                         <meta myibox-pip="32,288,176,112,1">
                         <body background="bg.jpg">
                         <h1>Album: $albums{$pid} ($pid)</h1>
                         <table align=right>
                         <tr><td width=40%><a href="MUTE"  
pod="1,1,$url\play/$pid">play</a></td>|;
                         my  
$qq=rq('/databases/1/containers/'.$pid.'/items?session- 
id='.$sid.'&revsion-id='.$rid);

                         my $i = 0;
                         for my $t  
(@{$qq->{apso}->[0]->{mlcl}->[0]->{mlit}}) {
                                 my $ppid = $t->{miid}->[0];
                                 my $pname =  $t->{minm}->[0];
                                 $page .= '<tr><td width=40%></td>' if 

(($i % 3) == 0) && $i;
# Pinnacle specific
#                              $page .= qq|<td width=20% align=center  
valign=top><a href="MUTE" pod="1,1,$url\show/$ppid"><img  
src="/thumb/$ppid" border=0></a><br>$pname</td>|;
                               $page .= qq|<td width=20% align=center  
valign=top><a href="$url\hires/$ppid"><img src="/thumb/$ppid"  
border=0></a><br>$pname</td>|;
                                 $page .= '</tr>' if ($i % 3) == 2 || $i  
== @albums;
                                 $i++;
                         };
                         $page .= '</tr>' unless ($i % 3);
                         $page .= "</table>";
                         $res = HTTP::Response->new( 200, "Ok", $h,  
$page);
                 }
                 elsif ($path =~ m|^/(\w+)/(\d+)|) {
                         my $type = $1;
                         $type = 'thumb' unless ($type eq 'hires');
                         my $ppid = $2;
                         my $f = $cache .'/in-'.$type.'-'.$ppid.'.jpg';
                         my $F = $cache .'/out-'.$type.'-'.$ppid.'.jpg';
                         if (! -e $F) {
                                 if (! -e $f) {
                                         my $img =  
rq('/databases/1/items?session- 
id='.$sid.'&meta=dpap.'.$type.'&query=(\'dmap.itemid:'.$ppid.'\')');
                                         # print Dumper($img);
                                         $page =  
$img->{adbs}->[0]->{mlcl}->[0]->{mlit}->[0]->{pfdt}->[0];
                                         open(FH,'>'.$f); print FH  
$page; close(FH);
                                 }

                                 my $p = new Image::Magick;
                                 $p->Read($f);
                                 if ($type eq 'thumb') {
                                         $p->Mogrify('Scale', geometry  
=> '100x100');
                                 } else {
                                         $p->Mogrify('Scale', geometry  
=> '720x576');
                                 }
# Map into something remotely not too ugly for display on a PAL  
telecsion screen.
                                 $p->Mogrify('Quantize', 'colorspace' =>  
'YCbCr');
                                 $p->Mogrify('Contrast', 'sharpen' =>  
'1');
                                 $p->Mogrify('Gamma', 'gamma' => 2.8 );
                                 $p->Write($F);
                                 undef $p;
                         }
                         open(FH,$F); read(FH, $page,128*1024*1024);  
close FH;

                         $res = HTTP::Response->new( 200, "Ok",
                                  
HTTP::Headers->new('Content-type','image/jpeg'),
                                 $page);
                 } else {
                         $res = HTTP::Response->new( 401, "not found");
                 };
		# this sucks - but Safari otherwise skips the first 2 images.
                 $c->force_last_request;
                 $c->send_response( $res );
                 print STDERR "served ".length($page)." bytes.\n";
         }
         $c->close;
         undef $c;
}

exit;

sub rq() {
my $s = shift;
my $res = $ua->request( HTTP::Request->new(GET => $S.$s));
return die $! unless ($res->is_success);
decode(0,$res->content);
};

sub decode() {
my ($p,$d)=@_;
my %r=();
# Table with data types - passed to 'unpack' except for 'nest' which
# is simply recursive. See http://tapjam.net/daap/draft.html for  
details.
my %d = qw(
         adbs    nest
         msrv    nest
         mlog    nest
         mupd    nest
         avdb    nest
         aply    nest
         mlit    nest
         mlit    nest
         mlcl    nest
         apso    nest
         mstt    N4
         musr    N4
         mlid    N4
         mstm    N4
         minm    C*
         mpro    CCCC
         ppro    CCCC
         mslr    C
         msal    C
         msau    C
         msdc    N
         muty    N
         mtca    N
         mtco    N
         mrco    N
         miid    N
         mper    N
         minm    a*
         mimc    N
         mctc    N
         pasp    a*
         pimf    a*
         pfdt    a*
);
while(length($d) != 0) {
         die unless length($d)>8;
         my $h = substr($d,0,8); $d = substr($d,8);
         my ($tag, $len) = unpack('a4N4', $h);
         my $data = substr($d,0,$len); $d = substr($d,$len);

         print ("\t" x $p) if $debug;
         print "$tag     $len    " if $debug;

         my @v = ();
         if (defined $d{ $tag }) {
                 if ($d{ $tag } eq 'nest') {
                         print "[\n" if $debug;
                         @v = (decode($p+1,$data) );
                         print ("\t" x $p) if $debug;
                         print "]" if $debug;
                 } else {
                         @v = unpack($d{ $tag },$data);
                         print "=".join(',',@v) if $debug;
                 }
         } else {
                 print "\n" if $debug;
                 print ("\t" x $p) if $debug;
                 print "         --<$data>--" if $debug;
                 @v = ($data);
         };
         print "\n" if $debug;
         $r{ $tag } = () unless defined $r{$tag};
         push @{ $r{ $tag } }, @v;
};
         return \%r;
}
Mime
View raw message