--- trunk2/all2all.pl	2004/06/16 11:29:37	353
+++ trunk2/all2all.pl	2004/09/12 02:31:52	428
@@ -2,7 +2,7 @@
 
 =head1 NAME
 
-all2all.pl - basic script for all WebPac needs
+all2all.pl - basic script for all WebPAC needs
 
 =cut
 
@@ -11,45 +11,396 @@
 use Carp;
 
 use lib './lib';
-use WebPac;
+use WebPAC;
+use WebPAC::jsFind;
+use WebPAC::Index;
 
-my $webpac = new WebPac(
+my $webpac = new WebPAC(
 	code_page => 'ISO-8859-2',
+	limit_mfn => 500,
+#	debug => 1,
+#	low_mem => 1,
 ) || die;
 
+my $log = $webpac->_get_logger() || die "can't get logger";
+
+$log->debug("creating WebPAC::jsFind object");
+
+my $index = new WebPAC::jsFind(
+	index_path => './out/index',
+	keys => 10,
+) || die;
+
+my $thes;
+
 $|=1;
 
-print "reading database\n";
 my $maxmfn = $webpac->open_isis(
-	filename => shift @ARGV || '/data/hidra/THS-500/THS',
+	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' },
 	],
 );
 
-print "rows: $maxmfn\n\n";
+$log->debug("isis file ",$webpac->{'isis_filename'}," opened");
 
-for (my $mfn = 1; $mfn <= $maxmfn; $mfn++) {
-	my $rec = $webpac->{'data'}->{$mfn} || die "no record with mfn $mfn";
+$log->info("rows: $maxmfn");
 
-	print "-- ",$webpac->fill_in($rec,'v250^a (v901^a)'),"\n";
+$webpac->open_import_xml(type => 'isis_hidra_ths');
 
-	my @t = $webpac->fill_in($rec,'v553^1;;v553^a');
-	print " Uži pojam: ",join("\t\n",@t),"\n" if (@t);
+if(1) { # XXX
 
-	@t = $webpac->fill_in($rec,'[a:v251::];;[d:[a:v251::]]');
-	print " Područje: ",join("\t\n",@t),"\n" if (@t);
+while (my $rec = $webpac->fetch_rec) {
+
+	my @ds = $webpac->data_structure($rec);
+
+	if (0 && $log->is_debug) {
+		$log->debug("rec = ",Dumper($rec));
+		$log->debug("ds = ",Dumper(\@ds));
+	}
+
+	next if (! @ds);
+
+	my $filename = $webpac->{'current_filename'} || $log->logdie("no current_filename in webpac object");
+
+	if ($filename) {
+		$webpac->output_file(
+			file => $filename,
+			template => 'html.tt',
+			data => \@ds,
+			headline => $webpac->{'headline'},
+		);
+	} else {
+		print $webpac->output(
+			template => 'text.tt',
+			data => \@ds,
+			headline => $webpac->{'headline'},
+		);
+	}
+
+	my $headline = $webpac->{'headline'};
+
+	my $f = $filename;
+	$f =~ s!out/!!;
+
+	# 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'}})
+		);
+	}
+
+	# 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(
+				path => $f,
+				headline => $h,
+			);
+		}
+	}
 
-	@t = $webpac->fill_in($rec,'[a:v561^4:v251:];;[d:[a:v561^4:v251:]]');
-	print " Mikrotezaurus: ",join("\t\n",@t),"\n" if (@t);
+#	print Dumper(\@ds);
 
-	@t = $webpac->fill_in($rec,'[a:v561^4:v562^4:v900];;[d:[a:v561^4:v562^4:v900]]');
-	print " Deskriptor: ",join("\t\n",@t),"\n" if (@t);
 }
 
