gnuift-perl 0.1.14-12.1 / usr / bin / gift-add-collection.pl

#!/usr/bin/perl -w # -*- mode: perl -*-

#     GIFT, a flexible content based image retrieval system.
#     Copyright (C) 1998, 1999, 2000, 2001, 2002, CUI University of Geneva

#     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; if not, write to the Free Software
#     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA


#
# This script makes GIFT index all images in a directory
# afterwards it creates an entry in the gift config file.
# 

use XML::DOM;
use XML::XQL;
use XML::XQL::DOM;
use Getopt::Long;
use IO::File;
use XML::Writer;
use POSIX;
use File::Find;
use File::Path;
use File::Copy;
use Text::Iconv;
use POSIX qw(tmpnam);
use strict;
use vars qw($self
	
	    $llTemp
	    $llFullName
    
	    $lFullName
	    $lName
	    $lExtension

	    *FH

	    $lCountPotentialImages
	    $lCountVisitedImages
	    $lImageDirectory
	    $lImageDirectory
	    $lCollectionName
	    $lFeaturePrefix
	    $lIndexPrefix
	    $lThumbnailDirectory
	    $lURLPrefix
	    $lThumbnailURLPrefix
	    $gGiftHome
	    $OLDCONFIG
	    $CONFIG
	    $lOptionList
	    %lOptions
	    $i
	    $lIndexPrefix
	    $url2fts_name
	    $URL2FTS
	    $lURL
	    $lFts
	    $lThumbnailURL
	    $lThumbnailFile
	    $gStringConverter
	    $gDoRemove
	    $gDoFixConfig
	   );


#
# first: get the options given on the command line
#
%lOptions=();

GetOptions(\%lOptions,
	   "fix-config",
	   "help",
	   "remove-collection",
	   "gift-home=s",
	   "local-encoding=s",
	   "image-directory=s",
	   "collection-name:s",
	   "feature-prefix:s",
	   "index-prefix:s",
	   "url-prefix:s",
	   "thumbnail-dir:s",
	   "thumbnail-url-prefix:s",
	   "no-png",
	   "no-gif",
	   "no-jpg",
	   "no-nps",
	   "no-ps");


my($lInEncoding,$lOutEncoding)=((!(defined($lOptions{"local-encoding"})))
  ? (&main::findOutEncodings())
  : ($lOptions{"local-encoding"},"UTF-8"));
print "I am assuming that the system is using $lInEncoding as encoding. 
Within the xml files generated, we will use $lOutEncoding as encoding method\n";

$gStringConverter = Text::Iconv->new($lInEncoding,$lOutEncoding);

#
# second: read the options from the .gift-add-collection file
# we look for this file in the GIFT_HOME directory
#
local $gDoFixConfig="";
local $lImageDirectory="";
local $lCollectionName="";
local $lFeaturePrefix="";
local $lIndexPrefix="";
local $lThumbnailDirectory="";
local $lURLPrefix="";
local $lThumbnailURLPrefix="";
local $gGiftHome= $lOptions{'gift-home'} || $gGiftHome || $ENV{GIFT_HOME} || $ENV{HOME};
local $gDoRemove="";
local $lOptionList={
		    "fix-config"           => \$gDoFixConfig,
		    "remove"               => \$gDoRemove,
		    "gift-home"            => \$gGiftHome,
		    "image-directory"      => \$lImageDirectory,
		    "collection-name"      => \$lCollectionName,
		    "feature-prefix"       => \$lFeaturePrefix,
		    "index-prefix"         => \$lIndexPrefix,
		    "thumbnail-dir"        => \$lThumbnailDirectory,
		    "url-prefix"           => \$lURLPrefix,
		    "thumbnail-url-prefix" => \$lThumbnailURLPrefix
		   };

