/[webpac]/trunk/all2xml.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

Diff of /trunk/all2xml.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 3 by dpavlin, Sat Nov 30 00:36:34 2002 UTC revision 188 by dpavlin, Sat Nov 29 19:07:00 2003 UTC
# Line 5  use OpenIsis; Line 5  use OpenIsis;
5  use Getopt::Std;  use Getopt::Std;
6  use Data::Dumper;  use Data::Dumper;
7  use XML::Simple;  use XML::Simple;
8  use Text::Unaccent;  use Text::Unaccent 1.02;        # 1.01 won't compile on my platform,
9  require Unicode::Map8;  use Text::Iconv;
10    use Config::IniFiles;
11  my $config=XMLin(undef, forcearray => [ 'isis' ], forcecontent => 1);  use Encode;
12    #use GDBM_File;
13    use Fcntl;      # for O_RDWR
14    use TDB_File;
15    
16    $|=1;
17    
18    my $config_file = $0;
19    $config_file =~ s/\.pl$/.conf/;
20    die "FATAL: can't find configuration file '$config_file'" if (! -e $config_file);
21    
22    my $config;
23    
24    #use index_DBI;         # default DBI module for index
25    use index_DBI_cache;    # faster DBI module using memory cache
26    my $index;
27    
28  my %opts;  my %opts;
29    
30  getopts('d:m:q', \%opts);  # usage:
31    #       -d directory name
32    #       -m multiple directories
33    #       -q quiet
34    #       -s run swish
35    
36    getopts('d:m:qs', \%opts);
37    
38    my $path;       # this is name of database
39    
40    Text::Iconv->raise_error(0);     # Conversion errors don't raise exceptions
41    
42    # this is encoding of all files on disk, including import_xml/*.xml file and
43    # filter/*.pm files! It will be used to store strings in perl internally!
44    my $codepage = 'ISO-8859-2';
45    
46    my $utf2cp = Text::Iconv->new('UTF-8',$codepage);
47    # this function will convert data from XML files to local encoding
48    sub x {
49            return $utf2cp->convert($_[0]);
50    }
51    
52  my $db_dir = $opts{d} || "ps";  # FIX  # decode isis/excel or other import codepage
53    my $import2cp;
54    
55  #die "usage: $0 -d [database_dir] -m [database1,database2] " if (! %opts);  # outgoing xml must be in UTF-8
56    my $cp2utf = Text::Iconv->new($codepage,'UTF-8');
57    
58  #print Dumper($config->{indexer});  # mapping between data type and tag which specify
59  #print "-" x 70,"\n";  # format in XML file
60    my %type2tag = (
61            'isis' => 'isis',
62            'excel' => 'column',
63            'marc' => 'marc',
64            'feed' => 'feed'
65    );
66    
67    my $cache;      # for cacheing
68    
69    # lookup hash (tied to file)
70    my %lhash;
71    # this option will cache all lookup entries in memory.
72    # if you are tight on memory, turn this off
73    my $use_lhash_cache = 1;
74    
75  # how to convert isis code page to UTF8?  sub data2xml {
 my $isis_map = Unicode::Map8->new($config->{isis_codepage}) || die;  
