Jonas,
A while back, i did the required research to create a collection in
multiple stages. What i was doing was running my (faster) feature
extractor against all the image files, using several machines,
dropping the result into one big database, and running the following
version of the gift-add-collection.pl script.
I'm attaching said script.
I THINK it works along the same lines as you're talking about,
only I was using several machines to create a collection with this.
I've done the "homework". A collection built with this script is
bitwise identical to a collection built normally.
Please comment.
(this is more of what i'm trying to merge in. i'm tired of having a
local fork. ;)
Julia Longtin <[EMAIL PROTECTED]>
On Mon, Aug 28, 2006 at 06:14:21PM +0200, Jonas Lindqvist wrote:
> Thanks...
>
> >>Something similar to this appeared to work when I was
> >>experimenting with the GIFT a while back, but I haven't tried it
> >>properly lately.
> >>
> >>What do you say? Have I missed some important steps, or have I
> >>misunderstood something?
> >
> >Looks good to me. Have you tried it?
>
> I tried something similar a couple of weeks ago, but exactly this
> series of commands, no. I would, only I'm currently extracting
> features for a set of 90k images, and I don't want to risk anything
> by fiddling with the GIFT right now.
> The 90k images will be added to an existing collection, so I need to
> do something like this when the extraction is done.
> Since you don't see anything wrong with my theoretical instructions,
> I will follow them myself. If it doesn't work I will let you know...
> If someone else can spot some obvious mistakes, please let me know...
> (Strange to ask before trying? Well, it's so time-consuming trying to
> debug things like this if it doesn't work...)
>
> >The only thing I can think of is making sure that the collection
> >name and id still match those in the gift-config.mrml file (added
> >by gift-add-collection), but I think they should...
>
> It will in this case, but it's good pointing that out in case someone
> else decides to follow the instructions to create a collection from
> scratch...
>
> You know, a gift-repair-db-and-xml-files.pl script would be handy...
> I might write one if I need to do this often... :-)
>
>
> /Jonas
>
> _______________________________________________
> help-GIFT mailing list
> [email protected]
> http://lists.gnu.org/mailman/listinfo/help-gift
#!/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/[EMAIL PROTECTED]@/$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 "This script was last modified on $main::gModifyingDateOfThis\n";
#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";
my $lThumbnailModificationTime=(stat($lThumbnailFile))[9];
# note: i removed time stamp checking, so that regens were quick.
if (!-e($lThumbnailFile)) {
$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";
}
# resize the image.
if ((!$main::lImageCount) || (!-e($lFts))) {
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")) ;
}
}
my $lFtsModificationTime=(stat($lFts))[9];
if (-e($lFts))
{ #dont, and say we did.
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++;
$main::lCountVisitedImages++;
print "creating no feature file, file found.\n";
print "\nPROGRESS: ".$main::lCountVisitedImages." of
".$main::lCountPotentialImages." done
(".POSIX::floor(90*$main::lCountVisitedImages/$main::lCountPotentialImages)."%)\n";
}
else
{ #actually perform feature extraction
if ($lFtsModificationTime) {
print($lFtsModificationTime," is the modifying date of $lFts
file\n")
}
print("We will make a new feature file\n");
print("Extracting features from $lTemp\n");
unlink($lTempFts);
eval{
system("/usr/bin/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";' );
}
$main::lImageCount++;
$main::lCountVisitedImages++;
# print "Number of images: $main::lImageCount\n\n";
unlink($lTemp);
unlink($lTempFts);
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";
}
}
# 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={};
[EMAIL PROTECTED];
# find the attributes collection-id in <algorithm
collection-id="__COLLECTION__">
my(@lToBeChanged)=$inParameters->{document}->xql("/mrml/cui-configuration/algorithm-list/algorithm/[EMAIL
PROTECTED]'__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={};
[EMAIL PROTECTED];
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={};
[EMAIL PROTECTED];
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/[EMAIL
PROTECTED]'$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={};
[EMAIL PROTECTED];
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/[EMAIL
PROTECTED]'$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;
}
_______________________________________________
help-GIFT mailing list
[email protected]
http://lists.gnu.org/mailman/listinfo/help-gift