unless(open DOT_FILE,"$ENV{HOME}/.gift-add-collection"){
  print STDERR "File $ENV{HOME}/.gift-add-collection could not be opened ($!), so I won't use it\n";
}else{
  {
    while (<DOT_FILE>) {
      chomp;
      foreach $i (keys %$lOptionList) {
	next if m/^\#/;		#skip comments
	eval("if(m/^$i=\\\"(.*)\\\"/){\${\$lOptionList->{\$i}}=\$1;}");
	
      }
    }
    foreach $i (keys %$lOptionList) {
      print "$i => ${$lOptionList->{$i}}\n" if $ {$lOptionList->{$i}};
    }
    ;
  }
}

# do we want to remove a collection
if($lOptions{'remove-collection'}){
  $gDoRemove=1;
}
# do we want to remove a collection
if($lOptions{'fix-config'}){
  $gDoFixConfig=1;
}

#
#
#
#unless($gDoRemove)$gGiftHome= $lOptions{'gift-home'} || $gGiftHome || $ENV{GIFT_HOME} || $ENV{HOME};


#
# old position of copy gift-config.mrml and write gift-embed-perl-modules
#

$lImageDirectory= $lOptions{'image-directory'} || $ARGV[0] || $lImageDirectory || $ENV{PWD} ;
$lImageDirectory=$ENV{PWD}.$lImageDirectory unless $lImageDirectory=~m[^/];
$lImageDirectory=$lImageDirectory."/";
$lImageDirectory=~s[ /+ ][/]gx;	#removing double backslashes in the end
$lImageDirectory=~s[^([^/])][$ENV{PWD}/$1]x; #making path absolute

#take the last bit of the directory as database name
$lCollectionName= $lOptions{'collection-name'} || $lCollectionName || (split("/",$lImageDirectory))[-1];

#$lCollectionName=~s§$gGiftHome§§;

$lFeaturePrefix=      $lOptions{'feature-prefix'} || $lFeaturePrefix || "$gGiftHome/gift-indexing-data/$lCollectionName/";
$lURLPrefix=          $lOptions{'url-prefix'}     || $lURLPrefix     || "file:$lImageDirectory";

