# Copyright 2005 Jean-Michel Fayard jmfayard_at_gmail.com
# Put into the public domain.
#

package Image::Kimdaba; 
use strict;
use warnings;
use XML::Parser;
use Carp;

=head1 NAME

Image::Kimdaba - Parser for the KDE Image Database

See here : http://ktown.kde.org/kimdaba

=head1 SYNOPSIS 

	use Image::Kimdaba;
	use English qw( -no_match_vars ) ;
	
	my @ListOfPictures;
	
	my $folder=getRootFolder();
	parseDB( "$folder" );
	
	print "Your actual Kimdaba settings are :\n";
	while( my ($attr, $value) = each %kimdabaconfig)
	{
	    print "\t$attr => $value\n";
	}
	print "\n";
	
	my $nb1= scalar keys %imageattributes;
	my $nb2= scalar keys %imageoptions;
	print "Following options were present in your $nb1 pictures :\n";
	while( my ($option,$r_values) = each %alloptions )
	{
	    my $nb = scalar @$r_values;
	    print "\t$nb $option\n";
	}
	print "\n";
	
	local $, = "\n" ; # print bla,bla prints "bla\nbla"
	
	print "\n\n== NO Keywords  (ten first) ==\n";
	@ListOfPictures=matchAnyOption( "Keywords" => [] );
	print sort(@ListOfPictures[0..9]);
	
	print "\n\n== Holiday  ==\n";
	@ListOfPictures=matchAnyOption( "Keywords" => [ "holiday" ] );
	print sort(@ListOfPictures);
	
	print "\n\n== ANNE HELENE ==\n";
	@ListOfPictures=matchAnyOption( "Persons" => [ "Anne Helene" ] );
	print sort(@ListOfPictures);
	
	print "\n\n== ANY OF (JESPER, ANNE HELEN) ==\n";

	@ListOfPictures=matchAnyOption( "Persons" => [ "Jesper" , "Anne Helene" ] );
	print sort(@ListOfPictures);
	
	print "\n\n== ALL OF (JESPER, ANNE HELEN) ==\n";
	@ListOfPictures=matchAllOptions( "Persons" => [ "Jesper" , "Anne Helene" ] );
	print sort(@ListOfPictures);
	
	print "\n\n== PERSONS=Jesper, Locations=Mallorca ==\n";
	@ListOfPictures=matchAllOptions( 
		"Persons" => [ "Jesper" ],
		"Locations" => [ "Mallorca" ]
		);
	print sort(@ListOfPictures);
	
	
	
	$, = "" ; # print bla,bla prints "blabla"
	
	print "\n\n==Print all infos known about specific pictures\n";
	print "\n\n== Drag&Drop pictures from Kimdaba  ==\n";
	@ListOfPictures=letMeDraganddropPictures();
	printImage( $_ ) foreach @ListOfPictures;
	

=head1 DESCRIPTION

From the website : http://ktown.kde.org/kimdaba

KimDaBa or KDE Image Database is a tool which you can use to easily sort your
images. It provides many functionnalities to sort them and find them easily. 

=head2 Datastructures

The infos available in the database are directly translated in following perl datastructures.
(See the index.xml file to see how it looks like)
 
note :  the reading of man perllol is highly recommended

=head3 C<%imageattributes>	

HASH OF (url of the picture, REF. HASH OF (attribute, value) )

Now and in the rest of the document, B<url> is given locally from the root directory,
 such as "Folder1/Subfolder/img001.jpg",
it's neither file:/home/user/Images/Folder1/Subfolder1/img001.jpg nor http://www.google.com/images/logo.gif

An B<HASH> corresponding to this B<url> could be 

	(
	monthFrom=>"1",
	dayFrom=>"18",
	hourFrom=>"19",
	yearTo=>"0",
	monthTo=>"0",
	md5sum=>"7f120e3cfb698ce0d7bb6e4e454c1a8b",
	minuteFrom=>"29",
	file=>"2005-01-09-Gif/img_0290.jpg",
	label=>"img_0290",
	angle=>"0",
	dayTo=>"0",
	secondFrom=>"46",
	yearFrom=>"2005",
	description=>""
 	)

=head3 C<%imageoptions>

HASH of (url, REF. HASH OF (optoin, REF. LIST OF value) )

C<url> is given locally from the root directory, such as "Folder1/Subfolder/img001.jpg"

An C<HASH> corresponding to this C<url> could be 

	(
 	Keywords => 	[ "holiday"	],
	Locations =>	[ "Mallorca"	],
	Persons =>	[ "Anne Helene", "Jesper" ]
	)

