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

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

  ViewVC Help
Powered by ViewVC 1.1.26