# is the urlprefix in ~/public_html? create a http-url!
$lURLPrefix=~s[^file:/var/www/gnuift/][http://localhost/gnuift//];

if ($lOptions{'thumbnail-dir'}) {
  $lThumbnailDirectory= $lOptions{'thumbnail-dir'} || $lThumbnailDirectory;
  $lThumbnailDirectory=~s[ /+$ ][/]x; #removing double backslashes in the end
  $lThumbnailDirectory=~s[^([^/])][$ENV{PWD}/$1]x; #making path absolute
} else {
  unless($lThumbnailDirectory){
    $lThumbnailDirectory= $lImageDirectory ;
    $lThumbnailDirectory=~s[ /*$ ][_thumbnails]x;	#strip trailing slashes and add thumbnails
  }
}

#$lThumbnailURLPrefix= $lOptions{'thumbnail-url-prefix'} || $lOptions{'url-prefix'} || "file:$lThumbnailDirectory";
$lThumbnailURLPrefix= $lOptions{'thumbnail-url-prefix'} 
  || $lThumbnailURLPrefix 
  || $lOptions{'url-prefix'} 
  || $lURLPrefix     
  || "file:$lThumbnailDirectory";

#cleanup: if there is no "thumbnails" in the end of the url,
# but there is thumbnails in the end of the directory
# automatically add that

if(($lThumbnailDirectory=~m/_thumbnails$ /x)
   && (!($lThumbnailURLPrefix=~m[^(.*)_thumbnails/*$ ]x))){
  $lThumbnailURLPrefix=~s[/*$ ][_thumbnails/]x;
}

# is the thumbnail-urlprefix in ~/public_html? create a http-url!
$lThumbnailURLPrefix=~s[^file:/var/www/gnuift/][http://localhost/gnuift//];

$lIndexPrefix= $lOptions{'index-prefix'} || $lIndexPrefix || $lFeaturePrefix;

# we asume that the lIndexPrefix ends with 
# a "/" throughout the program
$lIndexPrefix.="/" unless($lIndexPrefix=~m[ /$ ]x);
  
#
# replace variables:
#
foreach $i (values %$lOptionList) {
  $$i=~s/\@collection-name\@/$lCollectionName/g;
}


if ($lOptions{help}) {
  print "
gift-add-collection [options] [image-directory]: Add an image collection to your gift database.

THE FOLLOWING LIST OF OPTIONS ALSO SHOWS THE CURRENT VALUES AND TAKES 
OPTIONS BESIDES --help INTO ACCOUNT. IT IS A USEFUL TOOL FOR FINDING OUT HOW 
gift-add-collection WORKS.

Options (options override .gift-add-collection entries):

--gift-home                   Specify the directory which contains the configuration
                              to which you are adding a collection. By default either
                              GIFT_HOME (current value \"$ENV{GIFT_HOME}\") or 
                              HOME (current value \"$ENV{HOME}\"). 
                              The current value is \"$gGiftHome\"

--image-directory             All images in this directory will be indexed.
                              Same as giving image-directory after the options
                              Default:  \$PWD, 
                              Current value:  $lImageDirectory


--collection-name             Name of the new collection to be generated. Default
                              is full path of the image directory. 
                              Current value:  $lCollectionName

--feature-prefix              Feature data will be written into this directory.
                              Current value:  $lFeaturePrefix

--index-prefix                Indexing data will be written into this directory
                              Default: $lIndexPrefix 
                              (in general:same as given by --feature-prefix)

--thumbnail-dir               Thumbnails will be put into this directory: 
                              Current value:  $lThumbnailDirectory
                              (in general:same as given by the name 
                              'image-directory'_thumbnails)
                              Current value: $lThumbnailDirectory 

--fix-config                  Fixes the config file by adjusting the collection used
                              by the default query algorithm. If GIFT complains to 
                              you about an unknown collection with ID __COLLECTION__,
                              that's the thing to do.

Change here, if you want to make a database accessible from the WWW

--url-prefix                  This URL-trunc will be prepended
                              to the file names generated. Default:
                              file:-URL to images
                              Current value: $lURLPrefix
                              
--thumbnail-url-prefix        This URL-trunc will be prepended
                              to the thumbnail file names generated.
                              file:-URL to thumbnails
                              Current value: $lThumbnailURLPrefix


If this script recognizes that you are indexing files in public_html,
it will automatically generate http://localhost/~$ENV{HOME} URLs.

Options override the contents of 
$ENV{HOME}/.gift-add-collection
";
  exit 0;
}

unless(-e "$gGiftHome/gift-config.mrml"){
  copy("/usr/share/gift-config.mrml",
       "$gGiftHome/gift-config.mrml");
}

unless(-e "$gGiftHome/gift-embed-perl-modules.pl"){
  open PM_OUTFILE,">$gGiftHome/gift-embed-perl-modules.pl" 
    or die "Could not write file $gGiftHome/gift-embed-perl-modules.pl";
  
  print PM_OUTFILE "
#
# This file was automatically generated
# by the GNU Image-Finding Tool (GIFT).
#
# It should contain 'use' instructions for ALL modules
# you want to use from within the GIFT.
#
# You also have to add 'use lib' instructions where 
# necessary
#
use lib '/usr/bin';

use CGIFTLink;
";
}

mkpath([$lThumbnailDirectory],1,0755);
mkpath([$lIndexPrefix,$lFeaturePrefix],1,0711);

print 
  "

 I will read the images in:
 $lImageDirectory

 I will generate feature files which I put into:
 $lFeaturePrefix

 The index files will be stored in:
 $lIndexPrefix

 The URLs I will generate will have the prefix:
 $lURLPrefix

";



unless($gDoRemove || $gDoFixConfig){
  $url2fts_name=">${lIndexPrefix}/url2fts.xml";
  $URL2FTS=new IO::File($url2fts_name) or die "Could not open database $url2fts_name for output!";
  
  local $self={};
  
  $self->{writer}=new XML::Writer( OUTPUT => $URL2FTS,
				   DATA_MODE => 1,
				   DATA_INDENT => 2 );
  $self->{writer}->xmlDecl("UTF-8","yes");
  
  $self->{writer}->startTag("image-list");  
  
  $main::lImageCount=0;
  
  $main::gModifyingDateOfThis=(stat($0))[9];
  print "This file was last modified $main::gModifyingDateOfThis after the epoch\n";
  
  print "Estimating how many images we are going to index: ";
  $lCountPotentialImages=0;
  find(\&countPotentialImages,$lImageDirectory);
  print "$lCountPotentialImages\n";
  $lCountVisitedImages=0;
  find(\&wanted,$lImageDirectory);
  
  $self->{writer}->endTag("image-list");  
  $URL2FTS=0; #close the file
  
  sub countPotentialImages{
    my $lFullName=$File::Find::name;
    
    my $lName=$lFullName;
    
    $lName=~m§\.([^\.]*)$§;
    my $lExtension=$1;
    
    
    if ($lExtension && $lExtension=~m/^((tif)|(tiff)|(ppm)|(gif)|(jpg)|(jpeg)|(eps)|(png)|(ras))$ /xi) {
      $main::lCountPotentialImages++;
    }
  }

  sub wanted{
    local $lFullName=$File::Find::name;
    
    local $lName=$lFullName;
    
    $lName=~s[^$lImageDirectory][];
    
    $lName=~m§\.([^\.]*)$§;
    local $lExtension=$1;
    
    
    if ($lExtension && $lExtension=~m/^((tif)|(tiff)|(ppm)|(gif)|(jpg)|(jpeg)|(eps)|(png)|(ras))$/i) {
      eval{
	
	my $lNameBase=$lName;
	$lNameBase=~s§\.$lExtension$§§;
	
	
	$lURL="$lURLPrefix/$lName";
	$lFts="$lFeaturePrefix/${lNameBase}_$lExtension.fts";
	#the actual location of the thumbnail
	$lThumbnailFile="$lThumbnailDirectory/${lNameBase}_thumbnail_$lExtension.jpg";
	$lThumbnailURL ="$lThumbnailURLPrefix/${lNameBase}_thumbnail_$lExtension.jpg";
	
	print         "$lURL $lFts\n";
	
	my $lURL2FTSLine="$lURL $lThumbnailURL $lFts\n";
	$lURL2FTSLine=~s§/+§/§g;
	$lURL2FTSLine=~s§http:/§http://§g;
	
	my $i;
	foreach $i  ($lURL,
		     $lThumbnailURL) {
	  #escaping the URL
	  $i=~s[//][/]g;
	  $i=~s[^http:/][http://];
	  $i=~s[ ][%20]g;
	  
	  $i=safeConvertString($i);
	}
	
	
	
	
	print "lURLPrefix: $lURLPrefix lNameBase: $lNameBase lExtension: $lExtension\n";
	
	# uniqueness of names given by process id 
	# the variable containing the process id of this script 
	# is $$
	my $lTemp="/tmp/gift_tmp$$.ppm";
	my $lTempFts="/tmp/gift_tmp$$.fts";
	
	print "This script was last modified on $main::gModifyingDateOfThis\n";
	
	my $lThumbnailModificationTime=(stat($lThumbnailFile))[9];
	
	if (!-e($lThumbnailFile)
	    || $lThumbnailModificationTime<$main::gModifyingDateOfThis) {
	  $lThumbnailFile=~m§^(.*/)([^/]*)$§;
	  print($lThumbnailModificationTime," is the modifying date of $lThumbnailFile\n") 
	    if $lThumbnailModificationTime;
	  print("We will make a new thumbnail file\n");
	  print("making the path $1\n");
	  mkpath([$1],1,0711);
	  print("Converting $lFullName to $lThumbnailFile\n");
	  print STDERR "Warning: Thumbnail generation failed for $lThumbnailFile $!\n" 
	    if system("convert",
		      "-geometry",
		      "128x128",
		      $lFullName,
		      $lThumbnailFile);
	} else {
	  print "Warning: more recent version of thumbnail file $lThumbnailFile  found!\n";
	}
	
	my $lFtsModificationTime=(stat($lFts))[9];
	if (!(-e($lFts))
	    || ($lFtsModificationTime<$main::gModifyingDateOfThis)) {
	  if ($lFtsModificationTime) {
	    print($lFtsModificationTime," is the modifying date of $lFts file\n") 
	  }
	  print("We will make a new feature file\n");
	  print("Converting $lFullName to $lTemp\n");

	  unlink $lTemp;

	  local $llTemp=$lTemp;
	  local $llFullName=$lFullName;
	  eval{
	      if (system("convert" ,
			 "-geometry",
			 "256x256!",
			 $llFullName,
			 $llTemp)) {
		  print "Pre feature extraction convert call returned nonzero: $! \n",join(" ",("convert" ,
												"-geometry",
												"256x256!",
												$llFullName,
												$llTemp,"\n"));
	      }
	  };
	  
	  unless(-e($lTemp)){
	      die "Pre feature extraction convert call failed ",join(" ",("convert" ,
									  "-geometry",
									  "256x256!",
									  $llFullName,
									  $llTemp,"\n")) ;
	  }
	  
	  print("Extracting features from $lTemp\n");
	  
	  unlink($lTempFts);

	  eval{
	      system("/usr/bin/gift-extract-features $lTemp");
	  };
	  if(-e $lTempFts){
	      $lFts=~m§^(.*/)([^/]*)$§;
	      print("making the path $1\n");
	      mkpath([$1],1,0711);
	      print("...copying from $lTempFts to $lFts\n\n");
	      copy($lTempFts,$lFts) or print STDOUT "\nCopy $lTempFts -> $lFts failed: $!\n";
	  
	      if (!$main::lImageCount) {
		system qq(/usr/bin/gift-write-feature-descs < $lTemp |perl -e 'print "Writing InvertedFileFeatureDescription...\n";open OF,">$main::lIndexPrefix/InvertedFileFeatureDescription.db" or die "could not open $lIndexPrefix";while(<STDIN>){print OF join(" ",(split(" ",\$_))[0..1]),"\\n";};print "finished.\n";' );
		unlink $lTemp;
	      }
	      
	      $main::lImageCount++;
	      #    print "Number of images: $main::lImageCount\n\n";
	      unlink($lTemp);
	      unlink($lTempFts);
	      
	      $main::lCountVisitedImages++;
	      print "\nPROGRESS: ".$main::lCountVisitedImages." of ".$main::lCountPotentialImages." done (".POSIX::floor(90*$main::lCountVisitedImages/$main::lCountPotentialImages)."%)\n";
	    } else {
	      print "warning: Feature extraction of $lTemp to $lTempFts failed!\n";
	    }
	} else {
	  die "Feature extraction failed: $! \n" 
	}

	# 2004-03-18 add attribute line as last thing
	my $lAttributes={
			 "url-postfix" => $lURL,
			 "thumbnail-url-postfix" => $lThumbnailURL,
			 "feature-file-name" => safeConvertString($lFts)
			};
	
	
	$self->{writer}->emptyTag("image",(%{$lAttributes}));  

      };
      if ($@) {
	print STDERR "There was an error in extracting features from $File::Find::name\n";
      }
    }
  }

  
  

  #i am looking for a match of this to place the newly made data	  
  my $lTheLine='<!-- xxyx gift-add-collection xyxx DEPENDS ON THIS LINE -->';
  

  close URL2FTS;
  
  system("/usr/bin/gift-generate-inverted-file $lIndexPrefix/");
  
  print "\nPROGRESS: 99%\n";
  
  
  my $lUniqueCollectionID="c-".join("-",gmtime());
  
  {
    #rescue the old config
    $CONFIG="$gGiftHome/gift-config.mrml";
    $OLDCONFIG="${CONFIG}-old";
    copy($CONFIG,$OLDCONFIG);
    
    print "

Copying $CONFIG to $OLDCONFIG

";
    
    #before overwriting it with the new config
    
    my $lParser = new XML::DOM::Parser;
    my $lGIFTConfig = $lParser->parsefile ("$gGiftHome/gift-config.mrml") or die $!;
    
    
    if(0){
      $CONFIG=">$CONFIG";
      
      
      open OLDCONFIG or die "COULD NOT OPEN $OLDCONFIG";
      open CONFIG or die "COULD NOT OPEN $CONFIG";
      
      while (<OLDCONFIG>) {
	
	if (m/$lTheLine/) {

	  print CONFIG qq(<!-- automatically added by v_add_collection.pl -->
			  <collection 
			  collection-id="$lUniqueCollectionID" 
			  collection-name="$lCollectionName" 
			  
			  cui-algorithm-id-list-id="ail-inverted-file"
			  
			  cui-number-of-images="$main::lImageCount" 
			  cui-base-dir="${lIndexPrefix}"
			  cui-inverted-file-location="InvertedFile.db" 
			  cui-offset-file-location="InvertedFileOffset.db"
			  cui-feature-description-location=
			  "InvertedFileFeatureDescription.db"
			  cui-feature-file-location="url2fts.xml"
			  >
			  <query-paradigm-list>
			  <query-paradigm type="inverted-file"/>
			  <query-paradigm type="perl-demo"/>
			  </query-paradigm-list>
			  </collection>
			  \n\n);
	}
	
	s/\_\_COLLECTION\_\_/$lUniqueCollectionID/g;
	
      }
    }else{

      my $lString=&safeConvertString(qq(<?xml version="1.0" standalone="no" ?>
					 <collection 
					 collection-id="$lUniqueCollectionID" 
					 collection-name="$lCollectionName" 
					 
					 cui-algorithm-id-list-id="ail-inverted-file"
					 
					 cui-number-of-images="$main::lImageCount" 
					 cui-base-dir="${lIndexPrefix}"
					 cui-inverted-file-location="InvertedFile.db" 
					 cui-offset-file-location="InvertedFileOffset.db"
					 cui-feature-description-location=
					 "InvertedFileFeatureDescription.db"
					 cui-feature-file-location="url2fts.xml"
					 >
					 <query-paradigm-list>
					 <query-paradigm type="inverted-file"/>
					 <query-paradigm type="perl-demo"/>
					 </query-paradigm-list>
					 </collection>
					\n\n));
      #WORKAROUND: apparently under perl 5.8.0 XML::DOM::Parse has a problem
      #            when parsing from strings. Solution: 1. write to a temporary file
      #            2. parse the file. 3. delete the file.
      my $lName="";
      {
	do { 
	  $lName = tmpnam(); 
	} until sysopen(FH, $lName, O_RDWR|O_CREAT|O_EXCL, 0600);
	print FH $lString;
	close FH;
      }
      my $lCollection=$lParser->parsefile($lName);
      unlink $lName;
      
      &addCollection(collection=>$lCollection,
		     document=>$lGIFTConfig);

      &setDefaultCollectionID("collection-id"=>$lUniqueCollectionID,
			      document=>$lGIFTConfig);
      
      $lGIFTConfig->printToFile ("$gGiftHome/gift-config.mrml") or die $!;
    }
  }
  #print "The image count: ",$main::lImageCount,"\n";
  print "\nPROGRESS: 100%\n";
}else{
  # remove a collection
  # rescue the old config
    $CONFIG="$gGiftHome/gift-config.mrml";
  $OLDCONFIG="${CONFIG}-old";
  copy($CONFIG,$OLDCONFIG);
  
  print "

Copying $CONFIG to $OLDCONFIG

";
  
  #before overwriting it with the new config
  
  my $lParser = new XML::DOM::Parser;
  my $lGIFTConfig = $lParser->parsefile ("$gGiftHome/gift-config.mrml") or die $!;
  
  &removeCollection("collection-name"=>$lCollectionName,
		    document=>$lGIFTConfig)                            if $gDoRemove;

  &fixit("collection-name"=>$lCollectionName,
	 document=>$lGIFTConfig)                                       if $gDoFixConfig;

  $lGIFTConfig->printToFile ("$gGiftHome/gift-config.mrml") or die $!;
}