-print "## lookup ",Dumper($webpac->{'lookup'});
-print "## data ",Dumper($webpac->{'data'});
+foreach my $t (keys %{$thes}) {
+
+	my @e = $thes->{$t}->elements;
+	if (! @e) {
+		$log->logwarn("no elements in sorted index $t?");
+		next;
+	}
+
+	my $file = "./out/bfilter/$t.txt";
+	$log->info("saving sorted index $t to '$file' [".scalar(@e)." elements]");
+
+	$webpac->output_file(
+		file => $file,
+		template => 'index.tt',
+		data => \@e,
+		index_name => $t,
+	);
+}
+
+if (0 && $log->is_debug) {
+	$log->debug("lookup hash: ",Dumper($webpac->{'lookup'}));
+	$log->debug("data hash: ",Dumper($webpac->{'data'}));
+	foreach my $t (keys %{$thes}) {
+		$log->debug("thesaurus $t hash: ",Dumper($thes->{$t}));
+	}
+}
+
+} # XXX if(0)
+
+$log->debug("lookup hash: ",Dumper($webpac->{'lookup'}));
+
+#
+# tree dump implementation which shouldn't be here :-)
+#
+
+
+my $file = 'out/browse.html';
+my $js_url = 'tree-ids.js';
+
+$log->info("creating '$file' for tree html");
+open(HTML, "> $file") || $log->logdie("can't open '$file'");
+
+print HTML qq{
+<html>
+<head>
+ <title>Browse</title>
+ <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-2"/>
+ <script type="text/javascript" src="bfilter/hide.js"></script>
+ <script type="text/javascript" src="$js_url"></script>
+</head>
+
+<body onLoad="show_hide_display(show,hide);">
+
+<div style="float: right; width: 10em;">
+Folding:
+<a href="#" onClick="show_hide_display(show,hide);">default</a>
+<a href="#" onClick="show_display(show); show_display(hide);">all</a>
+<a href="#" onClick="hide_display(hide); hide_display(show);">none</a>
+<a href="#" onClick="alert('show: '+show.length+', hide: '+hide.length);">debug</a>
+</div>
+
+
+<ul>
+};
+
+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 { defined($l->{"a:".$_[0]."::"}) },
+	child_code	=> sub { return $_[0] },
+	style		=> 'display: none',
+	},{
+	# 1
+	code_arr	=> sub { @{$l->{"a:".$_[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 { defined($l->{"a:".$_[1].":"}) },
+	child_code	=> sub { return $_[1] },
+	style		=> 'display: none',
+	},{
+	# 2
+	code_arr	=> sub { @{$l->{"a:".$_[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 { defined($l->{"a:".$_[2].":".$_[1]}) },
+	child_code	=> sub { return "a:".$_[2].":".$_[1] },
+	style		=> 'display: none',
+	},{
+	# 3 uži pojam
+	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 { defined($l->{$_[1]}) },
+	child_code	=> sub { return $_[1] },
+	},{
+	# 4
+	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 { defined($l->{$_[1]}) },
+	child_code	=> sub { return $_[1] },
+	},{
+	# 5
+	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 { defined($l->{$_[1]}) },
+	child_code	=> sub { return $_[1] },
+	},{
+	# 6
+	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 { defined($l->{$_[1]}) },
+	child_code	=> sub { return $_[1] },
+	},{
+	# 7
+	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 { defined($l->{$_[1]}) },
+	child_code	=> sub { return $_[1] },
+	},{
+	# 8
+	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 { defined($l->{$_[1]}) },
+#	child_code	=> sub { return $_[1] },
+	have_children	=> sub { 0 },
+	child_code	=> sub { 0 },
+});
+
+my @show_ids;
+my @hide_ids;
+
+unroll(0,'');
+
+$log->debug("test filter: ",$tree[0]->{'filter_code'}->("root:99"));
+
+sub unroll {
+	my ($level,$start_code) = @_;
+
+	$log->logconfess("need level") unless (defined($level));
+
+	# all levels passed?
+	return if (! defined($tree[$level]));
+
+	$log->debug("unroll level $level, start code $start_code");
+
+	foreach my $code ($tree[$level]->{'code_arr'}->($start_code)) {
+
+		if ($code = $tree[$level]->{'filter_code'}->($code)) {
+		
+			$log->debug("# $level filter passed code $code");
+
+			my $v900 = $tree[$level]->{'lookup_v900'}->($code,$start_code) || $log->warn("can't lookup_v900($code,$start_code)");
+			$log->debug("# $level lookup_v900($code,$start_code) = $v900");
+
+			my $term = $tree[$level]->{'lookup_term'}->($code,$v900) || $log->warn("can't lookup_term($code,$v900)");
+			$log->debug("# $level lookup_term($code,$v900) = $term");
+
+			my $mfn  = $tree[$level]->{'lookup_mfn'}->($code,$v900)  || $log->warn("can't lookup_mfn($code,$v900)");
+			$log->debug("# $level lookup_mfn($code,$v900) = $mfn");
+
+			$log->debug("$code -> $v900 : $term [$mfn]");
+
+			my ($link_start,$link_end) = ('','');
+	
+			my $have_children = $tree[$level]->{'have_children'}->($code,$v900,$start_code);
+			if ($have_children) {
+				($link_start,$link_end) = (qq{<a href="#mfn$mfn" onClick="return toggle_display('mfn$mfn');">},qq{</a>});
+			} else {
+				$log->debug("# $level doesn't have_children($code,$v900,$start_code)");
+			}
+
+			my $mfn_link = "thes/$mfn.html";
+			if (-e "out/$mfn_link") {
+				print HTML " " x $level .
+					qq{<li>${link_start}${term}${link_end}}.
+					qq{&nbsp;<a href="$mfn_link">&raquo;</a></li>\n};
+			} else {
+				$log->warn("file 'out/$mfn_link' doesn't exist, skipping");
+			}
+
+			unless ($have_children) {
+				next;
+			}
+			my $style = $tree[$level]->{'style'};
+
+			print HTML " " x $level .
+				qq{<a name="mfn$mfn"></a>\n <ul id="mfn$mfn"}.
+				($style ? ' style="$style"' : "").
+				qq{>\n};
+
+			if ($style) {
+				if ($style =~ m/display\s*:\s*none/i) {
+					push @hide_ids, "mfn$mfn";
+				} else {
+					push @show_ids, "mfn$mfn";
+				}
+			} else {
+				# default: show
+				push @show_ids, "mfn$mfn";
+			}
+
+			unroll($level+1, $tree[$level]->{'child_code'}->($code,$v900,$start_code));
+			
+			print HTML " " x $level . qq{</ul>\n};
+
+		}
+	}
+}
+
+print HTML qq{
+</ul>
+</body>
+</html>
+};
+
+close(HTML);
+
+
+my $js_file = "out/$js_url";
+$log->info("creating '$js_file' with arrays of shown and hidden ids");
+open(JS, ">", $js_file) || $log->logdie("can't open '$js_file': $!");
+print JS "var show = ['",join("','",@show_ids),"'];\n";
+print JS "var hide = ['",join("','",@hide_ids),"'];\n";
+close(JS);
+
+$log->info("closing index");
+$index->close;
+
+$log->info("elapsed time: ",$webpac->fmt_time(time() - $webpac->{'start_t'}));