File indexing completed on 2024-11-17 04:01:01

 #!/usr/bin/perl
 # SPDX-FileCopyrightText: 2020 Robert Krawitz <rlk@alum.mit.edu>
 # SPDX-License-Identifier: GPL-2.0-or-later
 
 # CLI to edit/manage KPhotoAlbum index 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
 # $member_groups{category}{member}{groupname} = is_referenced
 my (%member_groups);
 # $group_members{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);
 
 # For add-item command
 my (@items_to_add) = ();
 my ($category_of_items_to_add) = '';
 my ($parent_of_items_to_add) = '';
 
 # For tag command
 my (@files_to_tag) = ();
 my ($tag_instead_of_untag) = 1;
 my ($category_of_items_to_tag) = '';
 my (@items_to_tag) = ();
 my (%map_items_to_tag) = ();
 
 # 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-util [options] command index_file [command_args]
 
     Commands:
     clean
         Clean file using options below
     merge file1 file2
         Merge file2 into file1
     add-item category [--parent parent_item] item...
         Add the specified items to the specified category.
         Category must already exist.
         If --parent is specified, make them children
         of the specified item (must exist).
     tag category iten
         Apply the specified tag to the list of files
         from stdin
 
     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");
     if (! defined $categories{"members"}{$name}) {
     $categories{"members"}{$name} = {};
     push @{$categories{"members_list"}}, $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 mappings for this id!";
         $category_id_remap{$id} = -1;
         } else {
         $category_id_remap{$id} = $category_max_id;
         }
     }
     }
     foreach my $item_to_tag (@items_to_tag) {
     if ($category_of_items_to_tag eq $name && $tag_instead_of_untag && 
         ! defined $$category{'members'}{$item_to_tag}) {
         die "Error: attempting to tag files $category_of_items_to_tag/$item_to_tag, but item $category_of_items_to_tag/$item_to_tag does not exist.\n";
     }
     }
     if ($category_of_items_to_add eq $name) {
     if ($parent_of_items_to_add ne '' && ! defined $$category{'members'}{$parent_of_items_to_add}) {
         die "Requested parent $parent_of_items_to_add does not exist.\n";
     }
     foreach my $item (@items_to_add) {
         if (defined $$category{'members'}{$item}) {
         warn "$name/$item already exists, skipping.\n";
         } else {
         $$category{'members'}{$item} = 1;
         $category_map{$name}[++$category_max_id] = $item;
         }
     }
     }
 }
 
 sub loadCategories($$$) {
     my ($node, $pass, $compressed) = @_;
     my $children = $node->childNodes();
     if ($pass == $last_pass) {
     $categories{"attributes"} = getAttributes($node);
     }
     $categories{"members"} = {} if (! defined $categories{"members"});
     $categories{"members_list"} = () if (! defined $categories{"members_list"});
     # 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);
     }
     if ($category_of_items_to_add ne '' &&
     ! defined $categories{'members'}{$category_of_items_to_add}) {
     die "Error: atempting to add items to category $category_of_items_to_add that is not present\n";
     }
     if ($category_of_items_to_tag ne '' && $tag_instead_of_untag &&
     ! defined $categories{'members'}{$category_of_items_to_tag}) {
     die "Error: attempting to tag files $category_of_items_to_tag, but category $category_of_items_to_tag does not exist.\n";
     }
     foreach my $item_to_tag (@items_to_tag) {
     if ($category_of_items_to_tag ne '' && $tag_instead_of_untag &&
         ! defined $categories{'members'}{$category_of_items_to_tag}{'members'}{$item_to_tag}) {
         die "Error: attempting to tag files $category_of_items_to_tag/$item_to_tag, but item $category_of_items_to_tag/$item_to_tag does not exist.\n";
     }
     }
 }
 
 ################################################################
 # 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");
     if ($tag_instead_of_untag ||
         $name ne $category_of_items_to_tag ||
         ! defined $map_items_to_tag{$name}) {
         $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 {
         if ($tag_instead_of_untag ||
             $category ne $category_of_items_to_tag ||
             ! defined $map_items_to_tag{$$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);
     }
     if ($category_of_items_to_tag ne '' && $tag_instead_of_untag) {
     my ($did_tag_images) = 0;
     foreach my $file (@files_to_tag) {
         if (! defined $images{$file}) {
         warn "Image $file does not exist, not tagging.\n";
         next;
         }
         $did_tag_images = 1;
         $images{$file}{"options"} = {} if (! defined $images{$file}{"options"});
         $images{$file}{"options"}{$category_of_items_to_tag} = {} if (! defined $images{$file}{"options"}{$category_of_items_to_tag});
         map { $images{$file}{"options"}{$category_of_items_to_tag}{$_} = 1; } @items_to_tag;
     }
     if ($did_tag_images) {
         map { $categories_used{$pass}{$category_of_items_to_tag}{$_} = 1; } @items_to_tag;
     }
     }
 }
 
 ################################################################
 # 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[$_]} = {} if (! defined $member_groups{$category}{$$map[$_]});
         $member_groups{$category}{$$map[$_]}{$groupname} = 1;
         $group_members{$category}{$groupname}{$$map[$_]} = 1;
         } @members;
     }
     } else {
     my ($member) = $node->getAttribute("member");
     $member_groups{$category}{$member} = {} if (! defined $member_groups{$category}{$member});
     $member_groups{$category}{$member}{$groupname} = 1;
     $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);
     }
     if ($category_of_items_to_add ne '' && $parent_of_items_to_add ne '') {
     foreach my $item (@items_to_add) {
         $member_groups{$category_of_items_to_add}{$item}{$parent_of_items_to_add} = 1;
         $group_members{$category_of_items_to_add}{$parent_of_items_to_add}{$item} = 1;
     }
     }
 }
 
 ################################################################
 # 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 (@groups) = keys %{$member_groups{$category}{$member}};
         foreach my $group (@groups) {
             delete $member_groups{$category}{$member}{$group};
             if (scalar %{$member_groups{$category}{$member}} == 0) {
             print STDERR "      Deleting empty member-group $member\n";
             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 (@{$categories{"members_list"}}) {
     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}});
             if ($val ne '') {
             $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};
 #       print STDERR "************ $cat\n";
         foreach my $group (sort keys %$groups) {
 #       print STDERR "\n  ++ $group\n";
 #       print STDERR "        ", join("\n        ", map {"$_|$category_map{$cat}{$_}"} keys %{$$groups{$group}}), "\n";
 #       print STDERR "\n";
         my ($val) = join(",", sort {$a <=> $b} map {$category_map{$cat}{$_}} keys %{$$groups{$group}});
 #       print STDERR "\n   ----\n";
         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();
 }
 
 sub check_argv(;$$) {
     my ($min_argv, $exact) = @_;
     if ($#ARGV < $min_argv || ($exact && $#ARGV != $min_argv)) {
     usage();
     }
 }
 
 check_argv(1);
 
 my ($command) = shift @ARGV;
 my ($src) = $ARGV[0];
 my ($merge);
 $last_pass = 0;
 $command = lc $command;
 $command =~ s/-/_/g;
 if ($command eq "clean") {
     check_argv(0, 1);
 } elsif ($command eq "merge") {
     check_argv(1, 1);
     $src = $ARGV[1];
     $merge = $ARGV[0];
     $last_pass = 1;
 } elsif ($command eq "add_category_item") {
     check_argv(2);
     shift @ARGV;
     $category_of_items_to_add = shift @ARGV;
     if ($ARGV[0] eq '--parent') {
     shift @ARGV;
     check_argv(1);
     $parent_of_items_to_add = shift @ARGV;
     }
     @items_to_add = @ARGV;
 } elsif ($command eq "tag_files" || $command eq "untag_files") {
     if ($command eq "untag" || $command eq "untag_files") {
     $tag_instead_of_untag = 0;
     }
     check_argv(2);
     shift @ARGV;
     $category_of_items_to_tag = shift @ARGV;
     @items_to_tag = @ARGV;
     map { $map_items_to_tag{$_} = 1; } @items_to_tag;
     while (<STDIN>) {
     chomp;
     push @files_to_tag, $_ if ($_ ne '')
     }
 } 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";
 }