#!/usr/bin/perl
# Copyright 2020 Robert Krawitz <rlk@alum.mit.edu>

# 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.

# 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";
}