=head3 C<%alloptions>

HASH of (option, REF. LIST of values)

Could be something like :

 	(
	Keywords =>	[ "beers", "holiday", "new wave", "silo falls over", "Anne Helene's 30 years birthday" ]m
	Locations =>	...,
	Persons	=>	...,
	OtherCategory => ...
	)

=head3 C<%membergroups>

membergroups are called categories depending on your version of Kimdaba.

HASH : (Locations => REF (HASH : USA => [ Chicago, Los Angeles ] ) )

Beware, you can have loops between membergroups.

=head3 C<%kimdabaconfig>

HASH of (attributes, values) 

Fast all KimDaBa settings are stored in the index.xml file, as attribute of the "KimDaBA/config" XML element.
So using this hash you can access many of the user preferences, for example it could be something like :

	( 
	viewSortTye=>>"0",
	passwd=>"",
	ensureImageWindowsOnScreen=>"1",
	viewerCacheSize=>"25",
	albumCategory=>"",
	showDrawings=>"1",
	htmlBaseURL=>"file:///home2/jmfayard/public_html",
	previewSize=>"256",
	thumbSize=>"64",
	displayLabels=>"1",
	launchViewerFullScreen=>"0",
	windowWidth-0=>"800",
	autoShowThumbnailView=>"0",
	showInfoBox=>"1",
	windowWidth-1=>"800",
	slideShowWidth_1280=>"600",
	viewerHeight_1280=>"450",
	fromDate=>"2005-01-01",
	htmlDestURL=>"file:///home2/jmfayard/public_html",
	trustTimeStamps=>"0",
	windowHeight-0=>"600",
	thumbNailBackgroundColor=>"#000000",
	windowHeight-1=>"600",
	slideShowInterval=>"5",
	toDate=>"2006-01-01",
	exclude=>"1",
	infoBoxPosition=>"6",
	locked=>"0",
	showDate=>"1",
	imageDirectory=>"/tmp/kimdaba-demo-jmfayard",
	searchForImagesOnStartup=>"1",
	autoSave=>"5",
	version=>"1",
	viewerWidth_1280=>"600",
	launchSlideShowFullScreen=>"0",
	showDescription=>"1",
	maxImages=>"100",
	useEXIFComments=>"1",
	useEXIFRotate=>"1",
	showTime=>"1",
	htmlBaseDir=>"/home2/jmfayard/public_html",
	slideShowHeight_1280=>"450",
	)



=head2 Fonctions

=cut

BEGIN {
    use Exporter   ();
    our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);

    $VERSION     = 0.5;
    @ISA         = qw(Exporter);
    @EXPORT      = qw(	%alloptions 	%kimdabaconfig	    	%membergroups
			%imageoptions	%imageattributes
			&printImage 		&getRootFolder		&parseDB 		
			&matchAllOptions    	&matchAnyOption		&letMeDraganddropPictures
			&askForPictures		
			&makeKimFile	    );
    %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],

    # your exported package globals go here,
    # as well as any optionally exported functions
#@EXPORT_OK   = qw(%imageoptions %imageattributes);
}
our @EXPORT_OK;

# exported package globals go here
our %imageattributes;
our %imageoptions;
our %alloptions;
our %kimdabaconfig;
our %membergroups;

# non-exported package globals go here

# initialize package globals, first exported ones
%imageattributes=();
%imageoptions=();
%alloptions=();
%kimdabaconfig=();
%membergroups=();

# then the others (which are still accessible as $Some::Module::stuff)

# all file-scoped lexicals must be created before
# the functions below that use them.

# file-private lexicals go here
my $option="" ;
my $image="";	    # image element that we currently handle
my $optionname="";	    # currently handle option with name $option for image $image
my @values=();	    # currently found values
my %alloptionshashed;
my $folder;	    # I need it for askForPictures



=head3 C<&letMeDraganddropPictures()>

	print "\n\n== Drag&Drop pictures from Kimdaba  ==\n";
	@ListOfPictures = &letMeDraganddropPictures();

Wait until the user drag and drop pictures from Kimdaba and Konqueror
and return a list of url.

=cut

