I've had a terrible time getting a decent export of iPhoto. If I try to export it by highlighting every event, I get a single directory full of 3400 images. If I want to have them come out in a reasonable manner, I have to export every Roll/Event individually.

Apple recommends backing up to CD, but as I generally use 1GB sticks in my camera, I frequently can't fit even a single camera load onto a CD. That's clearly a loser.

So I sat down this morning and wrote a quick-n-dirty Perl script to copy my images from iPhoto to disk.

This should not be as difficult as it is, but between Apple's flat plist fixation and their "moving target" philosophy, the first two CPAN modules I tried (Mac::PropertyList and Mac::iPhoto) simply errored out. I finally found Mac::PropertyList::SAX (interestingly based on Mac::PropertyList), and it worked fine.

This code probably violates all my own rants on style and coding: it's a morning's hack session, and looks like it. I'm putting it here in case anyone else needs it.

#!/usr/bin/perl

##
# Export iPhoto data by Event/Roll via Perl
#
# MPeever
# 2009-01-25
#

use strict;
use warnings;
use Data::Dumper;
use File::Copy qw/copy/;
use File::Spec;
use Mac::PropertyList::SAX qw/parse_plist_fh/;

my $targetDir = pop (@ARGV);
my @paths =  grep { -f } @ARGV ;
my $VERBOSE = grep { $_ eq '-v' } @ARGV;

die "Usage: $0 [-v][-v] \$albumData.xml [\$albumData.xml]... \$targetD
+ir\n" 
  unless scalar @paths;

print STDERR "Creating $targetDir\n"
  and mkdir $targetDir 
  unless -d $targetDir;

my @libraries = map { parseLibrary($_) } @paths;

foreach my $library (@libraries) {
  my $archiveLocation = $library->{'Archive Path'};
  my $rolls = rolls ($library);

  foreach my $roll (@{$rolls}) {
    my $name = $roll->{'name'};
    my $archivePath =  File::Spec->catdir($targetDir, $name);
    $roll -> {'archivePath'} = $archivePath;
  }
  print STDERR Dumper $rolls if ($VERBOSE > 1);

  foreach my $folder ( map { $_->{'archivePath'}} @{$rolls} ){
    warn "Folder exists! '$folder'" and next if -d $folder;
    print STDERR "Creating \"$folder\"\n" if $VERBOSE;
    mkdir $folder or warn "Error creating '$folder': $!";
  }

  foreach my $roll (@{$rolls}) {
    my $archivePath = $roll->{'archivePath'};
    foreach my $image (@{$roll->{'images'}}){
      my $src = $image->{'ImagePath'}->value;
      my $filename = (File::Spec->splitpath($src))[-1];
      my $dest = File::Spec->catfile($archivePath, $filename);
      warn "File Exists! '$dest'" and next if -f $dest;
      print qq{cp '$src' '$dest'}, "\n" if $VERBOSE;
      copy ($src, $dest) or 
    warn "Error copying $src -> $dest: $!";
    }
  }
}

## Parse a library file
## return Mac::PropertyList object
sub parseLibrary {
  my $path = shift;
  open (my ($fh), $path) or 
    warn "Couldn't open $path: $!" and 
      return '';
  my $data = parse_plist_fh ($fh);
  close $fh;
  return $data;
}

## Get the list of Rolls from a library
## return $hashRef to rolls
## Each Roll contains its own images
sub rolls {
  my $library = shift;
  my $photos = $library -> {'Master Image List'};
  my $rollNameKey = 
  my @rolls = map {
    my $rollIdKey = defined $_->{'RollID'} ? 'RollID' : 'AlbumId';
    my $rollNameKey = defined $_->{'RollName'} ? 'RollName' : 'AlbumNa
+me';
    my $name = $_->{$rollNameKey}->value;
    my $id = $_->{$rollIdKey}->value;
    my @imageIds = map {$_ -> value } @{ $_->{'KeyList'}->value};
    my @images = map {$photos -> {$_}} @imageIds;
    { 'name' => $name,
    'id' => $id,
      'imageIds' => \@imageIds ,
        'images' => \@images } 
  } @{$library->{'List of Rolls'}};
  return \@rolls;
}
[download]

Update: fixed usage message

Update: fixed dictionary keys in &rolls. To make it work on my other MacBook.