view release on metacpan or  search on metacpan

lib/Image/ExifTool/WriteXMP.pl  view on Meta::CPAN

}

#------------------------------------------------------------------------------
# Save information about resource containing blank node with nodeID
# Inputs: 0) reference to blank node information hash
#         1) reference to property list
#         2) property value
#         3) [optional] reference to attribute hash
# Notes: This routine and ProcessBlankInfo() are also used for reading information, but
#        are uncommon so are put in this file to reduce compile time for the common case
sub SaveBlankInfo($$$;$)
{
    my ($blankInfo, $propListPt, $val, $attrs) = @_;

    my $propPath = join '/', @$propListPt;
    my @ids = ($propPath =~ m{ #([^ /]*)}g);
    my $id;
    # split the property path at each nodeID
    foreach $id (@ids) {
        my ($pre, $prop, $post) = ($propPath =~ m{^(.*?)/([^/]*) #$id((/.*)?)$});
        defined $pre or warn("internal error parsing nodeID's"), next;
        # the element with the nodeID should be in the path prefix for subject
        # nodes and the path suffix for object nodes
        unless ($prop eq $rdfDesc) {
            if ($post) {
                $post = "/$prop$post";
            } else {
                $pre = "$pre/$prop";
            }
        }
        $$blankInfo{Prop}{$id}{Pre}{$pre} = 1;
        if ((defined $post and length $post) or (defined $val and length $val)) {
            # save the property value and attributes for each unique path suffix
            $$blankInfo{Prop}{$id}{Post}{$post} = [ $val, $attrs, $propPath ];
        }
    }
}

#------------------------------------------------------------------------------
# Process blank-node information
# Inputs: 0) ExifTool object ref, 1) tag table ref,
#         2) blank node information hash ref, 3) flag set for writing
sub ProcessBlankInfo($$$;$)
{
    my ($et, $tagTablePtr, $blankInfo, $isWriting) = @_;
    $et->VPrint(1, "  [Elements with nodeID set:]\n") unless $isWriting;
    my ($id, $pre, $post);
    # handle each nodeID separately
    foreach $id (sort keys %{$$blankInfo{Prop}}) {
        my $path = $$blankInfo{Prop}{$id};
        # flag all resource names so we can warn later if some are unused
        my %unused;
        foreach $post (keys %{$$path{Post}}) {
            $unused{$post} = 1;
        }
        # combine property paths for all possible paths through this node
        foreach $pre (sort keys %{$$path{Pre}}) {
            # there will be no description for the object of a blank node
            next unless $pre =~ m{/$rdfDesc/};
            foreach $post (sort keys %{$$path{Post}}) {
                my @propList = split m{/}, "$pre$post";
                my ($val, $attrs) = @{$$path{Post}{$post}};
                if ($isWriting) {
                    CaptureXMP($et, \@propList, $val, $attrs);
                } else {
                    FoundXMP($et, $tagTablePtr, \@propList, $val);
                }
                delete $unused{$post};
            }
        }
        # save information from unused properties (if RDF is malformed like f-spot output)
        if (%unused) {
            $et->Options('Verbose') and $et->Warn('An XMP resource is about nothing');
            foreach $post (sort keys %unused) {
                my ($val, $attrs, $propPath) = @{$$path{Post}{$post}};
                my @propList = split m{/}, $propPath;
                if ($isWriting) {
                    CaptureXMP($et, \@propList, $val, $attrs);
                } else {
                    FoundXMP($et, $tagTablePtr, \@propList, $val);
                }
            }
        }
    }
}

#------------------------------------------------------------------------------
# Convert path to namespace used in file (this is a pain, but the XMP
# spec only suggests 'preferred' namespace prefixes...)
# Inputs: 0) ExifTool object reference, 1) property path
# Returns: conforming property path
sub ConformPathToNamespace($$)
{
    my ($et, $path) = @_;
    my @propList = split('/',$path);
    my $nsUsed = $$et{XMP_NS};
    my $prop;
    foreach $prop (@propList) {
        my ($ns, $tag) = $prop =~ /(.+?):(.*)/;
        next if not defined $ns or $$nsUsed{$ns};
        my $uri = $nsURI{$ns};
        unless ($uri) {
            warn "No URI for namespace prefix $ns!\n";
            next;
        }
        my $ns2;
        foreach $ns2 (keys %$nsUsed) {
            next unless $$nsUsed{$ns2} eq $uri;
            # use the existing namespace prefix instead of ours
            $prop = "$ns2:$tag";
            last;
        }
    }
    return join('/',@propList);
}

#------------------------------------------------------------------------------
# Add necessary rdf:type element when writing structure
# Inputs: 0) ExifTool ref, 1) tag table ref, 2) capture hash ref, 3) path string
#         4) optional base path (already conformed to namespace) for elements in
#            variable-namespace structures
sub AddStructType($$$$;$)
{
    my ($et, $tagTablePtr, $capture, $path, $basePath) = @_;
    my @props = split '/', $path;
    my %doneID;
    for (;;) {
        pop @props;
        last unless @props;
        my $tagID = GetXMPTagID(\@props);
        next if $doneID{$tagID};
        $doneID{$tagID} = 1;
        my $tagInfo = $$tagTablePtr{$tagID};
        last unless ref $tagInfo eq 'HASH';
        if ($$tagInfo{Struct}) {
            my $type = $$tagInfo{Struct}{TYPE};