sub letMeDraganddropPictures
{
    my @res=();
    my $line=<STDIN>;
    chomp $line;
    # for pictures having a "'" in their filename
    $line=~s#'\\''#\\#g;
    my @a = ( $line =~ m/'[^']+'/g );
    
    my $folder2 = $kimdabaconfig{"imageDirectory"}; 
    foreach (@a) 
    {	# Change '/autre/Photos/USA/2004-08-09_Monument_Valley/Monument_Valley_05.JPG'
	# in			USA/2004-08-09_Monument_Valley/Monument_Valley_05.JPG
	s#$folder##;
	s#$folder2##;		# in case where $folder="." or similar
	s#(file:)?/+##;
	s#^'## ; 
	s#'$## ; 
	s#\\#'#g; 
	push @res, $_;
    }

# Now check which urls are really correct :
    @res	=grep {  exists $imageoptions{$_} } @res;
    return @res;
}


##########

=head3 C<< &matchAllOptions(HASH of (option => REF List of values)) >>

Returns a list of urls. See the example in the synopsis.

=head3 C<< &matchAnyOption(HASH of (option => REF List of values)) >>

Returns a list of urls. See the example in the synopsis.

=cut

sub matchAllOptions
{
    return @{ matchOptions( 1, @_) };
}
sub matchAnyOption
{
    return @{ matchOptions( 0, @_) };
}

sub matchOptions
{
    my ($matchall, %request)=@_;
    my @urlsfound=();
    my @checkoptions=keys %request;
URL:    for my $url (keys %imageattributes) 
    {
	my %options = ();
	%options= %{ $imageoptions{$url} } if (exists $imageoptions{$url} );
OPTION:	for my $option ( @checkoptions )		     
	{
	    unless (exists $options{$option} ) {
		if ( scalar @{ $request{$option} } == 0 ) {
		    next OPTION;
		} else {
		    next URL;
		}
	    }
			

	    my @values_image   =@{ $options{$option} };		    # (Anne Helen)
	    my @values_searched=@{ $request{$option} };		    # (Jesper, Anne Helen)
	    for my $req (@values_searched)		    
	    {
		my $res = scalar grep { $_ eq $req } @values_image;
		if ( ($res == 0) && ($matchall) ) {
		    next URL;
		} elsif ( ($res!=0) && (!$matchall) ) {		    # if trouvé, here
		    next OPTION;
		}
	    }
		
	    # If we went this far, this means that we...
	    if ($matchall) {
		next OPTION; # ... found a value corresponding to each of the options
	    } else {
		next URL;    # ... never found a value corresponding to one of the options
	    }
	}
	push @urlsfound, $url;
	
    }
    return [ @urlsfound ];	
}

=head3 C<&getRootFolder()>

	my $folder=getRootFolder();
	parseDB( "$folder" );

Returns the absolute path of the root directory.
You should run the demo, keep the files, and use /tmp/kimdaba-demo-$USER
when you are experimenting.
Thanks to this function, the root directory can 
- passed as first argument on the command line ($ kim_script /tmp/kimdaba-demo-$USER )
- or will be asked to the user

=head3 C<&parseDB( $folder )>

Readonly access to most information available in the index.xml file.
To modify a database, see B<&makeKimFile()>

=cut

sub getRootFolder
{
    no warnings;
    ($folder) = grep { -d } @main::ARGV;
    $folder = "~/Images"    unless (-d $folder );
    $folder = $ENV{PWD}	    unless (-d $folder );
    until ( (-d "$folder") && (-r "$folder/index.xml") )
    {
        print "In which folder are your pictures stored ?\n";
        chomp( $folder=<STDIN>);
    }
    return $folder;
}

=head3 C<&printImage( url )>

	printImage( $url );

Interesting to debug. Its code also shows how to access the hashes %imageattributes and %imageoptions :

	sub printImage {
	    my ($file)= @_;
	
	    print "=== $file ===\n" ;
	    print "Attributes : ";
	    my %attributes = %{ $imageattributes{$file} } ;
	    while( my ($attr, $value) = each( %attributes ) )
	    {
		print " $attr=>$value ; ";
	    }
	    print "\n";
		
	    my %options = %{ $imageoptions{$file} };
	    print "Options: \n" ;
	    while( my ($key, $r_values) = each( %options ) )
	    {
		print "\t$key ==> ", join('; ', @$r_values ) , "\n";
	    }
	    print "\n";
	}

=cut

sub printImage {
    my ($file)= @_;

    print "=== $file ===\n" ;
    print "Attributes : ";
    my %attributes = %{ $imageattributes{$file} } ;
    while( my ($attr, $value) = each( %attributes ) )
#    for my $attr ( keys %{ $imageattributes{$file} } )
    {
	print " $attr=>$value ; ";
    }
    print "\n";
	
    my %options = %{ $imageoptions{$file} };
    print "Options: \n" ;
#    for my $key ( sort keys %options ) 
    while( my ($key, $r_values) = each( %options ) )
    {
	print "\t$key ==> ", join('; ', @$r_values ) , "\n";
    }
    print "\n";
}




