--- trunk2/all2all.pl 2004/09/11 22:32:06 424
+++ trunk2/all2all.pl 2004/09/12 20:36:33 432
@@ -18,6 +18,7 @@
my $webpac = new WebPAC(
code_page => 'ISO-8859-2',
limit_mfn => 500,
+ start_mfn => 6000,
# debug => 1,
# low_mem => 1,
) || die;
@@ -56,7 +57,7 @@
$webpac->open_import_xml(type => 'isis_hidra_ths');
-if(0) { # XXX
+if(1) { # XXX
while (my $rec = $webpac->fetch_rec) {
@@ -150,13 +151,17 @@
} # XXX if(0)
-$log->info("lookup hash: ",Dumper($webpac->{'lookup'}));
+$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{
@@ -165,8 +170,34 @@
Browse
+
+
+
+
+
+ search |
+ thesarus |
+ browse
+
+
+
+
};
@@ -182,7 +213,7 @@
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 { $l->{"a:".$_[0]."::" } },
+ have_children => sub { defined($l->{"a:".$_[0]."::"}) },
child_code => sub { return $_[0] },
style => 'display: none',
},{
@@ -192,7 +223,7 @@
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 { $l->{"a:".$_[1].":" } },
+ have_children => sub { defined($l->{"a:".$_[1].":"}) },
child_code => sub { return $_[1] },
style => 'display: none',
},{
@@ -202,11 +233,94 @@
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"));
@@ -227,29 +341,57 @@
$log->debug("# $level filter passed code $code");
- my $v900 = $tree[$level]->{'lookup_v900'}->($code) || $log->logdie("can't lookup_v900 '$code'");
- $log->debug("# $level lookup_v900($code) = $v900");
- my $term = $tree[$level]->{'lookup_term'}->($code,$v900) || $log->logdie("can't lookup_term '$v900'");
+ 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->logdie("can't lookup_mfn '$v900'");
+
+ 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]");
- print HTML " " x $level .
- qq{- $term »
\n} if (-e "out/thes/$mfn.html");
+ my ($link_start,$link_end) = ('','');
+
+ my $have_children = $tree[$level]->{'have_children'}->($code,$v900,$start_code);
+ if ($have_children) {
+ ($link_start,$link_end) = (qq{},qq{});
+ } else {
+ $log->debug("# $level doesn't have_children($code,$v900,$start_code)");
+ }
- unless ($tree[$level]->{'have_children'}->($code,$v900)) {
- $log->warn("can't find children of $code at level $level");
+ my $mfn_link = "thes/$mfn.html";
+ if (-e "out/$mfn_link") {
+ print HTML " " x $level .
+ qq{- ${link_start}${term}${link_end}}.
+ qq{ »
\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{\n {'style'} ? ' style="'.$tree[$level]->{'style'}.'"' : '').
+ ($style ? ' style="'.$style.'"' : '').
qq{>\n};
- unroll($level+1, $tree[$level]->{'child_code'}->($code,$v900));
+ 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{
\n};
@@ -263,6 +405,17 @@
};
+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'}));