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

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

  ViewVC Help
Powered by ViewVC 1.1.26