sub findOutEncodings{
  my %lFoundEncodings;
  my $lInEncoding="US-ASCII";
  {
    open LOCALELIST, "locale -m |" or die "$!";
    while(<LOCALELIST>){
      chomp $_;
      $lFoundEncodings{$_}=1     if($_);
    }
  }
  
  {
    open LOCALELIST, "locale LC_MONETARY |" or die "$!";
    while(<LOCALELIST>){
      chomp $_;
      $lInEncoding=$_     if($lFoundEncodings{$_});
    }
  }
  return(($lInEncoding || "UTF-8"),"UTF-8");
}





sub safeConvertString( $ ){
  my $lStringCopy=shift;
  return $gStringConverter->convert($lStringCopy) || $lStringCopy;# is now in UTF-8 or what it was before
}
# CONFIG SERVER CODE

sub setDefaultCollectionID{

   my $inParameters={};
   %{$inParameters}=@_;
   
   # find the attributes collection-id in <algorithm collection-id="__COLLECTION__">
   my(@lToBeChanged)=$inParameters->{document}->xql("/mrml/cui-configuration/algorithm-list/algorithm/\@collection-id=\'__COLLECTION__\'");
   my $i;
   # replace __COLLECTION__ by actual collection ID.
   foreach $i (@lToBeChanged){
     $i->setNodeValue($inParameters->{"collection-id"});
   }
}

