diff --git a/contrib/kpa-merge b/contrib/kpa-merge index b6bf928a..4617b985 100755 --- a/contrib/kpa-merge +++ b/contrib/kpa-merge @@ -1,949 +1,949 @@ #!/usr/bin/perl -# Copyright 2017 Robert Krawitz +# Copyright 2017-2020 Robert Krawitz # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; see the file COPYING. If not, write to # the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, # Boston, MA 02110-1301, USA. # Maintain KPhotoAlbum index.xml files use strict; use warnings; use XML::LibXML; use Getopt::Long; use Carp("cluck"); my ($kpa_attributes); my (%categories); # Map between category name and ID for compressed files my (%category_map); my (%blocklist); # This is stored as {category}{member}{groupname}, as members can only be # members of one group. Weird, huh? But this way, when we overlay the new my (%member_groups); # $group_memberss{category}{groupname}{member} = is_referenced my (%group_members); # $category_images{category}{member} = is_referenced my (%categories_used); # $orphans{category}{member} = 1 my (%orphans); # $category_remappings{$category}{$item}{"old"|"new"} # If there's only one category 0, we can safely remap it if it shows # up in a member group. If there are more than one (indicated by a value # of -1 here), there's nothing we can do. my (%category_remappings); # $category_remappings{$id} = new_id my (%category_id_remap); my ($compress_output); # Order matters here; sort by date and then filename my (%images_seq); # But we also need fast access! my (%images); my (@image_list); my (@stacks_byimage); my (@stacks_byid); my (%stacks_remap); my (%stacks_to_remove); # Ordering within stacks does matter (particularly for the first image # on the stack). my (%stack_order); my ($max_stack_pass1) = 0; my ($opt_reject_new_images) = 0; my ($opt_keep_blocked_images) = 0; my ($opt_no_output) = 0; my ($opt_clean_unused_labels) = 0; my ($opt_replace_categories) = 0; my ($opt_force_compressed_output) = 0; my ($opt_force_uncompressed_output) = 0; my ($last_pass) = 1; my (%warned_idx0) = (); my ($opt_output_version) = 0; my ($output_version) = 0; sub usage() { my ($usage) = << 'FINIS'; Usage: kpa-merge [options] file1 [file2] If two files are provided, merge the two files and write the result to stdout. file1 is the up-to-date file containing categories you wish to merge into file2; the result is printed to stdout. Keywords and other categories are combined, such that the result contains all information from both files. Stacks are also combined and merged where appropriate. Image entries present in file1 are *not* copied to file2; a warning is printed. If only one file is provided, it is processed in the same way. This form can be used to clean up an index.xml file. kpa-merge currently handles version 7 and 8 files and by default writes the version of the first input file. kpa-merge can write either compressed or uncompressed output; by default it uses the compression of the first input file. Options: -R|--reject-new-images Don't load new images from the first file -B|--keep-blocked-images Unblock blocked images in the second file -n|--no-output Don't actually write the result (for testing purposes) -r|--replace-categories Replace all categories from images in the second file with corresponding data from the first (rather than merging) -c|--clean-unused-labels Purge unused labels (useful for one file usage) -C|--compressed-output Force compressed output -N|--no-compressed-output Force uncompressed output -V|--version Force specified output version (7 or 8). FINIS print STDERR $usage; exit(1); } ################################################################ ################################################################ # Load files ################################################### ################################################################ ################################################################ ################################################################ # Utilities ################################################################ sub getAttributes($) { my ($node) = @_; return $node->findnodes("./@*"); } sub getAttribute(\@$) { my ($attributes, $name) = @_; foreach my $attr (@$attributes) { if ($name eq $attr->nodeName) { return $attr; } } return undef; } sub setAttribute(\@$$) { my ($attributes, $name, $value) = @_; my ($attr) = getAttribute(@$attributes, $name); if ($attr) { $attr->setValue($value); } else { $attr = XML::LibXML::Attr->new($name, $value); push @$attributes, $attr; } } sub setDefaultAttribute(\@$$) { my ($attributes, $name, $value) = @_; if (! getAttribute(@$attributes, $name)) { my $attr = XML::LibXML::Attr->new($name, $value); push @$attributes, $attr; } } sub isNode($$) { my ($node, $name) = @_; return ($node->nodeType() == 1 && lc $node->nodeName() eq $name); } ################################################################ # Categories ################################################################ sub loadCategory($$$) { my ($node, $pass, $compressed) = @_; my ($name) = $node->getAttribute("name"); $categories{"members"}{$name} = {} if (! defined $categories{"members"}{$name}); $orphans{$name} = {}; $category_remappings{$name} = {}; $category_map{$name} = []; $category_id_remap{$name} = {}; my ($category) = $categories{"members"}{$name}; if ($pass == $last_pass) { $$category{"attributes"} = getAttributes($node); } $$category{"members"} = {} if (! defined $$category{"members"}); my (@members); my $children = $node->childNodes(); my ($category_max_id) = 0; my %items_to_remap; foreach my $i (1..$children->size()) { my ($child) = $children->get_node($i); next if $node->nodeType() != 1 || !isNode($child, "value"); my ($value) = $child->getAttribute("value"); my ($id) = $child->getAttribute("id"); if ($id == 0) { print STDERR "Warning: $name:$value has id 0, will remap\n"; $items_to_remap{$value} = $id; } elsif (defined $category_map{$name}[$id]) { print STDERR "Warning: duplicate ID for $name:$id!\n"; $items_to_remap{$value} = $id; } $$category{"members"}{$value} = 1; $category_map{$name}[$id] = $value; if ($id > $category_max_id) { $category_max_id = $id; } } foreach my $remap (keys %items_to_remap) { $category_max_id++; print STDERR "Remapping $remap from $items_to_remap{$remap} to $category_max_id\n"; $category_map{$remap}{$category_max_id} = $category_max_id; # Uncompressed databases don't have any problem with remapping, # since items are stored uncompressed. if ($compressed) { my ($id) = $items_to_remap{$remap}; $category_remappings{$name}{$remap}{"old"} = $id; $category_remappings{$name}{$remap}{"new"} = $category_max_id; if (defined $category_id_remap{$id}) { print STDERR "*** Non-unique category remap for $id.\n"; - print STDERR "*** Will remove member-group mappins for this id!"; + print STDERR "*** Will remove member-group mappings for this id!"; $category_id_remap{$id} = -1; } else { $category_id_remap{$id} = $category_max_id; } } } } sub loadCategories($$$) { my ($node, $pass, $compressed) = @_; my $children = $node->childNodes(); if ($pass == $last_pass) { $categories{"attributes"} = getAttributes($node); } $categories{"members"} = {} if (! defined $categories{"members"}); # Category maps (mapping between name and ID in a compressed file) # will differ for each file. %category_map = (); foreach my $i (1..$children->size()) { my ($child) = $children->get_node($i); next if $node->nodeType() != 1 || !isNode($child, "category"); loadCategory($child, $pass, $compressed); } } ################################################################ # Images ################################################################ # Image options and values for uncompressed files. sub loadOptionValues($$$) { my ($node, $pass, $file) = @_; my ($name) = $node->getAttribute("name"); $images{$file}{"options"}{$name} = {} if ($opt_replace_categories || ! defined $images{$file}{"options"}{$name}); my $children = $node->childNodes(); foreach my $i (1..$children->size()) { my ($child) = $children->get_node($i); next if $node->nodeType() != 1 || !isNode($child, "value"); my ($val) = $child->getAttribute("value"); $images{$file}{"options"}{$name}{$val} = 1; $categories_used{$pass}{$name}{$val} = 1; } } sub loadOptionTypes($$$) { my ($node, $pass, $file) = @_; my $children = $node->childNodes(); foreach my $i (1..$children->size()) { my ($child) = $children->get_node($i); next if $node->nodeType() != 1 || !isNode($child, "option"); $images{$file}{"options"} = {} if ($opt_replace_categories || ! defined $images{$file}{"options"}); loadOptionValues($child, $pass, $file); } } sub loadUncompressedOptions($$$) { my ($node, $pass, $file) = @_; my $children = $node->childNodes(); foreach my $i (1..$children->size()) { my ($child) = $children->get_node($i); next if $node->nodeType() != 1 || !isNode($child, "options"); loadOptionTypes($child, $pass, $file); } } # Compressed XML files are simpler to parse; there's only one node for each # category. sub loadCompressedOptions($$$) { my ($node, $pass, $file) = @_; foreach my $category (sort keys %category_map) { my ($members) = $node->getAttribute($category); if (defined $members && $members ne '') { my ($map) = $category_map{$category}; my (@members); my (@old_members) = split(/,/, $members); foreach my $id (@old_members) { if (defined $category_id_remap{$id}) { if ($category_id_remap{$id} > 0) { push @members, $category_id_remap{$id}; } else { print STDERR "*** Cannot remap non-unique id $id on file $file\n"; } } elsif ($id <= 0) { print STDERR "*** Invalid option ID 0 found category '$category' in $file; omitting\n"; } else { push @members, $id; } } $images{$file}{"options"} = {} if ($opt_replace_categories || ! defined $images{$file}{"options"}); $images{$file}{"options"}{$category} = {} if (! defined $images{$file}{"options"}{$category}); map { $images{$file}{"options"}{$category}{$$map[$_]} = 1; $categories_used{$pass}{$category}{$$map[$_]} = 1; } @members; } } } sub loadImage($$$) { my ($node, $pass, $compressed) = @_; my ($file) = $node->getAttribute("file"); my ($stack) = $node->getAttribute("stackId"); my ($stack_order) = $node->getAttribute("stackOrder"); my ($image_already_defined) = defined $images{$file}; $node->removeAttribute("stackId"); $node->removeAttribute("stackOrder"); if ($output_version == 7) { # Restore any attributes defaulted in version 8 if (! $node->hasAttribute("angle")) { $node->setAttribute("angle", 0); } if (! $node->hasAttribute("endDate")) { $node->setAttribute("endDate", $node->getAttribute("startDate")); } if (! $node->hasAttribute("label")) { my ($label) = $file; $label =~ s,^.*/,,; $label =~ s/\.[^.]*$//; $node->setAttribute("label", $label); } } else { if ($node->hasAttribute("angle") && $node->getAttribute("angle") eq "0") { $node->removeAttribute("angle"); } if ($node->hasAttribute("endDate") && $node->getAttribute("endDate") eq $node->getAttribute("startDate")) { $node->removeAttribute("endDate"); } if ($node->hasAttribute("label")) { my ($label) = $file; $label =~ s,^.*/,,; $label =~ s/\.[^.]*$//; if ($node->getAttribute("label") eq $label) { $node->removeAttribute("label"); } } } if (!defined $images{$file}) { # Always load images from the first file. We might or might not # keep images only found in the second file depending upon what # the user requested. if ($pass > 0) { if ($blocklist{$file}) { if ($opt_keep_blocked_images) { delete $blocklist{$file}; } else { warn "Skipping $file in destination blocklist\n"; return; } } elsif ($opt_reject_new_images) { warn "Skipping image $file after initial load\n"; return; } } $images{$file} = {}; $images{$file}{"attributes"} = getAttributes($node); } else { # We want to use the pass1 attributes where available. # But special case width and height; we want to use a value that's # not -1. my (@attributes) = $node->getAttributes(); my ($nattrs) = $images{$file}{"attributes"}; foreach my $attribute (@attributes) { my ($name) = $attribute->nodeName; my ($value) = $attribute->value; if (($name eq "width" || $name eq "height")) { my ($attr1) = getAttribute(@$nattrs, $name); if ($value ne "-1" && (! $attr1 || $attr1->value eq "-1")) { warn "Fixing $name on $file (" . $attr1->value . " => $value)\n"; $attr1->setValue($value); } } else { setDefaultAttribute(@$nattrs, $name, $value); } } } if ($stack) { $stacks_byimage[$pass]{$file} = $stack; $stacks_byid[$pass]{$stack} = [] if (! defined $stacks_byid[$pass]{$stack}); if (defined $stacks_byid[$pass]{$stack}[$stack_order - 1]) { warn "Duplicate stack/order ($stack, $stack_order) found for $file and $stacks_byid[$pass]{$stack}[$stack_order - 1], appending.\n"; push @{$stacks_byid[$pass]{$stack}}, $file; } else { $stacks_byid[$pass]{$stack}[$stack_order - 1] = $file; } if ($pass == $last_pass && $stack > $max_stack_pass1) { $max_stack_pass1 = $stack; } } my ($start_date) = $node->getAttribute("startDate"); my ($sort_key) = "$start_date$file"; $images_seq{$file} = $sort_key; if ($opt_replace_categories) { $images{$file}{"options"} = {}; } if ($compressed) { loadCompressedOptions($node, $pass, $file); } else { loadUncompressedOptions($node, $pass, $file); } } sub loadImages($$$) { my ($node, $pass, $compressed) = @_; my $children = $node->childNodes(); $stacks_byimage[$pass] = {}; $stacks_byid[$pass] = {}; foreach my $i (1..$children->size()) { my ($child) = $children->get_node($i); next if $node->nodeType() != 1 || !isNode($child, "image"); loadImage($child, $pass, $compressed); } } ################################################################ # Block list ################################################################ sub loadBlocklist($$$) { my ($node, $pass, $compressed) = @_; my $children = $node->childNodes(); foreach my $i (1..$children->size()) { my ($child) = $children->get_node($i); next if $node->nodeType() != 1 || !isNode($child, "block"); $blocklist{$child->getAttribute("file")} = 1; } } ################################################################ # Member groups ################################################################ sub loadMemberGroup($$) { my ($node, $compressed) = @_; my ($category) = $node->getAttribute("category"); my ($groupname) = $node->getAttribute("group-name"); if (! defined $categories{"members"}{$category}{"members"}{$groupname}) { if (! defined $orphans{$category}) { $orphans{$category}{$groupname} = 1; } if ($compressed && $node->hasAttribute("members") && $node->getAttribute("members") ne "") { my $suffix = (! $node->getAttribute("members") =~ /,/) ? 'ren' : ''; printf STDERR "WARNING: Orphan group $category:$groupname has child$suffix %s!\n", $node->getAttribute("members"); } else { print STDERR "Removing orphaned member-group $category:$groupname\n"; return; } } $member_groups{$category} = {} if (! defined $member_groups{$category}); $group_members{$category} = {} if (! defined $group_members{$category}); $group_members{$category}{$groupname} = {} if (! defined $group_members{$category}{$groupname}); if ($compressed) { my ($members) = $node->getAttribute("members"); if ($members) { my ($map) = $category_map{$category}; my (@old_members) = grep { ! $_ == 0 } split(/,/, $members); my (@members); foreach my $id (@old_members) { if (defined $category_id_remap{$id}) { if ($category_id_remap{$id} > 0) { push @members, $category_id_remap{$id}; } else { print STDERR "*** Cannot remap non-unique id $id for member-group $category:$groupname\n"; } } else { push @members, $id; } } map { $member_groups{$category}{$$map[$_]} = $groupname; $group_members{$category}{$groupname}{$$map[$_]} = 1; } @members; } } else { my ($member) = $node->getAttribute("member"); $member_groups{$category}{$member} = $groupname; $group_members{$category}{$groupname}{$member} = 1; } } sub loadMemberGroups($$$) { my ($node, $pass, $compressed) = @_; my $children = $node->childNodes(); foreach my $i (1..$children->size()) { my ($child) = $children->get_node($i); next if $node->nodeType() != 1 || !isNode($child, "member"); loadMemberGroup($child, $compressed); } } ################################################################ # Top level file loader ################################################################ sub load_file($$) { my ($file, $pass) = @_; print STDERR "Loading $file..."; my $doc = XML::LibXML->load_xml(location => $file); if (! $doc) { usage(); } my $kpa = ${$doc->findnodes('KPhotoAlbum')}[0]; if ($pass == 0) { $kpa_attributes = $kpa->findnodes("./@*"); } if ($pass == 0) { if ($opt_output_version != 0 && $opt_output_version != 7 && $opt_output_version != 8) { print STDERR "Output version must be 7 or 8"; usage(); } } if ($kpa->getAttribute("version") != 7 && $kpa->getAttribute("version") != 8) { die "kpa-merge only works with version 7 and 8 files\n"; } if ($pass == 0) { if ($opt_output_version) { $output_version = $opt_output_version; } else { $output_version = $kpa->getAttribute("version"); } } # Always write a version 8 file right now. $kpa->setAttribute("version", $output_version); my ($compressed) = int $kpa->getAttribute("compressed"); if ($pass == 0) { if ($opt_force_compressed_output) { $compress_output = 1; } elsif ($opt_force_uncompressed_output) { $compress_output = 0; } else { $compress_output = $compressed; } } my $children = $kpa->childNodes(); foreach my $i (1..$children->size()) { my ($topcn) = $children->get_node($i); if (isNode($topcn, "categories")) { print STDERR "categories..."; loadCategories($topcn, $pass, $compressed); } elsif (isNode($topcn, "images")) { print STDERR "images..."; loadImages($topcn, $pass, $compressed); } elsif (isNode($topcn, "blocklist")) { print STDERR "blocklist..."; loadBlocklist($topcn, $pass, $compressed); } elsif (isNode($topcn, "member-groups")) { print STDERR "member-groups..."; loadMemberGroups($topcn, $pass, $compressed); } elsif ($topcn->nodeType() == 1) { warn "Found unknown node " . $topcn->nodeName() . "\n"; } } if (keys %warned_idx0) { print STDERR "\n"; foreach my $k (sort keys %warned_idx0) { warn "Found $warned_idx0{$k} files with index 0 ($k $category_map{$k}[0])\n"; } } print STDERR "done.\n"; } ################################################################ ################################################################ # Reconcile images ############################################# ################################################################ ################################################################ # Reconcile stack IDs between the source and the merge files. # The merge file is considered to be authoritative. sub reconcile_stacks() { # We only need to look at stacks in the first file. If a stack exists # in the second file but not the first, it won't be disturbed by this, # as intended. print STDERR "image stacks..."; foreach my $file (sort keys %{$stacks_byimage[0]}) { if (! defined $stacks_byimage[1]{$file}) { my ($old_stack) = $stacks_byimage[0]{$file}; my ($by_id_0) = $stacks_byid[0]{$old_stack}; my ($found) = -1; foreach my $ofile (@$by_id_0) { # Gaps in stack indices next if (! defined $ofile); if (defined $stacks_byimage[1]{$ofile}) { if ($found == -1) { $found = $stacks_byimage[1]{$ofile}; } elsif ($found != $stacks_byimage[1]{$ofile}) { # If an image is in a different stack in one file # vs the other, there's not much we can do. warn "INCONSISTENT STACKS for $file ($found, $stacks_byimage[1]{$ofile})!\n"; } } } if ($found == -1) { my ($new_stack) = ++$max_stack_pass1; # Fix up all of the files in the renumbered stack map { $stacks_byimage[1]{$_} = $new_stack; } (grep { defined $_ } @$by_id_0); $stacks_byid[1]{$new_stack} = $stacks_byid[0]{$old_stack}; } else { $stacks_byimage[1]{$file} = $found; push @{$stacks_byid[1]{$found}}, $file; } } } # Now, set the stack order for each image my ($new_stackid) = 1; foreach my $stackid (sort keys %{$stacks_byid[1]}) { my ($stack) = $stacks_byid[1]{$stackid}; my ($order) = 1; foreach my $file (@$stack) { if (defined $file) { $stack_order{$file} = $order++; } } if ($order <= 2) { $stacks_to_remove{$stackid} = 1; } else { $stacks_remap{$stackid} = $new_stackid++; } } } sub reconcile_images() { # Now, stitch the two image sequences together. print STDERR "image sequences..."; my (%invert_images) = reverse %images_seq; @image_list = map { $invert_images{$_}} sort keys %invert_images; print STDERR "done.\n"; } # Find labels that are unreferenced by anything and purge them. This # may be an iterative process, since labels may be related to other # labels by way of member groups; removing a label may result in # another label losing all of its references. So we keep going until # we've found no further unreferenced labels. sub clean_unused_labels_pass(\%) { my ($categories_in_use) = @_; my ($removed_something) = 0; foreach my $category (sort keys %{$categories{"members"}}) { next if $category eq "Tokens"; print STDERR " Category $category...\n"; my ($members) = $categories{"members"}{$category}{"members"}; # "Member" here is the group name foreach my $member (sort keys %$members) { next if defined $$categories_in_use{$category}{$member}; if (! defined $group_members{$category}{$member} || ! scalar %{$group_members{$category}{$member}}) { # This is not used by any images and is not the name of a group. # Remove from categories print STDERR " Purging $member\n"; delete $$members{$member}; # Remove this group membership my ($group) = $member_groups{$category}{$member}; delete $member_groups{$category}{$member}; if (defined $group_members{$category}{$member}) { if (scalar %{$group_members{$category}{$member}} > 0) { print STDERR " WARNING: $member still has sub-members! Not deleting.\n"; } else { print STDERR " Deleting empty member-group $member\n"; delete $group_members{$category}{$member}; } } # And remove it from any group it's a member of. if (defined $group) { print STDERR " Removing $member from\n"; print STDERR " $group\n"; delete $group_members{$category}{$group}{$member}; # Prune any groups in which this was the last member, # which may allow us to do more work in the next pass. if (scalar %{$group_members{$category}{$group}} == 0) { print STDERR " Removed last member from $group\n"; delete $group_members{$category}{$group}; } } $removed_something = 1; } } } return $removed_something; } sub clean_unused_labels() { print STDERR "\nCleaning unused labels...\n"; my %categories_in_use; foreach my $category (keys %{$categories{"members"}}) { next if $category eq "Tokens"; $categories_in_use{$category} = (); map { $categories_in_use{$category}{$_} = 1; } keys %{$categories_used{$last_pass}{$category}}; if (! $opt_replace_categories && $last_pass > 0) { map { $categories_in_use{$category}{$_} = 1; } keys %{$categories_used{0}{$category}}; } } my ($pass) = 0; do { print STDERR " Pass $pass...\n"; $pass++; } while (clean_unused_labels_pass(%categories_in_use)); print STDERR "done.\n"; } ################################################################ ################################################################ # Write new file ############################################### ################################################################ ################################################################ # This code is a lot simpler; we don't have the same kinds of parse # issues or corner cases to worry about. sub copy_attributes($$;$) { my ($node, $attributes, $omit_pre_existing_categories) = @_; foreach my $attribute (@$attributes) { if (! $omit_pre_existing_categories || ! defined $categories{"members"}{$attribute->nodeName}) { $node->setAttribute($attribute->nodeName, $attribute->value); } } } sub addElement($$$) { my ($dom, $node, $element) = @_; my ($nnode) = $dom->createElement($element); $node->appendChild($nnode); return $nnode; } sub build_categories($$) { my ($dom, $new_kpa) = @_; my ($new_categories) = addElement($dom, $new_kpa, 'Categories'); copy_attributes($new_categories, $categories{"attributes"}); my ($members) = $categories{"members"}; %category_map = (); foreach my $cat (sort keys %$members) { my %cmap; my ($cnode) = addElement($dom, $new_categories, "Category"); my ($cat_data) = $$members{$cat}; copy_attributes($cnode, $$cat_data{"attributes"}); my ($count) = 1; foreach my $value (sort keys %{$$cat_data{"members"}}) { my ($vnode) = addElement($dom, $cnode, "value"); $cmap{$value} = $count; $vnode->setAttribute("value", $value); $vnode->setAttribute("id", $count++); } $category_map{$cat} = \%cmap; } } sub build_image_options($$$$) { my ($dom, $onode, $options, $iname) = @_; foreach my $option (sort keys %$options) { my ($oonode) = addElement($dom, $onode, "option"); $oonode->setAttribute("name", $option); foreach my $value (sort keys %{$$options{$option}}) { my ($vnode) = addElement($dom, $oonode, "value"); $vnode->setAttribute("value", $value); } } } sub build_images($$) { my ($dom, $new_kpa) = @_; my ($new_images) = addElement($dom, $new_kpa, 'images'); my ($compressed) = int $new_kpa->getAttribute("compressed"); foreach my $iname (@image_list) { my ($inode) = addElement($dom, $new_images, 'image'); my ($image) = $images{$iname}; copy_attributes($inode, $$image{"attributes"}, 1); if (defined $stacks_byimage[1]{$iname} && ! defined $stacks_to_remove{$stacks_byimage[1]{$iname}}) { $inode->setAttribute("stackId", $stacks_remap{$stacks_byimage[1]{$iname}}); $inode->setAttribute("stackOrder", $stack_order{$iname}); } if (defined $$image{"options"}) { if ($compressed) { foreach my $option (sort keys %{$$image{"options"}}) { my ($val) = join(",", sort {$a <=> $b} map { $category_map{$option}{$_} } keys %{$$image{"options"}{$option}}); $inode->setAttribute($option, $val); } } else { my ($onode) = addElement($dom, $inode, 'options'); build_image_options($dom, $onode, $$image{"options"}, $iname); } } } } sub build_blocklist($$) { my ($dom, $new_kpa) = @_; my ($new_blocklist) = addElement($dom, $new_kpa, 'blocklist'); foreach my $file (sort keys %blocklist) { my ($bnode) = addElement($dom, $new_blocklist, "block"); $bnode->setAttribute("file", $file); } } sub build_member_groups($$) { my ($dom, $new_kpa) = @_; my ($new_member_groups) = addElement($dom, $new_kpa, 'member-groups'); my ($compressed) = int $new_kpa->getAttribute("compressed"); if ($compressed) { foreach my $cat (sort keys %group_members) { my ($groups) = $group_members{$cat}; foreach my $group (sort keys %$groups) { my ($val) = join(",", sort {$a <=> $b} map {$category_map{$cat}{$_}} keys %{$$groups{$group}}); my ($mnode) = addElement($dom, $new_member_groups, "member"); $mnode->setAttribute("category", $cat); $mnode->setAttribute("group-name", $group); $mnode->setAttribute("members", $val); } } } else { foreach my $cat (sort keys %member_groups) { my ($clist) = $member_groups{$cat}; foreach my $member (sort keys %$clist) { my ($groupname) = $$clist{$member}; my ($mnode) = addElement($dom, $new_member_groups, "member"); $mnode->setAttribute("category", $cat); $mnode->setAttribute("group-name", $groupname); $mnode->setAttribute("member", $member); } } } } sub build_new_doc() { print STDERR "Building new document..."; my ($dom) = XML::LibXML::Document->new("1.0", "UTF-8"); my ($new_kpa) = $dom->createElement('KPhotoAlbum'); $dom->setDocumentElement($new_kpa); copy_attributes($new_kpa, $kpa_attributes); $new_kpa->setAttribute("compressed", $compress_output); print STDERR "categories..."; build_categories($dom, $new_kpa); print STDERR "images..."; build_images($dom, $new_kpa); print STDERR "blocklist..."; build_blocklist($dom, $new_kpa); print STDERR "member groups..."; build_member_groups($dom, $new_kpa); print STDERR "done.\n"; return $dom; } ################################################################ ################################################################ # ...And the top level! ######################################## ################################################################ ################################################################ my (%options) = ("R" => \$opt_reject_new_images, "reject-new-images" => \$opt_reject_new_images, "B" => \$opt_keep_blocked_images, "keep-blocked-images" => \$opt_keep_blocked_images, "n" => \$opt_no_output, "no-output" => \$opt_no_output, "N" => \$opt_force_uncompressed_output, "no-compressed-output"=> \$opt_force_uncompressed_output, "c" => \$opt_clean_unused_labels, "clean-unused-labels" => \$opt_clean_unused_labels, "C" => \$opt_force_compressed_output, "compressed-output" => \$opt_force_compressed_output, "r" => \$opt_replace_categories, "replace-categories" => \$opt_replace_categories, "V:i" => \$opt_output_version, "version:i" => \$opt_output_version, ); Getopt::Long::Configure("bundling", "require_order"); if (!Getopt::Long::GetOptions(%options)) { usage(); } my ($src, $merge); if ($#ARGV == 1) { $src = $ARGV[1]; $merge = $ARGV[0]; $last_pass = 1; } elsif ($#ARGV == 0) { $src = $ARGV[0]; $last_pass = 0; } else { usage(); } load_file($src, 0); load_file($merge, 1) if ($merge); print STDERR "Reconciling "; clean_unused_labels() if ($opt_clean_unused_labels); reconcile_stacks(); reconcile_images(); if (! $opt_no_output) { my ($doc) = build_new_doc(); print STDERR "Writing..."; $doc->toFH(\*STDOUT, 1); print STDERR "done.\n"; }