--- trunk/all2xml.pl 2003/07/14 18:20:27 108 +++ trunk2/all2all.pl 2004/09/15 22:36:23 454 @@ -1,569 +1,318 @@ #!/usr/bin/perl -w -use strict; -use OpenIsis; -use Getopt::Std; -use Data::Dumper; -use XML::Simple; -use Text::Unaccent 1.02; # 1.01 won't compile on my platform, -use Text::Iconv; -use Config::IniFiles; -use Encode; - -$|=1; - -my $config_file = $0; -$config_file =~ s/\.pl$/.conf/; -die "FATAL: can't find configuration file '$config_file'" if (! -e $config_file); - -my $config; - -#use index_DBI; # default DBI module for index -use index_DBI_cache; # faster DBI module using memory cache -my $index; - -my %opts; - -# usage: -# -d directory name -# -m multiple directories -# -q quiet -# -s run swish - -getopts('d:m:qs', \%opts); +=head1 NAME -my $path; # this is name of database +all2all.pl - basic script for all WebPAC needs -Text::Iconv->raise_error(0); # Conversion errors don't raise exceptions +=cut -# this is encoding of all files on disk, including import_xml/*.xml file and -# filter/*.pm files! It will be used to store strings in perl internally! -my $codepage = 'ISO-8859-2'; +use strict; +use YAML; +use Carp; +use Getopt::Long; + +use lib './lib'; +use WebPAC; +use WebPAC::jsFind; +use WebPAC::Index; +use WebPAC::Tree; + +# options which can be changed via command line +# +my $code_page = 'ISO-8859-2'; +my ($limit_mfn, $start_mfn, $debug, $low_mem); +my $index_path = './out/index'; + +my $result = GetOptions( + "code_page=s" => \$code_page, + "limit_mfn=i" => \$limit_mfn, + "start_mfn=i" => \$start_mfn, + "debug!" => \$debug, + "low_mem!" => \$low_mem, +); -my $utf2cp = Text::Iconv->new('UTF-8',$codepage); -# this function will convert data from XML files to local encoding -sub x { - return $utf2cp->convert($_[0]); -} +# create WebPAC object +# +my $webpac = new WebPAC( + code_page => $code_page, + limit_mfn => $limit_mfn, + start_mfn => $start_mfn, + debug => $debug, + low_mem => $low_mem, +) || die; + +my $log = $webpac->_get_logger() || die "can't get logger"; + +$log->debug("creating WebPAC::jsFind object"); + +my $index = new WebPAC::jsFind( + index_path => $index_path, + keys => 10, +) || die; -# decode isis/excel or other import codepage -my $import2cp; +my $thes; -# outgoing xml must be in UTF-8 -my $cp2utf = Text::Iconv->new($codepage,'UTF-8'); +$|=1; -# mapping between data type and tag which specify -# format in XML file -my %type2tag = ( - 'isis' => 'isis', - 'excel' => 'column', - 'marc' => 'marc', - 'feed' => 'feed' +my $maxmfn = $webpac->open_isis( + filename => shift @ARGV || '/data/hidra/THS/THS', + lookup => [ + { 'key' => 'd:v900', 'val' => 'v250^a' }, +# { 'eval' => '"v901^a" eq "Područje"', 'key' => 'pa:v561^4:v562^4:v461^1', 'val' => 'v900' }, +# { 'eval '=> '"v901^a" eq "Mikrotezaurus"', 'key' => 'a:v561^4:v562^4:v461^1', 'val' => 'v900' }, +# { 'eval' => '"v901^a" eq "Deskriptor"', 'key' => 'a:v561^4:v562^4:v461^1', 'val' => 'v900' }, + { 'key' => 'a:v561^4:v562^4:v461^1', 'val' => 'v900' }, + { 'key' => '900_mfn:v900', 'val' => 'v000' }, + # tree structure + { 'eval' => 'length("v251") == 2', 'key' => 'root:v251', 'val' => 'v900' }, + { 'eval' => '"v251"', 'key' => 'code:v900', 'val' => 'v561^4:v251' }, + ], ); -sub data2xml { +$log->debug("isis file ",$webpac->{'isis_filename'}," opened"); - use xmlify; +$log->info("rows: $maxmfn"); - my $type = shift @_; - my $row = shift @_; - my $add_xml = shift @_; - # needed to read values from configuration file - my $cfg = shift @_; - my $database = shift @_; +$webpac->open_import_xml(type => 'isis_hidra_ths'); - my $xml; +if(1) { # XXX - use parse_format; +while (my $rec = $webpac->fetch_rec) { - my $html = ""; # html formatted display output + my @ds = $webpac->data_structure($rec); - my %field_usage; # counter for usage of each field - - # sort subrouting using order="" attribute - sub by_order { - my $va = $config->{indexer}->{$a}->{order} || - $config->{indexer}->{$a}; - my $vb = $config->{indexer}->{$b}->{order} || - $config->{indexer}->{$b}; - - return $va <=> $vb; + if (0 && $log->is_debug) { + $log->debug("rec = ",Dump($rec)); + $log->debug("ds = ",Dump(\@ds)); } - foreach my $field (sort by_order keys %{$config->{indexer}}) { - - $field=x($field); - $field_usage{$field}++; - - my $swish_data = ""; - my $display_data = ""; - my $line_delimiter; - - my ($swish,$display); - - my $tag = $type2tag{$type} || die "can't find which tag to use for type $type"; - foreach my $x (@{$config->{indexer}->{$field}->{$tag}}) { - - my $format = x($x->{content}); - my $delimiter = x($x->{delimiter}) || ' '; - - my $repeat_off = 0; # repeatable offset - - my ($s,$d,$i) = (1,1,0); # swish, display default - $s = 0 if (lc($x->{type}) eq "display"); - $d = 0 if (lc($x->{type}) eq "swish"); - ($s,$d,$i) = (0,0,1) if (lc($x->{type}) eq "index"); - - # what will separate last line from this one? - if ($display_data && $x->{append} && $x->{append} eq "1") { - $line_delimiter = ' '; - } elsif ($display_data) { - $line_delimiter = '
'; - } - - # init vars so that we go into while... - ($swish,$display) = (1,1); - - # placeholder for all repeatable entries for index - my @index_data; - my $index_filter; - - # while because of repeatable fields - while ($swish || $display) { - ($swish,$display) = parse_format($type, $format,$row,$repeat_off++,$import2cp); - if ($repeat_off > 1000) { - print STDERR "loop (more than 1000 repeatable fields) deteced in $row, $format\n"; - last; - } - - # filter="name" ; filter this field through - # filter/[name].pm - my $filter = $x->{filter}; - if ($filter) { - require "filter/".$filter.".pm"; - } - # type="swish" ; field for swish - if ($s && $swish) { - if ($filter) { - no strict 'refs'; - $swish_data .= join(" ",&$filter($swish)); - } else { - $swish_data .= $swish; - } - } - - # type="display" ; field for display - if ($d && $display) { - if ($line_delimiter && $display_data) { - $display_data .= $line_delimiter; - undef $line_delimiter; - } - if ($filter) { - no strict 'refs'; - $display_data .= join($delimiter,&$filter($display)); - } else { - if ($display_data) { - $display_data .= $delimiter.$display; - } else { - $display_data .= $display; - } - } - } - - # type="index" ; insert into index - if ($i && $display) { - push @index_data, $display; - $index_filter = $filter if ($filter); - } - } - - # fill data in index - if (@index_data) { - if ($index_filter) { - no strict 'refs'; - foreach my $d (&$index_filter(@index_data)) { - $index->insert($field, $d, $path); - } - } else { - foreach my $d (@index_data) { - $index->insert($field, $d, $path); - } - } - } - } - - # now try to parse variables from configuration file - foreach my $x (@{$config->{indexer}->{$field}->{'config'}}) { - - my $delimiter = x($x->{delimiter}) || ' '; - my $val = $cfg->val($database, x($x->{content})); - - my ($s,$d,$i) = (1,1,0); # swish, display default - $s = 0 if (lc($x->{type}) eq "display"); - $d = 0 if (lc($x->{type}) eq "swish"); - ($s,$d,$i) = (0,0,1) if (lc($x->{type}) eq "index"); - - if ($val) { - $display_data .= $delimiter.$val if ($d); - $swish_data .= $val if ($s); - $index->insert($field, $val, $path) if ($i); - } - - } - - - if ($display_data) { - - if ($field eq "headline") { - $xml .= xmlify("headline", $display_data); - } else { - - # find field name (signular, plural) - my $field_name = ""; - if ($config->{indexer}->{$field}->{name_singular} && $field_usage{$field} == 1) { - $field_name = $config->{indexer}->{$field}->{name_singular}."#-#"; - } elsif ($config->{indexer}->{$field}->{name_plural}) { - $field_name = $config->{indexer}->{$field}->{name_plural}."#-#"; - } elsif ($config->{indexer}->{$field}->{name}) { - $field_name = $config->{indexer}->{$field}->{name}."#-#"; - } else { - print STDERR "WARNING: field '$field' doesn't have 'name' attribute!"; - } - if ($field_name) { - $html .= x($field_name); - } - $html .= $display_data."###\n"; - } - } - if ($swish_data) { - # remove extra spaces - $swish_data =~ s/ +/ /g; - $swish_data =~ s/ +$//g; - - $xml .= xmlify($field."_swish", unac_string($codepage,$swish_data)); - } - + next if (! @ds); - } + my $filename = $webpac->{'current_filename'} || $log->logdie("no current_filename in webpac object"); - # dump formatted output in - if ($html) { - #$xml .= xmlify("html",$html); - $xml .= ""; - } - - if ($xml) { - $xml .= $add_xml if ($add_xml); - return "\n$xml\n"; + if ($filename) { + $webpac->output_file( + file => $filename, + template => 'html.tt', + data => \@ds, + headline => $webpac->{'headline'}, + ); } else { - return; + print $webpac->output( + template => 'text.tt', + data => \@ds, + headline => $webpac->{'headline'}, + ); } -} - -########################################################################## -# read configuration for this script -my $cfg = new Config::IniFiles( -file => $config_file ); + my $headline = $webpac->{'headline'}; -# read global.conf configuration -my $cfg_global = new Config::IniFiles( -file => 'global.conf' ); + my $f = $filename; + $f =~ s!out/!!; -# open index -$index = new index_DBI( - $cfg_global->val('global', 'dbi_dbd'), - $cfg_global->val('global', 'dbi_dsn'), - $cfg_global->val('global', 'dbi_user'), - $cfg_global->val('global', 'dbi_passwd') || '', - ); - -my $show_progress = $cfg_global->val('global', 'show_progress'); - -foreach my $database ($cfg->Sections) { - - my $type = lc($cfg -> val($database, 'type')) || die "$database doesn't have 'type' defined"; - my $add_xml = $cfg -> val($database, 'xml'); # optional - -print STDERR "reading ./import_xml/$type.xml\n"; - - # extract just type basic - my $type_base = $type; - $type_base =~ s/_.+$//g; - - $config=XMLin("./import_xml/$type.xml", forcearray => [ $type2tag{$type_base}, 'config' ], forcecontent => 1); - - # output current progress indicator - my $last_p = 0; - sub progress { - return if (! $show_progress); - my $current = shift; - my $total = shift || 1; - my $p = int($current * 100 / $total); - if ($p != $last_p) { - printf STDERR ("%5d / %5d [%-51s] %-2d %% \r",$current,$total,"=" x ($p/2).">", $p ); - $last_p = $p; - } + # save into index + foreach my $ds (@ds) { + next if (! $ds->{'swish'}); + + $index->insert( + index_name => $ds->{'tag'}, + path => $f, + headline => $headline, + words => join(" ",@{$ds->{'swish'}}) + ); } - my $fake_dir = 1; - sub fakeprogress { - return if (! $show_progress); - my $current = shift @_; - - my @ind = ('-','\\','|','/','-','\\','|','/', '-'); - - $last_p += $fake_dir; - $fake_dir = -$fake_dir if ($last_p > 1000 || $last_p < 0); - if ($last_p % 10 == 0) { - printf STDERR ("%5d / %5s [%-51s]\r",$current,"?"," " x ($last_p/20).$ind[($last_p/20) % $#ind]); + # save into sorted index (thesaurus) + foreach my $ds (@ds) { + next if (! $ds->{'index'}); + + $thes->{$ds->{'tag'}} ||= new WebPAC::Index; + + foreach my $h (@{$ds->{'index'}}) { + $thes->{$ds->{'tag'}}->insert( + headline => $h, + mfn => $webpac->mfn, + ); } } - # now read database -print STDERR "using: $type...\n"; - - if ($type_base eq "isis") { - - my $isis_db = $cfg -> val($database, 'isis_db') || die "$database doesn't have 'isis_db' defined!"; - - $import2cp = Text::Iconv->new($config->{isis_codepage},$codepage); - my $db = OpenIsis::open( $isis_db ); - - # check if .txt database for OpenIsis is zero length, - # if so, erase it and re-open database - sub check_txt_db { - my $isis_db = shift || die "need isis database name"; - if (-e $isis_db.".TXT") { - print STDERR "WARNING: removing .txt OpenIsis database...\n"; - unlink $isis_db.".TXT" || warn "FATAL: unlink error on '$isis_db.TXT': $!"; - my $db = OpenIsis::open( $isis_db ); - return $db; - } - } - - # EOF error - if ($db == -1) { - $db = check_txt_db($isis_db); - if ($db == -1) { - print STDERR "FATAL: OpenIsis can't open zero size file $isis_db\n"; - next; - } - } - - # OpenIsis::ERR_BADF - if ($db == -4) { - print STDERR "FATAL: OpenIsis can't find file $isis_db\n"; - next; - # OpenIsis::ERR_IO - } elsif ($db == -5) { - print STDERR "FATAL: OpenIsis can't access file $isis_db\n"; - next; - } elsif ($db < 0) { - print STDERR "FATAL: OpenIsis unknown error $db with file $isis_db\n"; - next; - } - - my $max_rowid = OpenIsis::maxRowid( $db ); - - # if 0 records, try to rease isis .txt database - if ($max_rowid == 0) { - # force removal of database - $db = check_txt_db($isis_db); - $max_rowid = OpenIsis::maxRowid( $db ); - } - - print STDERR "Reading database: $isis_db [$max_rowid rows]\n"; - - my $path = $database; - - for (my $row_id = 1; $row_id <= $max_rowid; $row_id++ ) { - my $row = OpenIsis::read( $db, $row_id ); - if ($row && $row->{mfn}) { - - progress($row->{mfn}, $max_rowid); - - my $swishpath = $path."#".int($row->{mfn}); - - if (my $xml = data2xml($type_base,$row,$add_xml,$cfg,$database)) { - $xml = $cp2utf->convert($xml); - use bytes; # as opposed to chars - print "Path-Name: $swishpath\n"; - print "Content-Length: ".(length($xml)+1)."\n"; - print "Document-Type: XML\n\n$xml\n"; - } - } - } - # for this to work with current version of OpenIsis (0.9.0) - # you might need my patch from - # http://www.rot13.org/~dpavlin/projects/openisis-0.9.0-perl_close.diff - OpenIsis::close($db); - print STDERR "\n"; - - } elsif ($type_base eq "excel") { - use Spreadsheet::ParseExcel; - use Spreadsheet::ParseExcel::Utility qw(int2col); - - $import2cp = Text::Iconv->new($config->{excel_codepage},$codepage); - my $excel_file = $cfg -> val($database, 'excel_file') || die "$database doesn't have 'excel_file' defined!"; - - my $sheet = x($config->{sheet}) || die "no sheet in $type.xml"; - my $start_row = x($config->{start_row}) - 1 || die "no start_row in $type.xml"; - - my $oBook = Spreadsheet::ParseExcel::Workbook->Parse($excel_file) || die "can't open Excel file '$excel_file'"; - - my $sheet_nr = 0; - foreach my $oWks (@{$oBook->{Worksheet}}) { - #print STDERR "-- SHEET $sheet_nr:", $oWks->{Name}, "\n"; - last if ($oWks->{Name} eq $sheet); - $sheet_nr++; - } - - my $oWorksheet = $oBook->{Worksheet}[$sheet_nr]; - - print STDERR "using sheet: ",$oWorksheet->{Name},"\n"; - defined ($oWorksheet) || die "can't find sheet '$sheet' in $excel_file"; - my $end_row = x($config->{end_row}) || $oWorksheet->{MaxRow}; - - for(my $iR = $start_row ; defined $end_row && $iR <= $end_row ; $iR++) { - my $row; - for(my $iC = $oWorksheet->{MinCol} ; defined $oWorksheet->{MaxCol} && $iC <= $oWorksheet->{MaxCol} ; $iC++) { - my $cell = $oWorksheet->{Cells}[$iR][$iC]; - if ($cell) { - $row->{int2col($iC)} = $cell->Value; - } - } - - progress($iR, $end_row); - -# print "row[$iR/$end_row] "; -# foreach (keys %{$row}) { -# print "$_: ",$row->{$_},"\t"; -# } -# print "\n"; - - my $swishpath = $database."#".$iR; - - next if (! $row); - - if (my $xml = data2xml($type_base,$row,$add_xml,$cfg,$database)) { - $xml = $cp2utf->convert($xml); - use bytes; # as opposed to chars - print "Path-Name: $swishpath\n"; - print "Content-Length: ".(length($xml)+1)."\n"; - print "Document-Type: XML\n\n$xml\n"; - } - } - } elsif ($type_base eq "marc") { - - use MARC; - - $import2cp = Text::Iconv->new($config->{marc_codepage},$codepage); - my $marc_file = $cfg -> val($database, 'marc_file') || die "$database doesn't have 'marc_file' defined!"; - - # optional argument is format - my $format = x($config->{format}) || 'usmarc'; - - print STDERR "Reading MARC file '$marc_file'\n"; - - my $marc = new MARC; - my $nr = $marc->openmarc({ - file=>$marc_file, format=>$format - }) || die "Can't open MARC file '$marc_file'"; - - my $i=0; # record nr. - - my $rec; - - while ($marc->nextmarc(1)) { - - # XXX - fakeprogress($i++); - - my $swishpath = $database."#".$i; - - if (my $xml = data2xml($type_base,$marc,$add_xml,$cfg,$database)) { - $xml = $cp2utf->convert($xml); - use bytes; # as opposed to chars - print "Path-Name: $swishpath\n"; - print "Content-Length: ".(length($xml)+1)."\n"; - print "Document-Type: XML\n\n$xml\n"; - } - } - } elsif ($type_base eq "feed") { +# print Dump(\@ds); - $import2cp = Text::Iconv->new($config->{feed_codepage},$codepage); - my $prog = x($config->{prog}) || die "$database doesn't have 'prog' defined!"; - - print STDERR "Reading feed from program '$prog'\n"; - - open(FEED,"feeds/$prog |") || die "can't start $prog: $!"; - - my $i=1; # record nr. - - my $data; - my $line=1; - - while () { - chomp; +} - if (/^$/) { - my $swishpath = $database."#".$i++; +foreach my $t (keys %{$thes}) { - if (my $xml = data2xml($type_base,$data,$add_xml,$cfg,$database)) { - $xml = $cp2utf->convert($xml); - use bytes; # as opposed to chars - print "Path-Name: $swishpath\n"; - print "Content-Length: ".(length($xml)+1)."\n"; - print "Document-Type: XML\n\n$xml\n"; - } - $line = 1; - $data = {}; - next; - } + my @e = $thes->{$t}->elements; + if (! @e) { + $log->logwarn("no elements in sorted index $t?"); + next; + } - $line = $1 if (s/^(\d+):\s*//); - $data->{$line++} = $_; + my $file = "./out/bfilter/$t.txt"; + $log->info("saving sorted index $t to '$file' [".scalar(@e)." elements]"); - fakeprogress($i); + $webpac->output_file( + file => $file, + template => 'index.tt', + data => \@e, + index_name => $t, + ); +} - } +if (0 && $log->is_debug) { + $log->debug("lookup hash: ",Dump($webpac->{'lookup'})); + $log->debug("data hash: ",Dump($webpac->{'data'})); + foreach my $t (keys %{$thes}) { + $log->debug("thesaurus $t hash: ",Dump($thes->{$t})); } } -# call this to commit index -$index->close; - -1; -__END__ -########################################################################## +} # XXX if(0) -=head1 NAME - -all2xml.pl - read various file formats and dump XML for SWISH-E - -=head1 DESCRIPTION - -This command will read ISIS data file using OpenIsis perl module, MARC -records using MARC module and optionally Micro$oft Excel files to -create one XML file for usage with I indexer. Dispite it's name, -this script B from isis files (isis allready -has something like that). Output of this script is tailor-made for SWISH-E. - -=head1 BUGS - -Documentation is really lacking. However, in true Open Source spirit, source -is best documentation. I even made considerable effort to comment parts -which are not intuitively clear, so... +$log->debug("lookup hash: ",Dump($webpac->{'lookup'})); -=head1 AUTHOR +$log->info("creating tree"); -Dobrica Pavlinusic - -=head1 COPYRIGHT - -GNU Public License (GPL) v2 or later - -=head1 SEE ALSO +# +# define tree structure +# + +my $l = $webpac->{'lookup'} || $log->logconfess("can't find lookup"); + +my @tree = ({ + # level 0 + code_arr => sub { sort keys %{$l} }, + filter_code => sub { + my $t = shift; + return $t if ($t =~ s/root://); + }, + lookup_v900 => sub { shift @{$l->{"root:".$_[0]}} }, + lookup_term => sub { shift @{$l->{"d:".$_[1]}} }, + lookup_mfn => sub { shift @{$l->{"900_mfn:".$_[1]}} }, + have_children => sub { return $l->{"a:".$_[0]."::"} }, + have_children_at_level => sub { + my $l2 = shift; + my $l1 = substr($l2,0,1); + return(9, "a:$l1:$l2:" ) if ($l->{"a:$l1:$l2"}); + }, + style => 'display: none', + },{ + # 1 + code_arr => sub { @{$_[0]} }, + filter_code => sub { shift }, # nop + lookup_v900 => sub { shift @{$l->{"code:".$_[0]}} }, + lookup_term => sub { shift @{$l->{"d:".$_[0]}} }, + lookup_mfn => sub { shift @{$l->{"900_mfn:".$_[0]}} }, + have_children => sub { return $l->{"a:".$_[1].":"} }, + style => 'display: none', + },{ + # 2 + code_arr => sub { @{$_[0]} }, + filter_code => sub { shift }, + lookup_v900 => sub { shift }, + lookup_term => sub { shift @{$l->{"d:".$_[0]}} }, + lookup_mfn => sub { shift @{$l->{"900_mfn:".$_[0]}} }, + have_children => sub { return $l->{"a:".$_[2].":".$_[1]} }, + #style => 'display: none', + },{ + # 3 uži pojam + code_arr => sub { @{$_[0]} }, + filter_code => sub { shift }, + lookup_v900 => sub { + my ($c,$p) = @_; + $p =~ s/^a:(..:....):.*$/$1/; + return "a:".$p.":".$c; + }, + lookup_term => sub { shift @{$l->{"d:".$_[0]}} }, + lookup_mfn => sub { shift @{$l->{"900_mfn:".$_[0]}} }, + have_children => sub { return $l->{$_[1]} }, + },{ + # 4 + code_arr => sub { @{$_[0]} }, + filter_code => sub { shift }, + lookup_v900 => sub { + my ($c,$p) = @_; + $p =~ s/^a:(..:....):.*$/$1/; + return "a:".$p.":".$c; + }, + lookup_term => sub { shift @{$l->{"d:".$_[0]}} }, + lookup_mfn => sub { shift @{$l->{"900_mfn:".$_[0]}} }, + have_children => sub { return $l->{$_[1]} }, + },{ + # 5 + code_arr => sub { @{$_[0]} }, + filter_code => sub { shift }, + lookup_v900 => sub { + my ($c,$p) = @_; + $p =~ s/^a:(..:....):.*$/$1/; + return "a:".$p.":".$c; + }, + lookup_term => sub { shift @{$l->{"d:".$_[0]}} }, + lookup_mfn => sub { shift @{$l->{"900_mfn:".$_[0]}} }, + have_children => sub { return $l->{$_[1]} }, + },{ + # 6 + code_arr => sub { @{$_[0]} }, + filter_code => sub { shift }, + lookup_v900 => sub { + my ($c,$p) = @_; + $p =~ s/^a:(..:....):.*$/$1/; + return "a:".$p.":".$c; + }, + lookup_term => sub { shift @{$l->{"d:".$_[0]}} }, + lookup_mfn => sub { shift @{$l->{"900_mfn:".$_[0]}} }, + have_children => sub { return $l->{$_[1]} }, + },{ + # 7 + code_arr => sub { @{$_[0]} }, + filter_code => sub { shift }, + lookup_v900 => sub { + my ($c,$p) = @_; + $p =~ s/^a:(..:....):.*$/$1/; + return "a:".$p.":".$c; + }, + lookup_term => sub { shift @{$l->{"d:".$_[0]}} }, + lookup_mfn => sub { shift @{$l->{"900_mfn:".$_[0]}} }, + have_children => sub { return $l->{$_[1]} }, + },{ + # 8 + code_arr => sub { @{$_[0]} }, + filter_code => sub { shift }, + lookup_v900 => sub { + my ($c,$p) = @_; + $p =~ s/^a:(..:....):.*$/$1/; + return "a:".$p.":".$c; + }, + lookup_term => sub { shift @{$l->{"d:".$_[0]}} }, + lookup_mfn => sub { shift @{$l->{"900_mfn:".$_[0]}} }, +# have_children => sub { return $l->{$_[1]} }, +# child_code => sub { return $_[1] }, + have_children => sub { 0 }, + },{ + # 9 - level which is never reached except explicitly + code_arr => sub { @{$l->{$_[0]}} }, + filter_code => sub { shift }, + lookup_v900 => sub { + my ($c,$p) = @_; + $p =~ s/^a:(.+:.+):.*$/$1/; + return "a:".$p.":".$c; + }, + lookup_term => sub { shift @{$l->{"d:".$_[0]}} }, + lookup_mfn => sub { shift @{$l->{"900_mfn:".$_[0]}} }, + have_children => sub { 0 }, + have_children_at_level => sub { defined($l->{$_[1]}) && return (9,$_[1]) }, + },{ +}); + +my $tree = new WebPAC::Tree( + dir => './out', + html => 'browse.html', + template => './output_template/tree.tt', + js => 'tree-ids.js', + tree => \@tree, +); -SWISH-E web site at http://www.swish-e.org +$log->info("closing index"); +$index->close; -=cut +$log->info("elapsed time: ",$webpac->fmt_time(time() - $webpac->{'start_t'}));