/[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 74 by dpavlin, Sat Jul 5 22:37:30 2003 UTC revision 182 by dpavlin, Sat Nov 29 15:59:19 2003 UTC
# Line 9  use Text::Unaccent 1.02;       # 1.01 won't co Line 9  use Text::Unaccent 1.02;       # 1.01 won't co
9  use Text::Iconv;  use Text::Iconv;
10  use Config::IniFiles;  use Config::IniFiles;
11  use Encode;  use Encode;
12    #use GDBM_File;
13    use Fcntl;      # for O_RDWR
14    use TDB_File;
15    
16  $|=1;  $|=1;
17    
# Line 61  my %type2tag = ( Line 64  my %type2tag = (
64          'feed' => 'feed'          '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  sub data2xml {  sub data2xml {
76    
77          use xmlify;          use xmlify;
# Line 82  sub data2xml { Line 93  sub data2xml {
93    
94          # sort subrouting using order="" attribute          # sort subrouting using order="" attribute
95          sub by_order {          sub by_order {
96                  return 0 if (! $config->{indexer}->{$a}->{order});                  my $va = $config->{indexer}->{$a}->{order} ||
97                  return 0 if (! $config->{indexer}->{$b}->{order});                          $config->{indexer}->{$a};
98                    my $vb = $config->{indexer}->{$b}->{order} ||
99                            $config->{indexer}->{$b};
100    
101                  return $config->{indexer}->{$a}->{order} <=>                  return $va <=> $vb;
                         $config->{indexer}->{$b}->{order} ;  
102          }          }
103    
104          foreach my $field (sort by_order keys %{$config->{indexer}}) {          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                  $field=x($field);          # 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    
144    
145            # begin real work: go field by field
146            foreach my $field (@sorted_tags) {
147    
148                    $field=x($field);
149                  $field_usage{$field}++;                  $field_usage{$field}++;
150    
151                  my $swish_data = "";                  my $swish_data = "";
152                    my $swish_exact_data = "";
153                  my $display_data = "";                  my $display_data = "";
154                    my @index_data;
155                  my $line_delimiter;                  my $line_delimiter;
156    
157                  my ($swish,$display);                  my ($swish,$display);
158    
159                  my $tag = $type2tag{$type} || die "can't find which tag to use for type $type";                  my $tag = $type2tag{$type} || die "can't find which tag to use for type $type";
160    
161                    # 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}}) {                  foreach my $x (@{$config->{indexer}->{$field}->{$tag}}) {
169    
170                          my $format = x($x->{content});                          my $format = x($x->{content});
171                          my $delimiter = x($x->{delimiter}) || ' ';                          my $delimiter = x($x->{delimiter}) || ' ';
172    
173                          my $repeat_off = 0;             # repeatable offset                          my $repeat_off = 0;     # init repeatable offset
174    
175                          my ($s,$d,$i) = (1,1,0);        # swish, display default                          # 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");                          $s = 0 if (lc($x->{type}) eq "display");
179                          $d = 0 if (lc($x->{type}) eq "swish");                          $d = 0 if (lc($x->{type}) eq "swish");
180                          ($s,$d,$i) = (0,0,1) if (lc($x->{type}) eq "index");                          ($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?                          # what will separate last line from this one?
185                          if ($display_data && $x->{append} && $x->{append} eq "1") {                          if ($display_data && $x->{append}) {
186                                  $line_delimiter = ' ';                                  $line_delimiter = ' ';
187                          } elsif ($display_data) {                          } elsif ($display_data) {
188                                  $line_delimiter = '<br/>';                                  $line_delimiter = '<br/>';
# Line 124  sub data2xml { Line 191  sub data2xml {
191                          # init vars so that we go into while...                          # init vars so that we go into while...
192                          ($swish,$display) = (1,1);                          ($swish,$display) = (1,1);
193    
194                          if ($swish || $display) {                          # placeholder for all repeatable entries for index
195    
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                                    if ($fmt) {
210                                            my $nr = scalar $fmt =~ s/%s/%s/g;
211                                            if (($#data+1) == $nr) {
212                                                    return sprintf($fmt,@data);
213                                            } else {
214                                                    print STDERR "mkformat: [$data] can't be split on [$format_delimiter] to $nr fields!\n";
215                                                    return $data;
216                                            }
217                                    } else {
218                                            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);                                  ($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;
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                                  # filter="name" ; filter this field through
256                                  # filter/[name].pm                                  # filter/[name].pm
257                                  my $filter = $x->{filter};                                  my $filter = $x->{filter};
258                                  if ($filter) {                                  if ($filter && !$cache->{filter_loaded}->{$filter}) {
259                                          require "filter/".$filter.".pm";                                          require "filter/".$filter.".pm";
260                                            $cache->{filter_loaded}->{$filter}++;
261                                  }                                  }
262                                  # type="swish" ; field for swish                                  # type="swish" ; field for swish
263                                  if ($s && $swish) {                                  if ($swish) {
264                                          if ($filter) {                                          if ($filter && ($s || $se)) {
265                                                  no strict 'refs';                                                  no strict 'refs';
266                                                  $swish_data .= join(" ",&$filter($swish));                                                  my $tmp = join(" ",&$filter($swish)) if ($s || $se);
267                                                    $swish_data .= $tmp if ($s);
268                                                    $swish_exact_data .= $tmp if ($se);
269    
270                                          } else {                                          } else {
271                                                  $swish_data .= $swish;                                                  $swish_data .= $swish if ($s);
272                                                    $swish_exact_data .= $swish if ($se);
273                                          }                                          }
274                                  }                                  }
275    
# Line 146  sub data2xml { Line 277  sub data2xml {
277                                  if ($d && $display) {                                  if ($d && $display) {
278                                          if ($line_delimiter && $display_data) {                                          if ($line_delimiter && $display_data) {
279                                                  $display_data .= $line_delimiter;                                                  $display_data .= $line_delimiter;
                                                 undef $line_delimiter;  
280                                          }                                          }
281                                          if ($filter) {                                          if ($filter) {
282                                                  no strict 'refs';                                                  no strict 'refs';
283                                                  $display_data .= join($delimiter,&$filter($display));                                                  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 {                                          } else {
289                                                  if ($display_data) {                                                  if ($display_data) {
290                                                          $display_data .= $delimiter.$display;                                                          $display_data .= $delimiter.mkformat($x,$display);
291                                                  } else {                                                  } else {
292                                                          $display_data .= $display;                                                          $display_data = mkformat($x,$display);
293                                                  }                                                  }
294                                          }                                          }
295                                  }                                  }
296                                                                                                    
297                                  # type="index" ; insert into index                                  # type="index" ; insert into index
298                                    my $idisplay;
299                                  if ($i && $display) {                                  if ($i && $display) {
300                                          my $index_data = $display;                                          $idisplay = $display;
301                                          if ($filter) {                                          if ($filter) {
302                                                  no strict 'refs';                                                  no strict 'refs';
303                                                  foreach my $d (&$filter($index_data)) {                                                  $idisplay = &$filter($idisplay);
304                                                          $index->insert($field, $d, $path);                                          }
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                                                  }                                                  }
                                         } else {  
                                                 $index->insert($field, $index_data, $path);  
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                  }                  }
381    
# Line 184  sub data2xml { Line 388  sub data2xml {
388                          my ($s,$d,$i) = (1,1,0);        # swish, display default                          my ($s,$d,$i) = (1,1,0);        # swish, display default
389                          $s = 0 if (lc($x->{type}) eq "display");                          $s = 0 if (lc($x->{type}) eq "display");
390                          $d = 0 if (lc($x->{type}) eq "swish");                          $d = 0 if (lc($x->{type}) eq "swish");
391                            # no support for swish exact in config.
392                            # IMHO, it's useless
393                          ($s,$d,$i) = (0,0,1) if (lc($x->{type}) eq "index");                          ($s,$d,$i) = (0,0,1) if (lc($x->{type}) eq "index");
394    
395                          if ($val) {                          if ($val) {
# Line 192  sub data2xml { Line 398  sub data2xml {
398                                  $index->insert($field, $val, $path) if ($i);                                  $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                  if ($display_data) {                                                  # 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                          if ($field eq "headline") {                                          $xml .= xmlify($field."_swish", unac_string($codepage,$swish_data));
446                                  $xml .= xmlify("headline", $display_data);                                  }
447                          } else {  
448                                    my $swish_exact_data = $cache->{swish_exact_data}->{$field}->[$page];
449                                  # find field name (signular, plural)                                  if ($swish_exact_data) {
450                                  my $field_name = "";                                          $swish_exact_data =~ s/ +/ /g;
451                                  if ($config->{indexer}->{$field}->{name_singular} && $field_usage{$field} == 1) {                                          $swish_exact_data =~ s/ +$//g;
452                                          $field_name = $config->{indexer}->{$field}->{name_singular}."#-#";  
453                                  } elsif ($config->{indexer}->{$field}->{name_plural}) {                                          # add delimiters before and after word.
454                                          $field_name = $config->{indexer}->{$field}->{name_plural}."#-#";                                          # That is required to produce exact match
455                                  } elsif ($config->{indexer}->{$field}->{name}) {                                          $xml .= xmlify($field."_swish_exact", unac_string($codepage,'xxbxx '.$swish_exact_data.' xxexx'));
                                         $field_name = $config->{indexer}->{$field}->{name}."#-#";  
                                 } else {  
                                         print STDERR "WARNING: field '$field' doesn't have 'name' attribute!";  
456                                  }                                  }
457                                  if ($field_name) {                                  
458                                          $html .= x($field_name);                                  foreach my $d (@{$cache->{index_data}->{$field}->[$page]}) {
459                                            $index->insert($field, $d, $path);
460    #print STDERR "index $field: $d [$path]\n";
461                                  }                                  }
                                 $html .= $display_data."###\n";  
462                          }                          }
463            
464                  }                  }
465                  if ($swish_data) {                  
466                          # remove extra spaces                  if (! $iterate_by_page) {
467                          $swish_data =~ s/ +/ /g;                          if ($display_data) {
468                          $swish_data =~ s/ +$//g;                                  if ($field eq "headline") {
469                                            $xml .= xmlify("headline", $display_data);
470                                    } else {
471    
472                          $xml .= xmlify($field."_swish", unac_string($codepage,$swish_data));                                          # 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>          # dump formatted output in <html>
497          if ($html) {          if ($html) {
498                  $xml .= xmlify("html",$html);                  #$xml .= xmlify("html",$html);
499                    $xml .= "<html><![CDATA[ $html ]]></html>";
500          }          }
501                    
502          if ($xml) {          if ($xml) {
# Line 258  $index = new index_DBI( Line 523  $index = new index_DBI(
523                  $cfg_global->val('global', 'dbi_passwd') || '',                  $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  foreach my $database ($cfg->Sections) {  foreach my $database ($cfg->Sections) {
534    
535          my $type = lc($cfg -> val($database, 'type')) || die "$database doesn't have 'type' defined";          my $type = lc($cfg -> val($database, 'type')) || die "$database doesn't have 'type' defined";
536          my $add_xml = $cfg -> val($database, 'xml');    # optional          my $add_xml = $cfg -> val($database, 'xml');    # optional
537    
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    
546            # 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    
554  print STDERR "reading ./import_xml/$type.xml\n";  print STDERR "reading ./import_xml/$type.xml\n";
555    
556          # extract just type basic          # extract just type basic
557          my $type_base = $type;          my $type_base = $type;
558          $type_base =~ s/_.+$//g;          $type_base =~ s/_.+$//g;
559    
560          $config=XMLin("./import_xml/$type.xml", forcearray => [ $type2tag{$type_base}, 'config' ], forcecontent => 1);          $config=XMLin("./import_xml/$type.xml", forcearray => [ $type2tag{$type_base}, 'config', 'format' ], forcecontent => 1);
561    
562          # output current progress indicator          # output current progress indicator
563          my $last_p = 0;          my $last_p = 0;
564          sub progress {          sub progress {
565                  #return if (! $opts{q});        # FIXME                  return if (! $show_progress);
566                  my $current = shift;                  my $current = shift;
567                  my $total = shift || 1;                  my $total = shift || 1;
568                  my $p = int($current * 100 / $total);                  my $p = int($current * 100 / $total);
# Line 286  print STDERR "reading ./import_xml/$type Line 574  print STDERR "reading ./import_xml/$type
574    
575          my $fake_dir = 1;          my $fake_dir = 1;
576          sub fakeprogress {          sub fakeprogress {
577                    return if (! $show_progress);
578                  my $current = shift @_;                  my $current = shift @_;
579    
580                  my @ind = ('-','\\','|','/','-','\\','|','/', '-');                  my @ind = ('-','\\','|','/','-','\\','|','/', '-');
# Line 300  print STDERR "reading ./import_xml/$type Line 589  print STDERR "reading ./import_xml/$type
589          # now read database          # now read database
590  print STDERR "using: $type...\n";  print STDERR "using: $type...\n";
591    
592            # erase cache for tags by order in this database
593            delete $cache->{tags_by_order};
594    
595          if ($type_base eq "isis") {          if ($type_base eq "isis") {
596    
597                  my $isis_db = $cfg -> val($database, 'isis_db') || die "$database doesn't have 'isis_db' defined!";                  my $isis_db = $cfg -> val($database, 'isis_db') || die "$database doesn't have 'isis_db' defined!";
# Line 307  print STDERR "using: $type...\n"; Line 599  print STDERR "using: $type...\n";
599                  $import2cp = Text::Iconv->new($config->{isis_codepage},$codepage);                  $import2cp = Text::Iconv->new($config->{isis_codepage},$codepage);
600                  my $db = OpenIsis::open( $isis_db );                  my $db = OpenIsis::open( $isis_db );
601    
602                    # 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                            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                    # 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 );                  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";                  print STDERR "Reading database: $isis_db [$max_rowid rows]\n";
653    
654                  my $path = $database;                  my $path = $database;
# Line 330  print STDERR "using: $type...\n"; Line 670  print STDERR "using: $type...\n";
670                                  }                                  }
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";                  print STDERR "\n";
678    
679          } elsif ($type_base eq "excel") {          } elsif ($type_base eq "excel") {
# Line 460  print STDERR "using: $type...\n"; Line 804  print STDERR "using: $type...\n";
804                          fakeprogress($i);                          fakeprogress($i);
805    
806                  }                  }
807                    # close lookup
808                    untie %lhash if (%lhash);
809          }          }
810  }  }
811    
# Line 472  __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.74  
changed lines
  Added in v.182

  ViewVC Help
Powered by ViewVC 1.1.26