/[webpac]/trunk2/all2all.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /trunk2/all2all.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 440 - (show annotations)
Tue Sep 14 09:23:00 2004 UTC (19 years, 6 months ago) by dpavlin
File MIME type: text/plain
File size: 11512 byte(s)
missing rename mfn### -> id### because of IE bug

1 #!/usr/bin/perl -w
2
3 =head1 NAME
4
5 all2all.pl - basic script for all WebPAC needs
6
7 =cut
8
9 use strict;
10 use Data::Dumper;
11 use Carp;
12 use Getopt::Long;
13
14 use lib './lib';
15 use WebPAC;
16 use WebPAC::jsFind;
17 use WebPAC::Index;
18
19 # options which can be changed via command line
20 #
21 my $code_page = 'ISO-8859-2';
22 my ($limit_mfn, $start_mfn, $debug, $low_mem);
23 my $index_path = './out/index';
24
25 my $result = GetOptions(
26 "code_page=s" => \$code_page,
27 "limit_mfn=i" => \$limit_mfn,
28 "start_mfn=i" => \$start_mfn,
29 "debug!" => \$debug,
30 "low_mem!" => \$low_mem,
31 );
32
33 # create WebPAC object
34 #
35 my $webpac = new WebPAC(
36 code_page => $code_page,
37 limit_mfn => $limit_mfn,
38 start_mfn => $start_mfn,
39 debug => $debug,
40 low_mem => $low_mem,
41 ) || die;
42
43 my $log = $webpac->_get_logger() || die "can't get logger";
44
45 $log->debug("creating WebPAC::jsFind object");
46
47 my $index = new WebPAC::jsFind(
48 index_path => $index_path,
49 keys => 10,
50 ) || die;
51
52 my $thes;
53
54 $|=1;
55
56 my $maxmfn = $webpac->open_isis(
57 filename => shift @ARGV || '/data/hidra/THS/THS',
58 lookup => [
59 { 'key' => 'd:v900', 'val' => 'v250^a' },
60 # { 'eval' => '"v901^a" eq "Podruèje"', 'key' => 'pa:v561^4:v562^4:v461^1', 'val' => 'v900' },
61 # { 'eval '=> '"v901^a" eq "Mikrotezaurus"', 'key' => 'a:v561^4:v562^4:v461^1', 'val' => 'v900' },
62 # { 'eval' => '"v901^a" eq "Deskriptor"', 'key' => 'a:v561^4:v562^4:v461^1', 'val' => 'v900' },
63 { 'key' => 'a:v561^4:v562^4:v461^1', 'val' => 'v900' },
64 { 'key' => '900_mfn:v900', 'val' => 'v000' },
65 # tree structure
66 { 'eval' => 'length("v251") == 2', 'key' => 'root:v251', 'val' => 'v900' },
67 { 'eval' => '"v251"', 'key' => 'code:v900', 'val' => 'v561^4:v251' },
68 ],
69 );
70
71 $log->debug("isis file ",$webpac->{'isis_filename'}," opened");
72
73 $log->info("rows: $maxmfn");
74
75 $webpac->open_import_xml(type => 'isis_hidra_ths');
76
77 if(1) { # XXX
78
79 while (my $rec = $webpac->fetch_rec) {
80
81 my @ds = $webpac->data_structure($rec);
82
83 if (0 && $log->is_debug) {
84 $log->debug("rec = ",Dumper($rec));
85 $log->debug("ds = ",Dumper(\@ds));
86 }
87
88 next if (! @ds);
89
90 my $filename = $webpac->{'current_filename'} || $log->logdie("no current_filename in webpac object");
91
92 if ($filename) {
93 $webpac->output_file(
94 file => $filename,
95 template => 'html.tt',
96 data => \@ds,
97 headline => $webpac->{'headline'},
98 );
99 } else {
100 print $webpac->output(
101 template => 'text.tt',
102 data => \@ds,
103 headline => $webpac->{'headline'},
104 );
105 }
106
107 my $headline = $webpac->{'headline'};
108
109 my $f = $filename;
110 $f =~ s!out/!!;
111
112 # save into index
113 foreach my $ds (@ds) {
114 next if (! $ds->{'swish'});
115
116 $index->insert(
117 index_name => $ds->{'tag'},
118 path => $f,
119 headline => $headline,
120 words => join(" ",@{$ds->{'swish'}})
121 );
122 }
123
124 # save into sorted index (thesaurus)
125 foreach my $ds (@ds) {
126 next if (! $ds->{'index'});
127
128 $thes->{$ds->{'tag'}} ||= new WebPAC::Index;
129
130 foreach my $h (@{$ds->{'index'}}) {
131 $thes->{$ds->{'tag'}}->insert(
132 path => $f,
133 headline => $h,
134 );
135 }
136 }
137
138 # print Dumper(\@ds);
139
140 }
141
142 foreach my $t (keys %{$thes}) {
143
144 my @e = $thes->{$t}->elements;
145 if (! @e) {
146 $log->logwarn("no elements in sorted index $t?");
147 next;
148 }
149
150 my $file = "./out/bfilter/$t.txt";
151 $log->info("saving sorted index $t to '$file' [".scalar(@e)." elements]");
152
153 $webpac->output_file(
154 file => $file,
155 template => 'index.tt',
156 data => \@e,
157 index_name => $t,
158 );
159 }
160
161 if (0 && $log->is_debug) {
162 $log->debug("lookup hash: ",Dumper($webpac->{'lookup'}));
163 $log->debug("data hash: ",Dumper($webpac->{'data'}));
164 foreach my $t (keys %{$thes}) {
165 $log->debug("thesaurus $t hash: ",Dumper($thes->{$t}));
166 }
167 }
168
169 } # XXX if(0)
170
171 $log->debug("lookup hash: ",Dumper($webpac->{'lookup'}));
172
173 #
174 # tree dump implementation which shouldn't be here :-)
175 #
176
177
178 my $file = 'out/browse.html';
179 my $js_url = 'tree-ids.js';
180
181 $log->info("creating '$file' for tree html");
182 open(HTML, "> $file") || $log->logdie("can't open '$file'");
183
184 print HTML qq{
185 <html>
186 <head>
187 <title>Browse</title>
188 <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-2"/>
189 <script type="text/javascript" src="bfilter/hide.js"></script>
190 <script type="text/javascript" src="$js_url"></script>
191 </head>
192
193 <!--
194 <body onLoad="show_hide_display(show,hide);">
195 -->
196 <body>
197
198 <span style="background: #e0e0e0;">
199 <a href="search.html">search</a> |
200 <a href="thesaurus.html">thesarus</a> |
201 <a href="browse.html"><b>browse</b></a>
202 </span>
203
204 <div style="float: right; width: 10em; text-align: center; margin: 0.5m; background: #e0e0e0; border: 1px dashed #c0c0c0; z-index: 1;">
205 Folding:
206 <br/>
207 <a href="#" onClick="back_display();">&laquo;</a>&nbsp;<a href="#" onClick="default_display();">default</a>&nbsp;<a href="#" onClick="forward_display();">&raquo;</a>
208 <br/>
209 <a href="#" onClick="show_hide_display(show,hide);">reset</a>
210 <a href="#" onClick="show_display(show); show_display(hide);">all</a>
211 <a href="#" onClick="hide_display(hide); hide_display(show);">none</a>
212 <br/>
213 <a href="#" onClick="alert('show: '+show.length+', hide: '+hide.length+', changed:'+changed_display_ids.length+', positin: '+changed_display_pos);">debug</a>
214
215 <a href="#" onClick="outline_display('id6030');">outline</a>
216 </div>
217
218 <ul>
219 };
220
221 my $l = $webpac->{'lookup'} || $log->logconfess("can't find lookup");
222
223 my @tree = ({
224 # level 0
225 code_arr => sub { sort keys %{$l} },
226 filter_code => sub {
227 my $t = shift;
228 return $t if ($t =~ s/root://);
229 },
230 lookup_v900 => sub { shift @{$l->{"root:".$_[0]}} },
231 lookup_term => sub { shift @{$l->{"d:".$_[1]}} },
232 lookup_mfn => sub { shift @{$l->{"900_mfn:".$_[1]}} },
233 have_children => sub { defined($l->{"a:".$_[0]."::"}) },
234 child_code => sub { return $_[0] },
235 style => 'display: none',
236 },{
237 # 1
238 code_arr => sub { @{$l->{"a:".$_[0]."::"}} },
239 filter_code => sub { shift }, # nop
240 lookup_v900 => sub { shift @{$l->{"code:".$_[0]}} },
241 lookup_term => sub { shift @{$l->{"d:".$_[0]}} },
242 lookup_mfn => sub { shift @{$l->{"900_mfn:".$_[0]}} },
243 have_children => sub { defined($l->{"a:".$_[1].":"}) },
244 child_code => sub { return $_[1] },
245 style => 'display: none',
246 },{
247 # 2
248 code_arr => sub { @{$l->{"a:".$_[0].":"}} },
249 filter_code => sub { shift },
250 lookup_v900 => sub { shift },
251 lookup_term => sub { shift @{$l->{"d:".$_[0]}} },
252 lookup_mfn => sub { shift @{$l->{"900_mfn:".$_[0]}} },
253 have_children => sub { defined($l->{"a:".$_[2].":".$_[1]}) },
254 child_code => sub { return "a:".$_[2].":".$_[1] },
255 style => 'display: none',
256 },{
257 # 3 u¾i pojam
258 code_arr => sub { @{$l->{$_[0]}} },
259 filter_code => sub { shift },
260 lookup_v900 => sub {
261 my ($c,$p) = @_;
262 $p =~ s/^a:(..:....):.*$/$1/;
263 return "a:".$p.":".$c;
264 },
265 lookup_term => sub { shift @{$l->{"d:".$_[0]}} },
266 lookup_mfn => sub { shift @{$l->{"900_mfn:".$_[0]}} },
267 have_children => sub { defined($l->{$_[1]}) },
268 child_code => sub { return $_[1] },
269 },{
270 # 4
271 code_arr => sub { @{$l->{$_[0]}} },
272 filter_code => sub { shift },
273 lookup_v900 => sub {
274 my ($c,$p) = @_;
275 $p =~ s/^a:(..:....):.*$/$1/;
276 return "a:".$p.":".$c;
277 },
278 lookup_term => sub { shift @{$l->{"d:".$_[0]}} },
279 lookup_mfn => sub { shift @{$l->{"900_mfn:".$_[0]}} },
280 have_children => sub { defined($l->{$_[1]}) },
281 child_code => sub { return $_[1] },
282 },{
283 # 5
284 code_arr => sub { @{$l->{$_[0]}} },
285 filter_code => sub { shift },
286 lookup_v900 => sub {
287 my ($c,$p) = @_;
288 $p =~ s/^a:(..:....):.*$/$1/;
289 return "a:".$p.":".$c;
290 },
291 lookup_term => sub { shift @{$l->{"d:".$_[0]}} },
292 lookup_mfn => sub { shift @{$l->{"900_mfn:".$_[0]}} },
293 have_children => sub { defined($l->{$_[1]}) },
294 child_code => sub { return $_[1] },
295 },{
296 # 6
297 code_arr => sub { @{$l->{$_[0]}} },
298 filter_code => sub { shift },
299 lookup_v900 => sub {
300 my ($c,$p) = @_;
301 $p =~ s/^a:(..:....):.*$/$1/;
302 return "a:".$p.":".$c;
303 },
304 lookup_term => sub { shift @{$l->{"d:".$_[0]}} },
305 lookup_mfn => sub { shift @{$l->{"900_mfn:".$_[0]}} },
306 have_children => sub { defined($l->{$_[1]}) },
307 child_code => sub { return $_[1] },
308 },{
309 # 7
310 code_arr => sub { @{$l->{$_[0]}} },
311 filter_code => sub { shift },
312 lookup_v900 => sub {
313 my ($c,$p) = @_;
314 $p =~ s/^a:(..:....):.*$/$1/;
315 return "a:".$p.":".$c;
316 },
317 lookup_term => sub { shift @{$l->{"d:".$_[0]}} },
318 lookup_mfn => sub { shift @{$l->{"900_mfn:".$_[0]}} },
319 have_children => sub { defined($l->{$_[1]}) },
320 child_code => sub { return $_[1] },
321 },{
322 # 8
323 code_arr => sub { @{$l->{$_[0]}} },
324 filter_code => sub { shift },
325 lookup_v900 => sub {
326 my ($c,$p) = @_;
327 $p =~ s/^a:(..:....):.*$/$1/;
328 return "a:".$p.":".$c;
329 },
330 lookup_term => sub { shift @{$l->{"d:".$_[0]}} },
331 lookup_mfn => sub { shift @{$l->{"900_mfn:".$_[0]}} },
332 # have_children => sub { defined($l->{$_[1]}) },
333 # child_code => sub { return $_[1] },
334 have_children => sub { 0 },
335 child_code => sub { 0 },
336 });
337
338 my @show_ids;
339 my @hide_ids;
340
341 unroll(0,'');
342
343 $log->debug("test filter: ",$tree[0]->{'filter_code'}->("root:99"));
344
345 sub unroll {
346 my ($level,$start_code) = @_;
347
348 $log->logconfess("need level") unless (defined($level));
349
350 # all levels passed?
351 return if (! defined($tree[$level]));
352
353 $log->debug("unroll level $level, start code $start_code");
354
355 foreach my $code ($tree[$level]->{'code_arr'}->($start_code)) {
356
357 if ($code = $tree[$level]->{'filter_code'}->($code)) {
358
359 $log->debug("# $level filter passed code $code");
360
361 my $v900 = $tree[$level]->{'lookup_v900'}->($code,$start_code) || $log->warn("can't lookup_v900($code,$start_code)");
362 $log->debug("# $level lookup_v900($code,$start_code) = $v900");
363
364 my $term = $tree[$level]->{'lookup_term'}->($code,$v900) || $log->warn("can't lookup_term($code,$v900)");
365 $log->debug("# $level lookup_term($code,$v900) = $term");
366
367 my $mfn = $tree[$level]->{'lookup_mfn'}->($code,$v900) || $log->warn("can't lookup_mfn($code,$v900)");
368 $log->debug("# $level lookup_mfn($code,$v900) = $mfn");
369
370 $log->debug("$code -> $v900 : $term [$mfn]");
371
372 my ($link_start,$link_end) = ('','');
373
374 my $have_children = $tree[$level]->{'have_children'}->($code,$v900,$start_code);
375 if ($have_children) {
376 ($link_start,$link_end) = (qq{<a href="#mfn$mfn" onClick="return toggle_display('id$mfn');">},qq{</a>});
377 } else {
378 $log->debug("# $level doesn't have_children($code,$v900,$start_code)");
379 }
380
381 my $mfn_link = "thes/$mfn.html";
382 if (-e "out/$mfn_link") {
383 print HTML " " x $level .
384 qq{<li>${link_start}${term}${link_end}}.
385 qq{&nbsp;<a href="$mfn_link">&raquo;</a></li>\n};
386 } else {
387 $log->warn("file 'out/$mfn_link' doesn't exist, skipping");
388 }
389
390 unless ($have_children) {
391 next;
392 }
393 my $style = $tree[$level]->{'style'};
394
395 print HTML " " x $level .
396 qq{<a name="mfn$mfn"></a>\n <ul id="id$mfn"}.
397 ($style ? ' style="'.$style.'"' : '').
398 qq{>\n};
399
400 if ($style) {
401 if ($style =~ m/display\s*:\s*none/i) {
402 push @hide_ids, "id$mfn";
403 } else {
404 push @show_ids, "id$mfn";
405 }
406 } else {
407 # default: show
408 push @show_ids, "id$mfn";
409 }
410
411 unroll($level+1, $tree[$level]->{'child_code'}->($code,$v900,$start_code));
412
413 print HTML " " x $level . qq{</ul>\n};
414
415 }
416 }
417 }
418
419 print HTML qq{
420 </ul>
421 </body>
422 </html>
423 };
424
425 close(HTML);
426
427
428 my $js_file = "out/$js_url";
429 $log->info("creating '$js_file' with arrays of shown and hidden ids");
430 open(JS, ">", $js_file) || $log->logdie("can't open '$js_file': $!");
431 print JS "var show = ['",join("','",@show_ids),"'];\n";
432 print JS "var hide = ['",join("','",@hide_ids),"'];\n";
433 close(JS);
434
435 $log->info("closing index");
436 $index->close;
437
438 $log->info("elapsed time: ",$webpac->fmt_time(time() - $webpac->{'start_t'}));

Properties

Name Value
cvs2svn:cvs-rev 1.64
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26