##### <Parsing of the database goes here> ######
sub parseDB ($)  
{
    my ($folder)=@_;
    my $p1 = new XML::Parser(
	Style => 'Subs'
    );
    croak "Can not find KimDaBa's database"
	unless (-r "$folder/index.xml");
    $p1->parsefile( "$folder/index.xml");
}
sub member {
    my ( $p, $el, %attrs ) = @_ ;
    my ($groupname,$member) = 
	( $attrs{"group-name"}, $attrs{"member"} );
    # index.xml format has changed at Fri Dec 3
    my $category=$attrs{"option-group"} if ( exists $attrs{"option-group"}  );
    $category=$attrs{"category"} if ( exists $attrs{"category"}  );
	
    if (! exists( $membergroups{$category} ) ) {
	$membergroups{$category} = {
	    $groupname => [ $member ]
	};
	    
    } elsif (! exists( $membergroups{$category}{$groupname} ) ) {
	$membergroups{$category}{$groupname} =  [ $member ]  ;
    } else {
	my $r_list =  $membergroups{$category}{$groupname};
	push @$r_list, $member;
    }
}

sub config {
    my ( $p, $el, %attrs ) = @_ ;
    %kimdabaconfig=%attrs;
}
sub image {
    my ( $p, $el, %attrs ) = @_ ;
    $image = $attrs{"file"} ;
    $imageattributes{$image} = \%attrs;
}
sub image_ {
    my ( $p, $el ) = @_;
    $image = "";
}
	
sub options {
    my ( $p, $el, %attrs ) = @_ ;
    return  if ($image eq "") ;	# We are in KimDaBa>config>SearchInfo>Options>Option
				# or in KimDaBa>Options
    $imageoptions{$image} = {} ;
}    
sub option {
    my ( $p, $el, %attrs ) = @_ ;
    return  if ($image eq "") ;	# We are in KimDaBa>config>SearchInfo>Options>Option
				# or in KimDaBa>Options
    $optionname=$attrs{"name"};	
    @values=();
}
sub option_ {
    my ( $p, $el ) = @_;
    if ($image eq "") {
	$optionname="";
	return;
    }
    $imageoptions{$image}->{$optionname} = [ @values ];
    $alloptionshashed{$optionname} = {} 
	unless( exists $alloptionshashed{$optionname} );
    for my $value (@values) {
	$alloptionshashed{$optionname}{$value}=1;
    }
    $optionname="";
}

sub value {
    my ( $p, $el, %attrs ) = @_ ;
    return if ( $optionname eq "" ) ;
    push @values, $attrs{"value"};
}
sub KimDaBa_ {
# %alloptionshashed is hash of hash for efficiency reasons, but we want to return
# a more clean hash of list.
    my $nb= scalar %alloptionshashed;
    for (keys %alloptionshashed) {
	$alloptions{ $_ } = [ keys %{ $alloptionshashed{$_} } ];
    }
}
##### <Parsing of the database ends here> ######




=head3 C<&makeKimFile( $destdir, $name, @list )>

Instead of modifying directly the database (which could easily be dangerous
for your data), you write a kimdaba export file (*.kim)
then you use the import fonction in kimdaba (no dangerous, you are in control)

A .kim file is a zip archive containning an index.xml file, and
a Thumbnail directory. You just have to create the index.xml file 
(say in '/tmp') then you call :

  C<makeKimFile( "/tmp", "perl_output.kim", @ListOfPictures );>

where 

	/tmp/index.xml 		is the file created by you
	/tmp/perl_output.kim	is the resulting kimdaba import ile
	@ListOfPictures		is a list of urls present in /tmp/index.xml

Not that the KimDaBa import feature has some limitations.