76    
77  sub isis2xml {          use xmlify;
78    
79            my $type = shift @_;
80          my $row = shift @_;          my $row = shift @_;
81            my $add_xml = shift @_;
82            # needed to read values from configuration file
83            my $cfg = shift @_;
84            my $database = shift @_;
85    
86          my $xml;          my $xml;
87    
88          sub isis_sf {          use parse_format;
89                  my $row = shift @_;  
90                  my $isis_id = shift @_;          my $html = "";          # html formatted display output
91                  my $subfield = shift @_;  
92                  if ($row->{$isis_id}->[0]) {          my %field_usage;        # counter for usage of each field
93                          my $sf = OpenIsis::subfields($row->{$isis_id}->[0]);  
94                          if (! defined $subfield || length($subfield) == 0) {          # sort subrouting using order="" attribute
95                                  # subfield list undef, empty or no defined subfields for this record          sub by_order {
96                                  return $row->{$isis_id}->[0];                  my $va = $config->{indexer}->{$a}->{order} ||
97                          } elsif ($sf->{$subfield}) {                          $config->{indexer}->{$a};
98                                  return $sf->{$subfield};                  my $vb = $config->{indexer}->{$b}->{order} ||
99                          }                          $config->{indexer}->{$b};
100    
101                    return $va <=> $vb;
102            }
103    
104            my @sorted_tags;
105            if ($cache->{tags_by_order}) {
106                    @sorted_tags = @{$cache->{tags_by_order}};
107            } else {
108                    @sorted_tags = sort by_order keys %{$config->{indexer}};
109                    $cache->{tags_by_order} = \@sorted_tags;
110            }
111    
112            # lookup key
113            my $lookup_key;
114    
115            # cache for field in pages
116            delete $cache->{display_data};
117            delete $cache->{swish_data};
118            delete $cache->{swish_exact_data};
119            delete $cache->{index_data};
120            delete $cache->{index_delimiter};
121            my @page_fields;        # names of fields
122    
123    
124            # subs used to produce output
125    
126            sub get_field_name($$$) {
127                    my ($config,$field,$field_usage) = @_;
128    
129                    # find field name (signular, plural)
130                    my $field_name = "";
131                    if ($config->{indexer}->{$field}->{name_singular} && $field_usage == 1) {
132                            $field_name = $config->{indexer}->{$field}->{name_singular};
133                    } elsif ($config->{indexer}->{$field}->{name_plural}) {
134                            $field_name = $config->{indexer}->{$field}->{name_plural};
135                    } elsif ($config->{indexer}->{$field}->{name}) {
136                            $field_name = $config->{indexer}->{$field}->{name};
137                    } else {
138                            print STDERR "WARNING: field '$field' doesn't have 'name' attribute!";
139                    }
140                    if ($field_name) {
141                            return x($field_name);
142                  }                  }
143          }          }
144    
         foreach my $field (keys %{$config->{indexer}}) {  
145    
146            # begin real work: go field by field
147            foreach my $field (@sorted_tags) {
148    
149                    $field=x($field);
150                    $field_usage{$field}++;
151    
152                    my $swish_data = "";
153                    my $swish_exact_data = "";
154                  my $display_data = "";                  my $display_data = "";
155                  my $index_data = "";                  my @index_data;
156                    my $line_delimiter;
157    
158                  foreach my $x (@{$config->{indexer}->{$field}->{isis}}) {                  my ($swish,$display);
159    
160                          my $display_tmp = "";                  my $tag = $type2tag{$type} || die "can't find which tag to use for type $type";
                         my $index_tmp = "";  
161    
162                          my $format = $x->{content};                  # is this field page-by-page?
163                          my $i = 1;      # index only                  my $iterate_by_page = $config->{indexer}->{$field}->{iterate_by_page};
164                          my $d = 1;      # display only                  push @page_fields,$field if ($iterate_by_page);
165                          $i = 0 if (lc($x->{type}) eq "display");                  my %page_max = ();
166                          $d = 0 if (lc($x->{type}) eq "index");                  # default line_delimiter if using
167  #print "## i: $i d: $d ## $format ##";                    my $page_line_delimiter = $config->{indexer}->{$field}->{page_line_delimiter} || '<br/>';
168                          # parse format                  $cache->{index_delimiter}->{$field} = $config->{indexer}->{$field}->{index_delimiter};
169                          my $prefix = "";  
170                          if ($format =~ s/^([^\d]+)//) {                  foreach my $x (@{$config->{indexer}->{$field}->{$tag}}) {
171                                  $prefix = $1;  
172                          }                          my $format = x($x->{content});
173                          while ($format) {                          my $delimiter = x($x->{delimiter}) || ' ';
174                                  if ($format =~ s/^(\d\d\d)(\w?)//) {  
175                                          my $isis_tmp = isis_sf($row,$1,$2);                          my $repeat_off = 0;     # init repeatable offset
176                                          if ($isis_tmp) {  
177  #                                               $display_tmp .= $prefix . "/$1/$2/".$isis_tmp if ($d);                          # swish, swish_exact, display, index, index_lookup
178                                                  $display_tmp .= $prefix . $isis_tmp if ($d);                          # swish and display defaults
179                                                  $index_tmp .= $isis_tmp." " if ($i);                          my ($s,$se,$d,$i,$il) = (1,0,1,0,0);
180  #print " $isis_tmp <--\n";                          $s = 0 if (lc($x->{type}) eq "display");
181                                          }                          $d = 0 if (lc($x->{type}) eq "swish");
182                                          $prefix = "";                          ($s,$se,$d,$i) = (0,1,0,1) if (lc($x->{type}) eq "index");
183                                  } elsif ($format =~ s/^([^\d]+)//) {                          ($s,$se,$d,$i) = (0,1,0,0) if (lc($x->{type}) eq "swish_exact");
184                                          $prefix = $1;                          ($s,$se,$d,$i,$il) = (0,1,0,0,1) if (lc($x->{type}) =~ /^lookup/);
185    
186                            # what will separate last line from this one?
187                            if ($display_data && $x->{append}) {
188                                    $line_delimiter = ' ';
189                            } elsif ($display_data) {
190                                    $line_delimiter = '<br/>';
191                            }
192    
193                            # init vars so that we go into while...
194                            ($swish,$display) = (1,1);
195    
196                            # placeholder for all repeatable entries for index
197    
198                            sub mkformat {
199                                    my $x = shift || die "mkformat needs tag reference";
200                                    my $data = shift || return;
201                                    my $format_name = x($x->{format_name}) || return $data;
202                                    my $fmt = x($config->{format}->{$format_name}->{content}) || die "<format name=\"$format_name\"> is not defined!";
203                                    my $format_delimiter = x($x->{format_delimiter});
204                                    my @data;
205                                    if ($format_delimiter) {
206                                            @data = split(/$format_delimiter/,$data);
207                                    } else {
208                                            push @data,$data;
209                                    }
210    
211                                    if ($fmt) {
212                                            my $nr = scalar $fmt =~ s/%s/%s/g;
213                                            if (($#data+1) == $nr) {
214                                                    return sprintf($fmt,@data);
215                                            } else {
216                                                    print STDERR "mkformat: [$data] can't be split on [$format_delimiter] to $nr fields!\n";
217                                                    return $data;
218                                            }
219                                  } else {                                  } else {
220                                          print STDERR "WARNING: unparsed format '$format'\n";                                          print STDERR "usage of link '$format_name' without defined format (<link> tag)\n";
221                                    }
222                            }
223    
224                            # while because of repeatable fields
225                            while ($swish || $display) {
226                                    my $page = $repeat_off;
227                                    $page_max{$field} = $page if ($iterate_by_page && $page > ($page_max{$field} || 0));
228                                    ($swish,$display) = parse_format($type, $format,$row,$repeat_off++,$import2cp);
229                                    if ($repeat_off > 1000) {
230                                            print STDERR "loop (more than 1000 repeatable fields) deteced in $row, $format\n";
231                                          last;                                          last;
232                                  };                                  }
233    
234                                    # is this field is lookup?
235                                    if ($display && $x->{lookup}) {
236                                            my $null = "<!-- null -->";
237                                            if ($use_lhash_cache) {
238                                                    if (!defined($cache->{lhash}->{$display})) {
239                                                            my $new_display = $lhash{$display};
240                                                            if (defined($new_display)) {
241    #print STDERR "lookup cache store '$display' = '$new_display'\n";
242                                                                    $display = $new_display;
243                                                                    $cache->{lhash}->{$display} = $new_display;
244                                                            } else {
245                                                                    print STDERR "WARNING: lookup for '$display' didn't find anything.\n";
246                                                                    $display = "";
247                                                                    $cache->{lhash}->{$display} = $null;
248                                                            }
249                                                    } else {
250                                                            $display = $cache->{lhash}->{$display};
251                                                    }
252                                            } else {
253                                                    $display = $lhash{$display} || $null;
254                                            }
255                                    }
256    
257                                    # filter="name" ; filter this field through
258                                    # filter/[name].pm
259                                    my $filter = $x->{filter};
260                                    if ($filter && !$cache->{filter_loaded}->{$filter}) {
261                                            require "filter/".$filter.".pm";
262                                            $cache->{filter_loaded}->{$filter}++;
263                                    }
264                                    # type="swish" ; field for swish
265                                    if ($swish) {
266                                            if ($filter && ($s || $se)) {
267                                                    no strict 'refs';
268                                                    my $tmp = join(" ",&$filter($swish)) if ($s || $se);
269                                                    $swish_data .= $tmp if ($s);
270                                                    $swish_exact_data .= $tmp if ($se);
271    
272                                            } else {
273                                                    $swish_data .= $swish if ($s);
274                                                    $swish_exact_data .= $swish if ($se);
275                                            }
276                                    }
277    
278                                    # type="display" ; field for display
279                                    if ($d && $display) {
280                                            if ($line_delimiter && $display_data) {
281                                                    $display_data .= $line_delimiter;
282                                            }
283                                            if ($filter) {
284                                                    no strict 'refs';
285                                                    if ($display_data) {
286                                                            $display_data .= $delimiter.join($delimiter,mkformat($x,&$filter($display)));
287                                                    } else {
288                                                            $display_data = join($delimiter,mkformat($x,&$filter($display)));
289                                                    }
290                                            } else {
291                                                    if ($display_data) {
292                                                            $display_data .= $delimiter.mkformat($x,$display);
293                                                    } else {
294                                                            $display_data = mkformat($x,$display);
295                                                    }
296                                            }
297                                    }
298                                                    
299                                    # type="index" ; insert into index
300                                    my $idisplay;
301                                    if ($i && $display) {
302                                            $idisplay = $display;
303                                            if ($filter) {
304                                                    no strict 'refs';
305                                                    $idisplay = &$filter($idisplay);
306                                            }
307                                            push @index_data, $idisplay if (! $iterate_by_page);
308                                    }
309    
310                                    # store fields in lookup
311                                    if ($il && $display) {
312                                            if (lc($x->{type}) eq "lookup_key") {
313                                                    if ($lookup_key) {
314                                                            print STDERR "WARNING: try to redefine lookup_key (keys shouldn't be repeatable fields!)";
315                                                    } else {
316                                                            $lookup_key = $display;
317                                                    }
318                                            } elsif (lc($x->{type}) eq "lookup_val") {
319                                                    if ($lookup_key) {
320                                                            $lhash{$lookup_key} = $display;
321                                                    } else {
322                                                            print STDERR "WARNING: no lookup_key defined for  '$display'?";
323                                                    }
324                                            }
325    
326                                    }
327    
328                                    # store data for page-by-page repeatable fields
329                                    if ($iterate_by_page) {
330                                            sub iterate_fld($$$$$$) {
331                                                    my ($cache,$what,$field,$page,$data,$append) = @_;
332                                                    return if (!$data);
333    
334                                                    my $ldel = $page_line_delimiter;
335                                                    $ldel = " " if ($append);
336    #print STDERR "line delimiter: ",Dumper($ldel) if ($ldel);
337                                                    if (! $cache->{$what}->{$field}->[$page]) {
338                                                            $cache->{$what}->{$field}->[$page] = $data;
339                                                    } else {
340                                                            $cache->{$what}->{$field}->[$page] .= $ldel.$data;
341                                                    }
342                                            }
343    
344                                            if ($display_data) {
345                                                    iterate_fld($cache,'display_data',$field,$page,$display_data,$x->{append});
346                                            }
347                                                    $display_data = "";
348                                            if ($swish_data) {
349                                                    iterate_fld($cache,'swish_data',$field,$page,$swish_data,$x->{append});
350                                                    $swish_data = "";
351                                            }
352                                            if ($swish_exact_data) {
353                                                    iterate_fld($cache,'swish_exact_data',$field,$page,$swish_exact_data,$x->{append});
354                                                    $swish_exact_data = "";
355                                            }
356    
357                                            if ($idisplay) {
358                                                    my $ldel=$page_line_delimiter;
359                                                    my @index_data;
360                                                    if ($cache->{index_data}->{$field}->[$page]) {
361    
362                                                            @index_data = @{$cache->{index_data}->{$field}->[$page]};
363                                                    }
364                                                    if ($x->{append}) {
365                                                            $index_data[$#index_data] .= $idisplay;
366                                                    } else {
367                                                            push @index_data, $idisplay;
368                                                    }
369                                                    $idisplay = "";
370                                                    @{$cache->{index_data}->{$field}->[$page]} = @index_data;
371                                            }
372                                    }
373                            }
374    
375                            if (! $iterate_by_page) {
376                                    my $idel = $x->{index_delimiter};
377                                    # fill data in index
378                                    foreach my $tmp (@index_data) {
379                                            my $i = $d = $tmp;
380                                            if ($idel && $tmp =~ m/$idel/) {
381                                                    ($i,$d) = split(/$idel/,$tmp);
382                                            }
383                                            $index->insert($field, $i, $d, $path);
384                                    }
385                                    @index_data = ();
386                          }                          }
387                          # add suffix                  }
388                          $display_tmp .= $prefix if ($display_tmp);  
389                    # now try to parse variables from configuration file
390                    foreach my $x (@{$config->{indexer}->{$field}->{'config'}}) {
391    
392  #                       $display_data .= $display_tmp if ($display_tmp ne "");                          my $delimiter = x($x->{delimiter}) || ' ';
393  #                       $index_data .= $index_tmp if ($index_tmp ne "");                          my $val = $cfg->val($database, x($x->{content}));
                         $display_data .= $display_tmp;  
                         $index_data .= $index_tmp;  
394    
395                            my ($s,$d,$i) = (1,1,0);        # swish, display default
396                            $s = 0 if (lc($x->{type}) eq "display");
397                            $d = 0 if (lc($x->{type}) eq "swish");
398                            # no support for swish exact in config.
399                            # IMHO, it's useless
400                            ($s,$d,$i) = (0,0,1) if (lc($x->{type}) eq "index");
401    
402                            if ($val) {
403                                    $display_data .= $delimiter.$val if ($d);
404                                    $swish_data .= $val if ($s);
405                                    $index->insert($field, $val, $path) if ($i);
406                            }
407    
408                            if ($iterate_by_page) {
409                                    # FIXME data from config tag will appear just
410                                    # on first page!!!
411                                    my $page = 0;
412                                    if ($display_data) {
413                                            $cache->{display_data}->{$field}->[$page] = $display_data;
414                                            $display_data = "";
415                                    }
416                                    if ($swish_data) {
417                                            $cache->{swish_data}->{$field}->[$page] = $swish_data;
418                                            $swish_data = "";
419                                    }
420                                    if ($swish_exact_data) {
421                                            $cache->{swish_exact_data}->{$field}->[$page] = $swish_exact_data;
422                                            $swish_exact_data = "";
423                                    }
424                            }
425                  }                  }
426  #print "--display:$display_data\n--index:$index_data\n";  
427                  $xml->{$field}->{display} .= $isis_map->tou($display_data)->utf8 if ($display_data);                  # save data page-by-page
428                  $xml->{$field}->{index} .= unac_string($config->{isis_codepage},$index_data) if ($index_data);                  foreach my $field (@page_fields) {
429                            my $nr_pages = $page_max{$field} || next;
430    #print STDERR "field '$field' iterate over ",($nr_pages || 0)," pages...\n";
431    #print STDERR Dumper($cache->{display_data});
432                            for (my $page=0; $page <= $nr_pages; $page++) {
433    
434                                    my $display_data = $cache->{display_data}->{$field}->[$page];
435                                    if ($display_data) { # default
436                                            if ($field eq "headline") {
437                                                    $xml .= xmlify("headline", $display_data);
438                                            } else {
439    
440                                                    # fallback to empty field name if needed
441                                                    $html .= get_field_name($config,$field,$field_usage{$field}) || '';
442                                                    $html .= "#-#".$display_data."###\n";
443                                            }
444                                    }
445                                    
446                                    my $swish_data = $cache->{swish_data}->{$field}->[$page];
447                                    if ($swish_data) {
448                                            # remove extra spaces
449                                            $swish_data =~ s/ +/ /g;
450                                            $swish_data =~ s/ +$//g;
451    
452                                            $xml .= xmlify($field."_swish", unac_string($codepage,$swish_data));
453                                    }
454    
455                                    my $swish_exact_data = $cache->{swish_exact_data}->{$field}->[$page];
456                                    if ($swish_exact_data) {
457                                            $swish_exact_data =~ s/ +/ /g;
458                                            $swish_exact_data =~ s/ +$//g;
459    
460                                            # add delimiters before and after word.
461                                            # That is required to produce exact match
462                                            $xml .= xmlify($field."_swish_exact", unac_string($codepage,'xxbxx '.$swish_exact_data.' xxexx'));
463                                    }
464                                    
465                                    my $idel = $cache->{index_delimiter}->{$field};
466                                    foreach my $tmp (@{$cache->{index_data}->{$field}->[$page]}) {
467                                            my $i = $tmp;
468                                            my $d = $tmp;
469                                            if ($idel && $tmp =~ m/$idel/) {
470                                                    ($i,$d) = split(/$idel/,$tmp);
471                                            }
472                                            $index->insert($field, $i, $d, $path);
473    #print STDERR "index [$idel] $field: $i --> $d [$path]\n";
474                                    }
475                            }
476                    
477                    }
478                    
479                    if (! $iterate_by_page) {
480                            if ($display_data) {
481                                    if ($field eq "headline") {
482                                            $xml .= xmlify("headline", $display_data);
483                                    } else {
484    
485                                            # fallback to empty field name if needed
486                                            $html .= get_field_name($config,$field,$field_usage{$field}) || '';
487                                            $html .= "#-#".$display_data."###\n";
488                                    }
489                            }
490                            if ($swish_data) {
491                                    # remove extra spaces
492                                    $swish_data =~ s/ +/ /g;
493                                    $swish_data =~ s/ +$//g;
494    
495                                    $xml .= xmlify($field."_swish", unac_string($codepage,$swish_data));
496                            }
497    
498                            if ($swish_exact_data) {
499                                    $swish_exact_data =~ s/ +/ /g;
500                                    $swish_exact_data =~ s/ +$//g;
501    
502                                    # add delimiters before and after word.
503                                    # That is required to produce exact match
504                                    $xml .= xmlify($field."_swish_exact", unac_string($codepage,'xxbxx '.$swish_exact_data.' xxexx'));
505                            }
506                    }
507          }          }
508    
509            # dump formatted output in <html>
510            if ($html) {
511                    #$xml .= xmlify("html",$html);
512                    $xml .= "<html><![CDATA[ $html ]]></html>";
513            }
514            
515          if ($xml) {          if ($xml) {
516                  return XMLout($xml, rootname => 'xml', noattr => 1 );                  $xml .= $add_xml if ($add_xml);
517                    return "<xml>\n$xml</xml>\n";
518          } else {          } else {
519                  return;                  return;
520          }          }
# Line 106  sub isis2xml { Line 522  sub isis2xml {
522    
523  ##########################################################################  ##########################################################################
524    
525  my $last_tell=0;  # read configuration for this script
526    my $cfg = new Config::IniFiles( -file => $config_file );
527    
528  my @isis_dirs = ( '.' );        # use dirname as database name  # read global.conf configuration
529    my $cfg_global = new Config::IniFiles( -file => 'global.conf' );
530    
531  if ($opts{m}) {  # open index
532          @isis_dirs = split(/,/,$opts{m});  $index = new index_DBI(
533                    $cfg_global->val('global', 'dbi_dbd'),
534                    $cfg_global->val('global', 'dbi_dsn'),
535                    $cfg_global->val('global', 'dbi_user'),
536                    $cfg_global->val('global', 'dbi_passwd') || '',
537            );
538    
539    my $show_progress = $cfg_global->val('global', 'show_progress');
540    
541    my $unac_filter = $cfg_global->val('global', 'unac_filter');
542    if ($unac_filter) {
543            require $unac_filter;
544  }  }
545    
546  my @isis_dbs;  foreach my $database ($cfg->Sections) {
547    
548            my $type = lc($cfg -> val($database, 'type')) || die "$database doesn't have 'type' defined";
549            my $add_xml = $cfg -> val($database, 'xml');    # optional
550    
551  foreach (@isis_dirs) {          # create new lookup file
552          if (-e $config->{isis_data}."/$db_dir/$_/LIBRI") {          my $lookup_file = $cfg -> val($database, 'lookup_newfile'); # optional
553                  push @isis_dbs,$config->{isis_data}."/$db_dir/$_/LIBRI/LIBRI";          if ($lookup_file) {
554                    #tie %lhash, 'GDBM_File', $lookup_file, &GDBM_NEWDB, 0644;
555                    tie %lhash, 'TDB_File', $lookup_file, TDB_CLEAR_IF_FIRST, O_RDWR, 0644;
556                    print STDERR "creating lookup file '$lookup_file'\n";
557          }          }
558          if (-e $config->{isis_data}."/$db_dir/$_/PERI") {  
559                  push @isis_dbs,$config->{isis_data}."/$db_dir/$_/PERI/PERI";          # open existing lookup file
560            $lookup_file = $cfg -> val($database, 'lookup_open'); # optional
561            if ($lookup_file) {
562                    #tie %lhash, 'GDBM_File', $lookup_file, &GDBM_READER, 0644;
563                    tie %lhash, 'TDB_File', $lookup_file, TDB_DEFAULT, O_RDWR, 0644;
564                    print STDERR "opening lookup file '$lookup_file'\n";
565          }          }
566          if (-e $config->{isis_data}."/$db_dir/$_/AMS") {  
567                  push @isis_dbs,$config->{isis_data}."/$db_dir/$_/AMS/AMS";  print STDERR "reading ./import_xml/$type.xml\n";
568    
569            # extract just type basic
570            my $type_base = $type;
571            $type_base =~ s/_.+$//g;
572    
573            $config=XMLin("./import_xml/$type.xml", forcearray => [ $type2tag{$type_base}, 'config', 'format' ], forcecontent => 1);
574    
575            # output current progress indicator
576            my $last_p = 0;
577            sub progress {
578                    return if (! $show_progress);
579                    my $current = shift;
580                    my $total = shift || 1;
581                    my $p = int($current * 100 / $total);
582                    if ($p != $last_p) {
583                            printf STDERR ("%5d / %5d [%-51s] %-2d %% \r",$current,$total,"=" x ($p/2).">", $p );
584                            $last_p = $p;
585                    }
586          }          }
587          if (-e $config->{isis_data}."/$db_dir/$_/ARTI") {  
588  #               push @isis_dbs,$config->{isis_data}."/$db_dir/$_/ARTI/ARTI";          my $fake_dir = 1;
589            sub fakeprogress {
590                    return if (! $show_progress);
591                    my $current = shift @_;
592    
593                    my @ind = ('-','\\','|','/','-','\\','|','/', '-');
594    
595                    $last_p += $fake_dir;
596                    $fake_dir = -$fake_dir if ($last_p > 1000 || $last_p < 0);
597                    if ($last_p % 10 == 0) {
598                            printf STDERR ("%5d / %5s [%-51s]\r",$current,"?"," " x ($last_p/20).$ind[($last_p/20) % $#ind]);
599                    }
600          }          }
 }  
601    
602  print STDERR "FATAL: Can't find isis database.\nPerhaps isis_data (".$config->{isis_data}.") has wrong value?\n" if (! @isis_dbs);          # now read database
603    print STDERR "using: $type...\n";
604    
605  my $db;          # erase cache for tags by order in this database
606            delete $cache->{tags_by_order};
607    
608  foreach my $isis_db (@isis_dbs) {          if ($type_base eq "isis") {
609    
610                    my $isis_db = $cfg -> val($database, 'isis_db') || die "$database doesn't have 'isis_db' defined!";
611    
612          my $db = OpenIsis::open( $isis_db );                  $import2cp = Text::Iconv->new($config->{isis_codepage},$codepage);
613          if (0) {                  my $db = OpenIsis::open( $isis_db );
614  #       # FIX  
615  #       if (! $db ) {                  # check if .txt database for OpenIsis is zero length,
616                  print STDERR "WARNING: can't open '$isis_db'\n";                  # if so, erase it and re-open database
617                  next ;                  sub check_txt_db {
618          }                          my $isis_db = shift || die "need isis database name";
619                            my $reopen = 0;
620    
621          my $max_rowid = OpenIsis::maxRowid( $db );                          if (-e $isis_db.".TXT") {
622                                    print STDERR "WARNING: removing $isis_db.TXT OpenIsis database...\n";
623                                    unlink $isis_db.".TXT" || warn "FATAL: unlink error on '$isis_db.TXT': $!";
624                                    $reopen++;
625                            }
626                            if (-e $isis_db.".PTR") {
627                                    print STDERR "WARNING: removing $isis_db.PTR OpenIsis database...\n";
628                                    unlink $isis_db.".PTR" || warn "FATAL: unlink error on '$isis_db.PTR': $!";
629                                    $reopen++;
630                            }
631                            return OpenIsis::open( $isis_db ) if ($reopen);
632                    }
633    
634                    # EOF error
635                    if ($db == -1) {
636                            $db = check_txt_db($isis_db);
637                            if ($db == -1) {
638                                    print STDERR "FATAL: OpenIsis can't open zero size file $isis_db\n";
639                                    next;
640                            }
641                    }
642    
643          print STDERR "Reading database: $isis_db [$max_rowid rows]\n";                  # OpenIsis::ERR_BADF
644                    if ($db == -4) {
645                            print STDERR "FATAL: OpenIsis can't find file $isis_db\n";
646                            next;
647                    # OpenIsis::ERR_IO
648                    } elsif ($db == -5) {
649                            print STDERR "FATAL: OpenIsis can't access file $isis_db\n";
650                            next;
651                    } elsif ($db < 0) {
652                            print STDERR "FATAL: OpenIsis unknown error $db with file $isis_db\n";
653                            next;
654                    }
655    
656          my $last_p = 0;                  my $max_rowid = OpenIsis::maxRowid( $db );
657    
658                    # if 0 records, try to rease isis .txt database
659                    if ($max_rowid == 0) {
660                            # force removal of database
661                            $db = check_txt_db($isis_db);
662                            $max_rowid = OpenIsis::maxRowid( $db );
663                    }
664    
665                    print STDERR "Reading database: $isis_db [$max_rowid rows]\n";
666    
667                    my $path = $database;
668    
669                    for (my $row_id = 1; $row_id <= $max_rowid; $row_id++ ) {
670                            my $row = OpenIsis::read( $db, $row_id );
671                            if ($row && $row->{mfn}) {
672            
673                                    progress($row->{mfn}, $max_rowid);
674    
675                                    my $swishpath = $path."#".int($row->{mfn});
676    
677                                    if (my $xml = data2xml($type_base,$row,$add_xml,$cfg,$database)) {
678                                            $xml = $cp2utf->convert($xml);
679                                            use bytes;      # as opposed to chars
680                                            print "Path-Name: $swishpath\n";
681                                            print "Content-Length: ".(length($xml)+1)."\n";
682                                            print "Document-Type: XML\n\n$xml\n";
683                                    }
684                            }
685                    }
686                    # for this to work with current version of OpenIsis (0.9.0)
687                    # you might need my patch from
688                    # http://www.rot13.org/~dpavlin/projects/openisis-0.9.0-perl_close.diff
689                    OpenIsis::close($db);
690                    print STDERR "\n";
691    
692            } elsif ($type_base eq "excel") {
693                    use Spreadsheet::ParseExcel;
694                    use Spreadsheet::ParseExcel::Utility qw(int2col);
695                    
696                    $import2cp = Text::Iconv->new($config->{excel_codepage},$codepage);
697                    my $excel_file = $cfg -> val($database, 'excel_file') || die "$database doesn't have 'excel_file' defined!";
698    
699                    my $sheet = x($config->{sheet}) || die "no sheet in $type.xml";
700                    my $start_row = x($config->{start_row}) - 1 || die "no start_row in $type.xml";
701    
702                    my $oBook = Spreadsheet::ParseExcel::Workbook->Parse($excel_file) || die "can't open Excel file '$excel_file'";
703    
704                    my $sheet_nr = 0;
705                    foreach my $oWks (@{$oBook->{Worksheet}}) {
706                            #print STDERR "-- SHEET $sheet_nr:", $oWks->{Name}, "\n";
707                            last if ($oWks->{Name} eq $sheet);
708                            $sheet_nr++;
709                    }
710    
711                    my $oWorksheet = $oBook->{Worksheet}[$sheet_nr];
712            
713                    print STDERR "using sheet: ",$oWorksheet->{Name},"\n";
714                    defined ($oWorksheet) || die "can't find sheet '$sheet' in $excel_file";
715                    my $end_row = x($config->{end_row}) || $oWorksheet->{MaxRow};
716    
717                    for(my $iR = $start_row ; defined $end_row && $iR <= $end_row ; $iR++) {
718                            my $row;
719                            for(my $iC = $oWorksheet->{MinCol} ; defined $oWorksheet->{MaxCol} && $iC <= $oWorksheet->{MaxCol} ; $iC++) {
720                                    my $cell = $oWorksheet->{Cells}[$iR][$iC];
721                                    if ($cell) {
722                                            $row->{int2col($iC)} = $cell->Value;
723                                    }
724                            }
725    
726  #       { my $row_id = 1;                          progress($iR, $end_row);
727  # FIX  
728          for (my $row_id = 1; $row_id <= $max_rowid; $row_id++ ) {  #                       print "row[$iR/$end_row] ";
729                  my $row = OpenIsis::read( $db, $row_id );  #                       foreach (keys %{$row}) {
730                  if ($row && $row->{mfn}) {  #                               print "$_: ",$row->{$_},"\t";
731    #                       }
732                          # output current process indicator  #                       print "\n";
733                          my $p = int($row->{mfn} * 100 / $max_rowid);  
734                          if ($p != $last_p) {                          my $swishpath = $database."#".$iR;
735                                  printf STDERR ("%5d / %5d [%-51s] %-2d %% \r",$row->{mfn},$max_rowid,"=" x ($p/2).">", $p ) if (! $opts{q});  
736                                  $last_p = $p;                          next if (! $row);
737    
738                            if (my $xml = data2xml($type_base,$row,$add_xml,$cfg,$database)) {
739                                    $xml = $cp2utf->convert($xml);
740                                    use bytes;      # as opposed to chars
741                                    print "Path-Name: $swishpath\n";
742                                    print "Content-Length: ".(length($xml)+1)."\n";
743                                    print "Document-Type: XML\n\n$xml\n";
744                          }                          }
745                    }
746            } elsif ($type_base eq "marc") {
747    
748                    use MARC;
749                    
750                    $import2cp = Text::Iconv->new($config->{marc_codepage},$codepage);
751                    my $marc_file = $cfg -> val($database, 'marc_file') || die "$database doesn't have 'marc_file' defined!";
752    
753                    # optional argument is format
754                    my $format = x($config->{format}) || 'usmarc';
755    
756                    print STDERR "Reading MARC file '$marc_file'\n";
757    
758                    my $marc = new MARC;
759                    my $nr = $marc->openmarc({
760                                    file=>$marc_file, format=>$format
761                            }) || die "Can't open MARC file '$marc_file'";
762    
763                    my $i=0;        # record nr.
764    
765                    my $rec;
766    
767                          if (my $xml = isis2xml($row)) {                  while ($marc->nextmarc(1)) {
768                                  print "Path-Name: $isis_db#".$row->{mfn}."\n";  
769                            # XXX
770                            fakeprogress($i++);
771    
772                            my $swishpath = $database."#".$i;
773    
774                            if (my $xml = data2xml($type_base,$marc,$add_xml,$cfg,$database)) {
775                                    $xml = $cp2utf->convert($xml);
776                                    use bytes;      # as opposed to chars
777                                    print "Path-Name: $swishpath\n";
778                                  print "Content-Length: ".(length($xml)+1)."\n";                                  print "Content-Length: ".(length($xml)+1)."\n";
779                                  print "Document-Type: XML\n\n$xml\n";                                  print "Document-Type: XML\n\n$xml\n";
780                          }                          }
781                  }                  }
782            } elsif ($type_base eq "feed") {
783    
784                    $import2cp = Text::Iconv->new($config->{feed_codepage},$codepage);
785                    my $prog = x($config->{prog}) || die "$database doesn't have 'prog' defined!";
786    
787                    print STDERR "Reading feed from program '$prog'\n";
788    
789                    open(FEED,"feeds/$prog |") || die "can't start $prog: $!";
790    
791                    my $i=1;        # record nr.
792    
793                    my $data;
794                    my $line=1;
795    
796                    while (<FEED>) {
797                            chomp;
798    
799                            if (/^$/) {
800                                    my $swishpath = $database."#".$i++;
801    
802                                    if (my $xml = data2xml($type_base,$data,$add_xml,$cfg,$database)) {
803                                            $xml = $cp2utf->convert($xml);
804                                            use bytes;      # as opposed to chars
805                                            print "Path-Name: $swishpath\n";
806                                            print "Content-Length: ".(length($xml)+1)."\n";
807                                            print "Document-Type: XML\n\n$xml\n";
808                                    }
809                                    $line = 1;
810                                    $data = {};
811                                    next;
812                            }
813    
814                            $line = $1 if (s/^(\d+):\s*//);
815                            $data->{$line++} = $_;
816    
817                            fakeprogress($i);
818    
819                    }
820                    # close lookup
821                    untie %lhash if (%lhash);
822          }          }
         print STDERR "\n";  
823  }  }
824    
825    # call this to commit index
826    $index->close;
827    
828  1;  1;
829  __END__  __END__
# Line 182  __END__ Line 831  __END__
831    
832  =head1 NAME  =head1 NAME
833    
834  isis2xml.pl - read isis file and dump XML  all2xml.pl - read various file formats and dump XML for SWISH-E
835    
836  =head1 DESCRIPTION  =head1 DESCRIPTION
837    
838  This command will read ISIS data file using OpenIsis perl module and  This command will read ISIS data file using OpenIsis perl module, MARC
839  create XML file for usage with I<SWISH-E>  records using MARC module and optionally Micro$oft Excel files to
840  indexer. Dispite it's name, this script B<isn't general xml generator>  create one XML file for usage with I<SWISH-E> indexer. Dispite it's name,
841  from isis files (isis allready has something like that). Output of this  this script B<isn't general xml generator> from isis files (isis allready
842  script is tailor-made for SWISH-E.  has something like that). Output of this script is tailor-made for SWISH-E.
843    
844    =head1 BUGS
845    
846    Documentation is really lacking. However, in true Open Source spirit, source
847    is best documentation. I even made considerable effort to comment parts
848    which are not intuitively clear, so...
849    
850  =head1 AUTHOR  =head1 AUTHOR
851    

Legend:
Removed from v.3  
changed lines
  Added in v.188

  ViewVC Help
Powered by ViewVC 1.1.26