#------------------------------------------------------------------------------
# File:         picasa_faces.config
#
# Description:  User-defined Composite tag definitions to convert face regions
#               in .picasa.ini files to MWG region tags (Metadata Working Group
#               region, used by Picasa) and MP region tags (used by Microsoft
#               Photo Library).
#
# Tag definitions and examples:
#
#   PicasaToMWGRegion
#       This will create the MWG region tag but will filter out the regions
#       that are still unnamed in Picasa.  Picasa defaults to naming these
#       regions 'ffffffffffffffff' but normally will not save these to file.
#     Example:
#       exiftool -config picasa_faces.config "-RegionInfo<PicasaToMWGRegion" FILE
#
#   PicasaToMPRegion
#       This will create the MP region tag but will filter out the regions that
#       are still unnamed in Picasa.  Picasa defaults to naming these regions
#       'ffffffffffffffff' but normally will not save these to file.
#     Example:
#       exiftool -config picasa_faces.config "-RegionInfoMP<PicasaToMPRegion" FILE
#
#   PicasaRegionNames
#       Returns a list of the region names associated with the file.  This
#       allows copying of the region names to XMP:Subject and/or IPTC:Keywords.
#       It also allows checking to see if regions need to be updated.
#     Example:
#       exiftool -config picasa_faces.config "-XMP:Subject<PicasaRegionNames" FILE
#
#   PicasaToMWGRegionUnfiltered
#       This will create the MWG region tag.  This version does not filter out
#       the unnamed regions.  Picasa normally will filter out unnamed regions
#       when it saves regions in the file.
#     Example:
#       exiftool -config picasa_faces.config "-RegionInfo<PicasaToMWGRegionUnfiltered" FILE
#
#   PicasaToMPRegionUnfiltered
#       This will create the MP region tag.  This version does not filter out
#       the unnamed regions.  Picasa normally will filter out unnamed regions
#       when it saves regions in the file.
#     Example:
#       exiftool -config picasa_faces.config "-RegionInfoMP<PicasaToMPRegionUnfiltered" FILE
#
# Notes:        The face names are loaded from the Picasa contacts file, which
#               defaults to:
#
#               C:/Users/MainUser/AppData/Local/PicasaData/Google/Picasa2/contacts/contacts.xml
#
#               The default contacts file may be changed by editing the value
#               of $contactXML below, or on the command line with ExifTool 9.90
#               or later via the -userParam option, eg:
#               -userparam PicasaContactsFile=/path/to/contacts.xml
#
# Requires:     ExifTool version 8.82 or later (9.90 or later for -userparam)
#
# Revisions:    2015/03/07 - Bryan K. Williams (aka StarGeek) Created
#               2015/03/12 - PH Minor changes, optimizations and reformatting
#               2015/05/11 - BKW Fix bug where Picasa writes region data for
#                            rotated NEF and CR2 images as if the orientation
#                            is not rotated.
#               2015/05/12 - PH Minor code tweaks
#               2015/10/26 - BKW Round off area sizes to 7 decimal places
#
# References:   http://u88.n24.queensu.ca/exiftool/forum/index.php/topic,6354.0.html
#------------------------------------------------------------------------------

# Picasa contacts file name
my $contactXML = 'C:/Users/MainUser/AppData/Local/PicasaData/Google/Picasa2/contacts/contacts.xml';

# local variables
my $lastIniFile     = '';   # path of last .picasa.ini file loaded
my $lastContactFile = '';   # path of last contacts.xml file loaded

# raw file types that need additional processing to get regions correct
my %isRawFile = map { $_ => 1 } qw(
    3FR ARW CR2 CRW CS1 DCR DNG EIP ERF IIQ K25 KDC MEF MOS MRW NEF NRW
    ORF PEF RAF RAW RW2 RWL SR2 SRF SRW X3F), 'Canon 1D RAW';

my %contactHash;    # lookup for loaded contacts.xml entries
my %fileHash;       # lookup for loaded .picasa.ini entries