Example :

	use Image::Kimdaba;
	
	my @ListOfPictures;
	
	my $folder=getRootFolder();
	parseDB( "$folder" );
	
	print "\n\n== Drag&Drop pictures from Kimdaba  ==\n";
	@ListOfPictures=letMeDraganddropPictures();
	print join("\n", sort(@ListOfPictures));
	print "--\n";
	
	my $destdir="/tmp";
	open( EXPORT, "> ${destdir}/index.xml");
	print EXPORT <<FIN
	<?xml version="1.0" encoding="UTF-8"?>
	<KimDaBa-export location="external" >
	FIN
	;
	
	for my $url (@ListOfPictures)
	{
	    my $description="yeah! I changed the description";
	    my $md5sum="";
	    if (
		(exists $imageattributes{$url})
		&&
		(exists $imageattributes{$url}{'md5sum'})
		&&
		(! $imageattributes{$url}{'md5sum'} eq "")
	       )
	    {
		$md5sum="md5sum=\"$imageattributes{$url}{'md5sum'}\" ";
	    }
		
	    
	    my $value="Test Add Another Keyword";
	    print EXPORT <<FIN
	 <image description="$description" $md5sum file="$url" >
	  <options>
	   <option name="Keywords" >
	    <value value="Test Add a keyword" />
	    <value value="$value" />
	   </option>
	  </options>
	 </image>
	FIN
	    ;
	}
	
	print EXPORT <<FIN
	</KimDaBa-export>
	FIN
	;
	close( EXPORT );
	
	
	makeKimFile( $destdir, "perl_export.kim", @ListOfPictures);


=cut

sub makeKimFile
{
    my ($destdir,$name,@ListOfPictures)=@_;
    system( "rm -rf   ${destdir}/Thumbnails" );
    system( "mkdir -p ${destdir}/Thumbnails" );
    for my $url (@ListOfPictures)
    {
	next unless( -e "${folder}/${url}" );
#	( my $dest = $url) =~ s#(.*)/(.*)#\2#;
	my ($dirname,$basename) = ( $url =~ m#(.*)/(.*)# );
	my $thumb="${folder}/${dirname}/ThumbNails/"
		. "$kimdabaconfig{'thumbSize'}x$kimdabaconfig{'thumbSize'}"
		. "-$imageattributes{$url}{'angle'}"
		. "-$basename";
	if (-e $thumb) {
	    my $a=symlink $thumb, "${destdir}/Thumbnails/$basename";
	    next;
	}
	print "Creating thumbnail for $url...\n";
	$url=~s/'/'\\''/g;
	$basename=~s/'/'\\''/g;
	system(
"convert -size 128x128 '$folder/$url' -resize 128x128  '${destdir}/Thumbnails/$basename'"
);
    }
    chdir $destdir or croak "$!";
    unlink $name;
    system( "zip", "-r", $name, "index.xml", "Thumbnails" );
    print "KimDaBa export file created : ${destdir}/${name}\n";
}


1;  # don't forget to return a true value from the file




# Desactived for now, because it's rather pointless and adds a dependcy on Term::Readline

##sub askForPictures
##{
##    my @res;
##    print <<EOF
##Now specify a list of urls of pictures that this script will handle.
##You can write any perl code. Then Ctrl-D when you are done.
##Common examples:
##    # simple list
##    \@res=( "img004.jpg" , "img006.jpg" , "img010.jpg" );
##    # pictures not on disk
##    \@res=grep { ! -e "$folder/\$_" } keys \%imageoptions;
##    # pictures rotated in Kimdaba but not in the real life
##    @res=grep {  $imageattributes{$_}{"angle"}!=0 } keys %imageattributes;
##    # kimdaba's queries
##    \@res=matchAllOptions( "Persons" => [ "Jesper" , "Anne Helene" ] );
##    \@res=matchAllOptions( "Persons" => [ "Jesper" ], "Locations" => [ "Mallorca" ]);
##    \@res=matchAnyOption( "Keywords" => [ "ForMyScript" ] );
##
##EOF
##;
##  use Term::ReadLine;
##  my $term = new Term::ReadLine 'Kimdaba Query';
##  my $prompt = "Kim> ";
##  my $OUT = $term->OUT || \*STDOUT;
##    
##  while(1)
##  {
##      while ( defined (my $perlcode = $term->readline($prompt)) ) {
##	  my $res = eval ($perlcode);
##	  warn $@ if $@;
##	  print $OUT $res, "\n" unless $@;
##	  $term->addhistory($_) if /\S/;
##      }
##
### Now check which urls are really correct :
##    @res=grep { exists $imageoptions{$_} } @res;
##    print "Following pictures were found\n";
##    print join("\n",@res),"\n\n";
##    print "Continue with those picutres? [yes]/no : ";
##    $_=<STDIN>;
##    /no/ or last;
##    }
##    return @res;
##}

=head1 BUGS/CAVEATS/etc 

A lot ;-)

=head1 AUTHOR 

Jean-Michel Fayard ; jmfayard{at}moufrei.de

=head1 SEE ALSO 

B<perllol>