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

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

  ViewVC Help
Powered by ViewVC 1.1.26