You are viewing a plain text version of this content. The canonical link for it is here.
Posted to community@apache.org by Dirk-Willem van Gulik <di...@webweaving.org> on 2004/03/14 22:51:00 UTC
iPhoto <-> Web bridge hack - now what we need is some apache/template wizzardry
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;
}