faceextract/faceextract.pl at master · chy-causer/faceextract · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
#!/bin/perl -w
#
use strict;
use utf8;
use XML::Simple qw(:strict);
use Data::Dumper;
use Image::ExifTool qw(:Public);

if(scalar(@ARGV) == 1)
{
	chdir($ARGV[0]);
}

# Location of contact file
my $contactsfile = "/cygdrive/c/Users/greger/AppData/Local/Google/Picasa2/contacts/contacts.xml";

# Picasa-file-filename
my $filename = ".picasa.ini";

my $xml = new XML::Simple ( ForceArray => 1);
my $xmpinfo;

# Parse the contacts file, and make a contact map
my $contacts = $xml->XMLin($contactsfile, ForceArray=>1, KeyAttr =>{}, );
my %contactmap = ();
my $conts = $contacts->{contact};
foreach my $contact (@$conts)
{
	$contactmap{$contact->{id}} = $contact->{name};
}


# Open and read the picasa file into an array
open(PICASAFILE, $filename) || die("Could not open picasafile: $!");
my @picasadata = <PICASAFILE>;
close(PICASAFILE);

# Remove all carriage returns.
foreach my $line (@picasadata)
{
	$line =~ s/\r\n/\n/;
}

# Go through the picasa file
for(my $i = 0; $i < scalar(@picasadata); $i++)
{
	if($picasadata[$i] =~ /^\[(.*)\]/)
	{
		my $exifTool = new Image::ExifTool();
		print $1."\n";
		my $xmpfile = $1;
		if($xmpfile =~ m/NEF/i)
		{
			$xmpfile =~ s/NEF/xmp/gi;
		}
		print "Using $xmpfile for info.\n";
		$exifTool->Options(List => 1);
		$xmpinfo = $exifTool->ImageInfo($xmpfile);

		my $Subjects = $exifTool->GetValue('Subject');
		my $Hierarchical = $exifTool->GetValue('HierarchicalSubject');

		$i++;
		my $changes = 0;
		if($picasadata[$i] =~ /^faces=(.*)/)
		{
			my @faces = split(/;/, $1);
			print "\tFound ".scalar(@faces)." faces\n";
			foreach my $face (@faces)
			{
				my ($region, $id) = split(/,/, $face);
				my $new_subject = $contactmap{$id};
				print "\t\tFound: ".$new_subject."\n";
				my $old = 0;
				if(ref($Subjects) eq "ARRAY")
				{
					for my $subject (@$Subjects)
					{
						if($subject eq $new_subject)
						{
							$old = 1;
						}
					}
				}
				elsif(ref($Subjects) eq "SCALAR")
				{
					if($$Subjects eq $new_subject)
					{
						$old = 1;
					}

				}
				if(!$old)
				{
					$exifTool->SetNewValue(Subject => $new_subject, AddValue=>1);
					print "Added to keywords.\n";
					$changes++;
				}

				$old = 0;
				#print Dumper($Hierarchical);
				if(ref($Hierarchical) eq "ARRAY")
				{
					for my $subject (@$Hierarchical)
					{
						if($subject eq ("People|Persons|".$new_subject))
						{
							$old = 1;
						}
					}
				}
				elsif(ref($Hierarchical) eq "SCALAR")
				{
					if($$Hierarchical eq ("People|Persons|".$new_subject))
					{
						$old = 1;
					}
				}

				if(!$old)
				{
					$exifTool->SetNewValue(HierarchicalSubject => ("People|Persons|".$new_subject), AddValue=>1);
					print "Added to hierarchical keywords.\n";
					$changes++;
				}

			}
		}
#		$changes = 0;
		if($changes > 0)
		{
			my $ret = $exifTool->WriteInfo($xmpfile);
			if($ret == 1) { print "\tFile written ok.\n"; }
			if($ret == 2) { print "\tFile written, no changes.\n"; } #Should not happen
			if($ret == 0) { print "\t *** File write error on file: ".$xmpfile." ***\n"; }
		}
		else
		{
			print "\tNo changes to file.\n";
		}
	}
	print "\n";

}