#------------------------------------------------------------------------------
# Load Picasa's contacts.xml and .picasa.ini files.
# Inputs: 0) ExifTool object reference, 1) .picasa.ini directory
# Returns: 1 if files were loaded and parsed, undef on error
# Notes: If file has already been loaded, it isn't reloaded
sub LoadPicasaFiles($$)
{
    local (*CONTACTS, *INI);
    my ($et, $iniDir) = @_;

    # check ExifTool version to see if there might be
    # a command line setting for the contact file
    my $contactFile = ($Image::ExifTool::VERSION >= 9.89 and
                      defined($et->Options(UserParam => 'PicasaContactsFile'))) ?
                      $et->Options(UserParam => 'PicasaContactsFile') : $contactXML;

    # load Picasa contacts.xml file unless done already
    unless ($contactFile eq $lastContactFile) {
        $lastContactFile = $contactFile;
        undef %contactHash;
        # Picasa's default setting for unnamed faces.
        $contactHash{'ffffffffffffffff'} = 'unnamed';
        if (open(CONTACTS, $contactFile)) {
            require Image::ExifTool::HTML;
            while (<CONTACTS>) {
                /name="(.*?)"/ or next;
                my $name = $1;
                /id="([a-f0-9]+)"/ or next;
                my $id = $1;
                $contactHash{$id} = Image::ExifTool::HTML::UnescapeHTML($name);
            }
            close(CONTACTS);
        } else {
            local $SIG{'__WARN__'} = undef; # stop ExifTool from catching the warning
            warn "Error reading contacts file $contactFile\n";
        }
    }

    # load .picasa.ini file from the specified directory
    my $iniFile = "$iniDir/.picasa.ini";

    if ($iniFile eq $lastIniFile) {
        return %fileHash ? 1 : undef;
    }
    $lastIniFile = $iniFile;
    open(INI, $iniFile) or return undef;
    my $section = '';
    while (<INI>) {
        # Process New Section
        /^\s*\[(.+)\][\n\r]*$/ and $section = $1, next;
        # process entry (all we care about are the "faces" lines)
        /^faces=(.*)$/ or next;
        my @temp = split /;/, $1;
        foreach (@temp) {
            /rect64\(([\da-f]{1,16})\),([\da-f]{1,16})/ or next;
            # the string in parens after "rect64" is a 64 bit number in hex,
            # but Picasa doesn't add leading zeroes, so the length of the string
            # cannot be assumed to be 16 bytes.  Handle this as two 32-bit numbers
            # for compatibility with 32-bit systems.
            my $hi = hex(substr($1, 0, -8));
            my $lo = hex(substr($1, -8));
            # round to 7 decimals (arbitrary, but seems to be about what Picasa uses)
            my $x0 = int((($hi >> 16)   /65535)*10000000+.5)/10000000;
            my $y0 = int((($hi & 0xffff)/65535)*10000000+.5)/10000000;
            my $x1 = int((($lo >> 16)   /65535)*10000000+.5)/10000000;
            my $y1 = int((($lo & 0xffff)/65535)*10000000+.5)/10000000;
            push @{ $fileHash{$section} }, {
                ContactID => $2,
                X => $x0,
                Y => $y0,
                W => int(($x1 - $x0)*10000000+.5)/10000000,
                H => int(($y1 - $y0)*10000000+.5)/10000000,
            };
        }
    }
    close(INI);
    return %fileHash ? 1 : undef;
}

#------------------------------------------------------------------------------
# Rotate region to specified orientation (for RAW file types only)
# Input: 0) rectangle array ref (x,y,w,h), 1) EXIF orientation value, 2) file type
sub RotateRegion($$$)
{
    my ($rect, $orientation, $fileType) = @_;
    if ($orientation and $fileType and $isRawFile{$fileType}) {
        my ($x,$y,$w,$h) = @$rect;
        if ($orientation == 8) {        # CW 90
            @$rect = (1-$h-$y, $x, $h, $w);
        } elsif ($orientation == 3) {   # CW 180
            @$rect = (1-$x-$w, 1-$y-$h, $w, $h);
        } elsif ($orientation == 6) {   # CW 270
            @$rect = ($y, 1-$x-$w, $h, $w);
        }
    }
}

