/[webpac]/branches/drustvene/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 /branches/drustvene/all2xml.pl

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

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

Legend:
Removed from v.7  
changed lines
  Added in v.182

  ViewVC Help
Powered by ViewVC 1.1.26