#! /usr/bin/perl # How to convert keywords that were in Extensis Portfolio # to keywords in iPhoto 6 # This creates some AppleScript, that is save in the files addkeyXX # and run by "osascript addkeyXX" # Full path to the text file that contains Portfolio data my $pf_file = 'Portfolio.txt'; # Full path to the file in iPhoto Library my $ip_file = 'AlbumData.xml'; # My Portfolio export done under OS9 mixed German and French names # The following hash table should correspond to the ordering depending on your langage my %fields = ( "Description" => 1, "Date" => 4, "Filename" => 6, "Path" => 25, "Keywords" => 27, ); sub get_keywords { my %keywords = (); open PF, $pf_file; my $line = ; while () { my @line = split /\t/, $_; my $path = $line[$fields{Path}]; my $keyw = $line[$fields{Keywords}]; my @keyw = split /[\035]/, $keyw; my $desc = $line[$fields{Description}]; $desc =~ s/[\013]/\n/g; my $date = $line[$fields{Date}]; foreach my $k (@keyw) { $keywords{$k} = 1; } } close PF; my $i = 50; foreach my $k (sort (keys %keywords)) { $keywords{$k} = $i; $i++; } %keywords; } sub add_keywords { my %keywords = @_; open IP, $ip_file; while () { next unless m|List of Keywords|; my $k; my $v; while () { last if m||; $v = $1 if m|(.*)|; $keywords{$1} = $v if m|(.*)|; } last; } close IP; %keywords; } sub print_keywords { my %keywords = @_; print "\tList of Keywords\n"; print "\t\n"; foreach my $k (sort (keys %keywords)) { print "\t\t$keywords{$k}\n"; print "\t\t$k\n"; } print "\t\n"; } sub parse_pf { my %keywords = @_; my %res = (); open PF, $pf_file; my $line = ; while () { # Conversion of some characters from MacRoman to UTF-8 s/[\211]//g; s/[\215]//g; s/[\216]//g; s/[\217]//g; s/[\220]//g; s/[\221]//g; s/[\224]//g; s/[\231]//g; s/[\203]//g; my @line = split /\t/, $_; my $file = $line[$fields{Filename}]; my $path = $line[$fields{Path}]; my $keyw = $line[$fields{Keywords}]; my @keyw = split /[\035]/, $keyw; my $desc = $line[$fields{Description}]; $desc =~ s/[\013]/\n/g; my $date = $line[$fields{Date}]; my @data = ( $path, $date, $keyw, $desc, ); push @{$res{$file}}, \@data; } close PF; %res; } sub print_res { my %res = @_; foreach my $file (sort (keys %res)) { print "==== $file ====\n"; foreach my $data (@{$res{$file}}) { my @keyw = split /[\035]/, $$data[2]; my $desc = $$data[3]; $desc =~ s/^/\t\t/gm; print "$$data[0]\n"; print "\t$$data[1]\n"; print "\t".(join '/', @keyw)."\n"; print "$desc\n"; } } } my %keywords = get_keywords; %keywords = add_keywords %keywords; # print_keywords %keywords; my %res = parse_pf %keywords; # print_res %res; my $scptsize = 100; my $count = 0; my $num = 0; my $outfile; $num++; $outfile = sprintf "addkey%02d", $num; open OUT, ">$outfile"; select OUT; print "tell application \"iPhoto\"\n"; #### read the file open IP, $ip_file; while () { last if m|List of Keywords|; } #### list of keywords my %keywords_ip; while () { # Conversion of some characters from MacRoman to UTF-8 s//\211/g; s//\215/g; s//\216/g; s//\217/g; s//\220/g; s//\221/g; s//\224/g; s//\231/g; s//\203/g; $keywords_ip{$1} = 1 if m|(.*)|; last if m|^\t|; } while () { last if m|Master Image List|; } ; while () { last if m|^\t|; #### analysis of metadata from iPhoto my $k; my %k; my $v; $k = $1 if m|^\t\t(.*)|; while () { last if m|^\t\t|; if (m|^\t\t\t(.*)|) { $v = $1; next; } if (m||) { my @kw; while () { last if m|^\t\t\t|; push @kw, $_; } $k{$v} = \@kw; } else { $k{$v} = $1 if m|^\t\t\t(.*)|; } } #### Are there Portfolio data corresponding to this picture ? my $data; ## Sort out doubles, using the date of the picture or the parent directory name my $file = $k{ImagePath}; $file =~ s|.*/(.*)|$1|; if (scalar(@{$res{$file}})) { my $when = $k{DateAsTimerInterval}; $when =~ s|(.*)|$1|; $when += 3600*24*(365*31+8); my @date = localtime $when; $when = sprintf "%04d:%02d:%02d", $date[5]+1900, $date[4]+1, $date[3]; my $roll = $k{ImagePath}; $roll =~ s|.*/([^/]*)/[^/]*|$1|; foreach my $d (@{$res{$file}}) { if ($$d[0] =~ m/${when}:${file}/ or $$d[0] =~ m/${roll}:${file}/) { $data = $d; last; } } } #### Update if ($data) { $_ = $$data[2]; # Conversion of some characters from UTF-8 to MacRoman s//\211/g; s//\215/g; s//\216/g; s//\217/g; s//\220/g; s//\221/g; s//\224/g; s//\231/g; s//\203/g; my @keyw = split /[\035]/, $_; print " select photos whose id is 4294967296+$k\n" if scalar(@keyw); my @kw; foreach my $keyw (@keyw) { print " assign keyword string \"$keyw\"\n"; push @kw, $keyw unless $keywords_ip{$keyw}; } $_ = $$data[3]; # Conversion of some characters from UTF-8 to MacRoman s//\211/g; s//\215/g; s//\216/g; s//\217/g; s//\220/g; s//\221/g; s//\224/g; s//\231/g; s//\203/g; my $comm = $_; $comm =~ s/MINOLTA DIGITAL CAMERA *//g; $comm =~ s/\n\n/\n/g; $comm =~ s/\n$//; $comm =~ s/\n/; /g; $comm =~ s/^ *//m; $comm = " ; $comm" if scalar(@kw) and $comm; $comm = (join '/', @kw).$comm if scalar(@kw); printf " tell photos whose id is 4294967296+$k to set the comment to \"$comm\"\n"; $count++; if ($count % $scptsize == 0) { print "end tell\n"; close OUT; $num++; $outfile = sprintf "addkey%02d", $num; open OUT, ">$outfile"; select OUT; print "tell application \"iPhoto\"\n"; } } } close IP; print "end tell\n"; close OUT;