#!/usr/bin/perl

use Data::Dumper;
use strict;
use XML::Simple;
use File::Path qw(mkpath);

my %opts = ( r => '^(sm/|.+/sm/)',
	     C => 'Tokens',
	     k => 'KPhotoAlbum');
LocalGetOptions(\%opts,
   ['c=s', 'Configuration file'],
   '',
   ['m=s', 'tagmove spec;  tag=dir,tag2=dir2'],
   ['copy','  Copy instead of move'],
   '',
   ['C=s', 'Category to use (default = "Tokens")'],
   ['l',   'List categories'],
   ['L',   'List values of the category'],
   '',
   ['p=s', 'path REGEXP to match against'],
   ['r=s', 'REGEXP pattern to ignore files'],
   '',
   ['v',   'Verbose'],
   ['n',   'Do not actually do anything'],
   ['k',   'DB name (KPhotoAlbum is default; KimDaBa is the older)'],
   '',
   ['h|help','Command line help']) || die "bad options";

die "You need to specifiy a kimdaba index file (-c)" if (!$opts{'c'});

my $doc = XMLin($opts{'c'}, ForceArray => 1, KeyAttr => 'bogus');

if ($opts{'l'}) {
    my $cats = $doc->{'Categories'}[0]{'Category'};
    print "Category names found in $opts{c}:\n";
    my @catnames;
    foreach my $cat (@$cats) {
	push @catnames, $cat->{'name'}
    }
    print "  ", join("\n  ", @catnames, "\n");
    exit;
}

if ($opts{'L'}) {
    my $cats = $doc->{'Categories'}[0]{'Category'};
    my $foundit;

    foreach my $cat (@$cats) {
	$foundit = $cat if ($cat->{'name'} eq $opts{'C'});
    }
    die "no such category: $opts{'C'}\n" if (!defined($foundit));

    my @values;
    foreach my $val (@{$foundit->{'value'}}) {
	push @values, $val->{'value'};
    }

    print "Values found in category \"$opts{'C'}\":\n";
    print "  ",join("\n  ", @values),"\n";
    exit;
}

my $images = $doc->{'images'}[0]{'image'};

die "You didn't specify a -move spec (-m)" if (!$opts{'m'});

my %moves = split(/[,=]/,$opts{'m'});

# my @moves=split(/,/,$opts{'m'});
# map { my ($a, $b) = split(/=/,$_);
#       $moves{$a} = $b } @moves;

#print Dumper(\%moves);

foreach my $img (@$images) {
#    next if (! -f $img->{'file'});
    next if ($opts{'r'} && $img->{'file'} =~ /$opts{'r'}/);
    next if ($opts{'p'} && $img->{'file'} !~ /$opts{'p'}/);
    Verbose("img: ",$img->{'file'},"\n");
    my $moved = 0;
    my $opt;
    foreach my $possibility (@{$img->{'options'}[0]{'option'}}) {
	if ($possibility->{'name'} eq $opts{'C'}) {
	    $opt = $possibility;
	    last;
	}
    }
    my %hastokens;
    foreach my $tok (@{$opt->{'value'}}) {
	Verbose("  tokens:",$tok->{'value'},"\n");
	$hastokens{$tok->{'value'}} = 1;
	if (exists($moves{$tok->{'value'}})) {
	    Move($img->{'file'},
		 $moves{$tok->{'value'}} || $moves{"-" . $tok->{'value'}},
		 $img);
	    $moved = 1;
	    last;
	}
    }
    if (!$moved) {
	Verbose("  no match\n");
	if (exists($moves{'none'})) {
	    Move($img->{'file'}, $moves{'none'}, $img);
	}
	foreach my $tok (keys(%moves)) {
	    next if ($tok !~ /^-/);
	    $tok =~ s/^-//;
	    next if (exists($hastokens{$tok}));
	    Move($img->{'file'}, $moves{"-".$tok}, $img);
	}
    }
}

if (!$opts{'n'} && !$opts{'copy'}) {
    # save the original file as a backup.
    my $baknum = 1;
    while (-f "$opts{'c'}.bak$baknum") {
	$baknum++;
    }
    rename($opts{'c'}, "$opts{'c'}.bak$baknum");

    XMLout($doc, RootName => 'KPhotoAlbum', OutputFile => $opts{'c'});
}

sub Verbose {
    print @_ if ($opts{'v'});
}