#------------------------------------------------------------------------------
# User-defined tag definitions
#
%Image::ExifTool::UserDefined = (
    'Image::ExifTool::Composite' => {
        #
        # Versions that filter out unnamed regions (ContactID=ffffffffffffffff)
        #
        PicasaToMWGRegion => {
            Require =>  {
                0 => 'Directory',
                1 => 'FileName',
                2 => 'ImageWidth',
                3 => 'ImageHeight',
            },
            Desire => {
                4 => 'Orientation',
                5 => 'FileType',
            },
            ValueConv => sub {
                my ($val, $et) = @_;
                LoadPicasaFiles($et, $$val[0]) or return undef; # load contacts.xml and Picasa.ini
                my $filename = $$val[1];
                my @regList;
                # convert to local variables for readability, and make
                # sure there is a region associated with the current file
                my $contactHashRef = \%contactHash;
                my $tempArrayRef = $fileHash{$filename} or return undef;
                foreach my $tempHash (@$tempArrayRef) {
                    next if $$tempHash{ContactID} eq 'ffffffffffffffff';
                    my $name = $$contactHashRef{$$tempHash{ContactID}};
                    next unless defined $name;
                    my @rect = @$tempHash{'X','Y','W','H'};
                    RotateRegion(\@rect, $$val[4], $$val[5]);
                    push @regList, {
                        Area => {
                            X => $rect[0] + $rect[2] / 2,
                            Y => $rect[1] + $rect[3] / 2,
                            W => $rect[2],
                            H => $rect[3],
                            Unit => 'normalized',
                        },
                        Name => $name,
                        Type => 'Face',
                    };
                }
                # make sure a region exists, otherwise return undef
                return @regList ? {
                    AppliedToDimensions => { W => $$val[2], H => $$val[3], Unit => 'pixel' },
                    RegionList => \@regList,
                } : undef;
            },
        },
        PicasaToMPRegion => {
            Require => {
                0 => 'Directory',
                1 => 'FileName',
            },
            Desire => {
                2 => 'Orientation',
                3 => 'FileType',
            },
            ValueConv => sub {
                my ($val, $et) = @_;
                LoadPicasaFiles($et, $$val[0]) or return undef; # load contacts.xml and Picasa.ini
                my $filename = $$val[1];
                my @regList;
                # convert to local variables for readability, and make
                # sure there is a region associated with the current file
                my $contactHashRef = \%contactHash;
                my $tempArrayRef = $fileHash{$filename} or return undef;
                foreach my $tempHash (@$tempArrayRef) {
                    next if $$tempHash{ContactID} eq 'ffffffffffffffff';
                    my $name = $$contactHashRef{$$tempHash{ContactID}};
                    next unless defined $name;
                    my @rect = @$tempHash{'X','Y','W','H'};
                    RotateRegion(\@rect, $$val[2], $$val[3]);
                    push @regList, {
                        PersonDisplayName => $name,
                        Rectangle => join(', ', @rect),
                    };
                }
                # make sure a region exists, otherwise return undef
                return @regList ? { Regions => \@regList } : undef;
            },
        },
        PicasaRegionNames => {
            Require => {
                0 => 'Directory',
                1 => 'FileName',
            },
            ValueConv => sub {
                my ($val, $et) = @_;
                LoadPicasaFiles($et, $$val[0]) or return undef; # load contacts.xml and Picasa.ini
                my $filename = $$val[1];
                my @regList;
                # convert to local variables for readability, and make
                # sure there is a region associated with the current file
                my $contactHashRef = \%contactHash;
                my $tempArrayRef = $fileHash{$filename} or return undef;
                foreach my $tempHash (@$tempArrayRef) {
                    next if $$tempHash{ContactID} eq 'ffffffffffffffff';
                    my $name = $$contactHashRef{$$tempHash{ContactID}};
                    push @regList, $name if defined $name;
                }
                # make sure a region exists, otherwise return undef
                return @regList ? \@regList  : undef;
            },
        },
        #
        # Versions that do not filter out unnamed regions (ContactID=ffffffffffffffff)
        # Picasa normally does not add these regions when it saves names to the file.
        #
        PicasaToMWGRegionUnfiltered => {
            Require => {
                0 => 'Directory',
                1 => 'FileName',
                2 => 'ImageWidth',
                3 => 'ImageHeight',
            },
            Desire => {
                4 => 'Orientation',
                5 => 'FileType',
            },
            ValueConv => sub {
                my ($val, $et) = @_;
                LoadPicasaFiles($et, $$val[0]) or return undef; # load contacts.xml and Picasa.ini
                my $filename = $$val[1];
                my @regList;
                # convert to local variables for readability, and make
                # sure there is a region associated with the current file
                my $contactHashRef = \%contactHash;
                my $tempArrayRef = $fileHash{$filename} or return undef;
                foreach my $tempHash (@$tempArrayRef) {
                    my @rect = @$tempHash{'X','Y','W','H'};
                    RotateRegion(\@rect, $$val[4], $$val[5]);
                    push @regList, {
                        Area => {
                            X => $rect[0] + $rect[2] / 2,
                            Y => $rect[1] + $rect[3] / 2,
                            W => $rect[2],
                            H => $rect[3],
                            Unit => 'normalized',
                        },
                        Name => $$contactHashRef{$$tempHash{ContactID}} || 'unnamed',
                        Type => 'Face',
                    };
                }
                # make sure a region exists, otherwise return undef
                return @regList ? {
                    AppliedToDimensions => { W => $$val[2], H => $$val[3], Unit => 'pixel' },
                    RegionList => \@regList,
                } : undef;
            },
        },
        PicasaToMPRegionUnfiltered => {
            Require => {
                0 => 'Directory',
                1 => 'FileName',
            },
            Desire => {
                2 => 'Orientation',
                3 => 'FileType',
            },
            ValueConv => sub {
                my ($val, $et) = @_;
                LoadPicasaFiles($et, $$val[0]) or return undef; # load contacts.xml and Picasa.ini
                my $filename = $$val[1];
                my @regList;
                # convert to local variables for readability, and make
                # sure there is a region associated with the current file
                my $contactHashRef = \%contactHash;
                my $tempArrayRef = $fileHash{$filename} or return undef;
                foreach my $tempHash (@$tempArrayRef) {
                    my @rect = @$tempHash{'X','Y','W','H'};
                    RotateRegion(\@rect, $$val[2], $$val[3]);
                    push @regList, {
                        PersonDisplayName => $$contactHashRef{$$tempHash{ContactID}} || 'unnamed',
                        Rectangle => join(', ', @rect),
                    }
                }
                # make sure a region exists, otherwise return undef
                return @regList ? { Regions => \@regList } : undef;
            },
        },
    },
);

#------------------------------------------------------------------------------
1;  #end