sub fixit{

  print "Fixing config file by adjusting the collection ID of the default algorithm";

  my $inParameters={};
  %{$inParameters}=@_;

  my $lReturnValue={success=>1};
  # get a list of collections
  my(@lCollections)=$inParameters->{document}->xql("/mrml/cui-configuration/collection-list/collection");

  #make the first collection a default collection
  if(@lCollections){# clean out the files mentioned in the collection tag

    my $lId=$lCollections[0]->getAttribute("collection-id");
    $inParameters->{"collection-id"}=$lId;

    &setDefaultCollectionID((%$inParameters));
  }else{
    # no collection found --> failure
    $lReturnValue->{success}=0;
  }

  return $lReturnValue;
}

sub addCollection{
   my $inParameters={};
   %{$inParameters}=@_;
   my $lReturnValue={success=>1};
   
   my $lCollectionID=$inParameters->{collection}->getDocumentElement()->getAttribute("collection-id") or die;
   my $lCollectionName=$inParameters->{collection}->getDocumentElement()->getAttribute("collection-name") or die;

   my(@lConflict)=$inParameters->{document}->xql("/mrml/cui-configuration/collection-list/collection/\@collection-name=\'$lCollectionName\'");


   if(@lConflict){
     print join(",",@lConflict);

     my $lAttributes=$inParameters->{collection}->getDocumentElement()->getAttributes();


     my $i;
     for $i ($lAttributes->getValues( )){
       my $lName=  $i->getName();
       my $lValue= $i->getNodeValue();

       print "\n----> $lName $lValue  <----";

       if($lConflict[0]->getAttribute("$lName")){
	 unless (($lConflict[0]->getAttribute("$lName") eq $lValue)){
	   $lReturnValue->{error}="attribute value conflict $lName $lValue\n";
	   $lReturnValue->{success}=0;	
	   last;
	 }
       }else{
	 $lConflict[0]->setAttribute("$lName",$lValue);
       }
     }

     
     if($lReturnValue->{success}){

       my @lQueryParadigmLocation=$inParameters->{document}->xql("/mrml/cui-configuration/collection-list/collection/query-paradigm-list");

       my $lHasQueryParadigm=scalar(@lQueryParadigmLocation);
       
       for $i ($inParameters->{collection}->getChildNodes()){
	 unless(($i->getNodeName() eq "query-paradigm-list")
		&& $lHasQueryParadigm){
	   $i->setOwnerDocument($inParameters->{document});
	   $lConflict[0]->insertBefore($i);
	 }
       }

       if($lHasQueryParadigm){# merge two query paradigm lists
	 my $lQPTag=$lQueryParadigmLocation[0];

	 # find all query paradigms to be added
	 my @lQueryParadigms=$inParameters->{collection}->xql("/mrml/cui-add-collection/collection/query-paradigm-list/*");

	 #add them to the list
	 #FIXME: there is no elimination of duplicates
	 if(scalar @lQueryParadigms){
	   my $i;
	   for $i (@lQueryParadigms){
	     $i->setOwnerDocument($inParameters->{document});
	     $lQPTag->insertBefore($i);
	   }
	 }
       }
     }
   }else{
     my $lCollection=$inParameters->{collection}->getDocumentElement();
     $inParameters->{collection}->removeChild($lCollection);
     $lCollection->setOwnerDocument($inParameters->{document});
     my @lInsertLocation=$inParameters->{document}->xql("mrml//collection-list");
     $lCollection->setOwnerDocument($inParameters->{document});
     unless(@lInsertLocation){
       die "Wrong config file format. <collection-list> tag expected => Could not find suitable insert location within config file";
     }else{
       $lInsertLocation[0]->insertBefore($lCollection);
       my $lNewLine=$inParameters->{document}->createTextNode("\n");
       $lInsertLocation[0]->insertBefore($lNewLine);
     }
   }
   return $lReturnValue;
}
sub removeCollection{
   my $inParameters={};
   %{$inParameters}=@_;
   my $lReturnValue={success=>1};
   
   my $lCollectionName=$inParameters->{"collection-name"};

   print "Removing collection with name $lCollectionName\n";

   my(@lToBeDeleted)=$inParameters->{document}->xql("/mrml/cui-configuration/collection-list/collection[\@collection-name=\'$lCollectionName\']");


   if(@lToBeDeleted){# clean out the files mentioned in the collection tag

     my $lBaseDirectory=$lToBeDeleted[0]->getAttribute("cui-base-dir");
     my $lURL2FTSLocation=$lBaseDirectory."/".$lToBeDeleted[0]->getAttribute("cui-feature-file-location");
     unlink($lBaseDirectory."/".$lToBeDeleted[0]->getAttribute("cui-offset-file-location"));
     unlink($lBaseDirectory."/".$lToBeDeleted[0]->getAttribute("cui-inverted-file-location"));

     my $lParser= new XML::Parser(Handlers=>{Start => sub{
					       my $inUserData=shift;
					       my $inElement=shift;
					       my $inAttributes={};
					       %{$inAttributes}=(@_);
					       print "Clearing out collection $lCollectionName: Deleting ", $inAttributes->{"feature-file-name"},"\n";
					       unlink $inAttributes->{"feature-file-name"};
					       unlink $inAttributes->{"feature-file-name"}.".ADI";
					     }});
     unlink $lURL2FTSLocation;
     # now remove the collection element
     $lToBeDeleted[0]->getParentNode()->removeChild($lToBeDeleted[0]);

     my $lURL2FTS= $lParser->parsefile($lURL2FTSLocation);
   }
   return $lReturnValue;
}