sub Move {
    my ($file, $dir, $img) = @_;
    my ($fdir,$fname);
    ($fdir, $fname) = ($file =~ /(.*)\/([^\/]+)$/);
#    print STDERR "$fdir,$fname,$file,$dir\n";
    $fname = $file if ($fname eq '' && $fdir eq '');
    $fdir = '.' if ($fdir eq '');
    $dir =~ s/\%s/$fdir/g;
    if (!$opts{'n'}) {
	mkpath ("$dir/sm") if (! -d "$dir/sm");
	mkpath ("$dir/ThumbNails") if (! -d "$dir/ThumbNails");
	if ($opts{'copy'}) {
	    system("cp $fdir/$fname $dir/$fname");
	} else {
	    rename("$fdir/$fname", "$dir/$fname");
	    rename("$fdir/$fname", "$dir/$fname");
	    rename("$fdir/sm/$fname", "$dir/sm/$fname");
	    rename("$fdir/ThumbNails/64x64-0-$fname","$dir/ThumbNails/$fname");
	}
    }
    Verbose("  moved $fdir/$fname to $dir/$fname\n");

    my ($newd,$newf) = ($img->{'file'} =~ /(.*)\/([^\/]*)/);
    if (!$newd && !$newf) {
	$newf = $img->{'file'};
    }
    $newd = $newd . "/" . $dir;
    $newd =~ s/^\///;
    $img->{'file'} = $dir . "/" . $newf;
}

#######################################################################
# Getopt::GUI::Long optionality
#

sub LocalGetOptions {
    if (eval {require Getopt::GUI::Long;}) {
  	import Getopt::GUI::Long;
        # optional configure call
	Getopt::GUI::Long::Configure(qw(display_help no_ignore_case));
  	return GetOptions(@_);
    }
    require Getopt::Long;
    import Getopt::Long;
    # optional configure call
    Getopt::Long::Configure(qw(auto_help no_ignore_case));
    GetOptions(LocalOptionsMap(@_));
}

sub LocalOptionsMap {
    my ($st, $cb, @opts) = ((ref($_[0]) eq 'HASH') 
  			    ? (1, 1, $_[0]) : (0, 2));
    for (my $i = $st; $i <= $#_; $i += $cb) {
  	if ($_[$i]) {
	    next if (ref($_[$i]) eq 'ARRAY' && $_[$i][0] =~ /^GUI:/);
  	    push @opts, ((ref($_[$i]) eq 'ARRAY') ? $_[$i][0] : $_[$i]);
  	    push @opts, $_[$i+1] if ($cb == 2);
  	}
    }
    return @opts;
}

=pod

=head1 NAME

kimdbtokenmove - Moves kimdaba images from directory to directory 

=head1 SYNOPSIS

 # lists all Categories in a kimdaba DB file

 % kimdbtokenmove -l -c index.xml
 Category names found in index.xml:
  Keywords
  Locations
  Persons
  Animals
  Events
  Folder
  Tokens

 # lists all values within a given category in a kimdaba DB file

 % kimdbtokenmove -L -c index.xml -C Events
 Values found in category "Events":
  Graduation
  Birthday
  Christmas
  Halloween
  Easter

 # moves all images tagged with 'Birthday' into one directory, and all
 # images tagged with 'Christmas' into another:

 % kimdbtokenmove -c index.xml -C Events \
     -m Birthday=birthdaydir,Christmas=christmasdir

 # the same thing, but only for files originally found in "subdir1"

 % kimdbtokenmove -c index.xml -C Events -p subdir1 \
     -m Birthday=birthdaydir,Christmas=christmasdir

 # the same thing, but only for files that don't contain "dontmove" in
 # the name or path to it.

 % kimdbtokenmove -c index.xml -C Events -p subdir1 -r dontmove \
     -m Birthday=birthdaydir,Christmas=christmasdir

=head1 OPTIONS

=over

=item -c KIMDB

The kimdaba database file to look at and modify.

=item -m tag1=dir1,tag2=dir2,...

The move specifications.  Images tagged with tag1 are moved into dir1,
etc.  A special keyword of "none" means move it if no tags exist for
it.  If a '-' sign is prepended to a tag, a file is only moved if it
does B<not> contain that tag.

=item -C CATEGORY

The category that the tags in the -m flag should match in.  This
defaults to 'Tokens'.

=item -l

List categories found in a kimdaba db file (eg index.xml)

=item -L

List values found in a given category in a kimdaba db file (eg index.xml).  You should specify the category using the -C switch.

=item -p PATHREGEX

Only consider moving files matching the PATHREGEX.

=item -r PATHREGEX

Ignore any file matching PATHREGEX

=item -v

Verbose mode

=item -n

Don't actually do anything.  Useful with the -v flag to verify it's
going to do what you want.

=item -h

Usage information.

=back

=head1 AUTHOR

Wes Hardaker <hardaker@users.sourceforge.net>

=head1 COPYRIGHT

Copyright (c) 2005-2009  Wes Hardaker.  All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut