/[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 54 by dpavlin, Mon Jun 23 20:20:32 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 18  die "FATAL: can't find configuration fil Line 21  die "FATAL: can't find configuration fil
21    
22  my $config;  my $config;
23    
24  use index_DBI;  # there is no other, right now ;-)  #use index_DBI;         # default DBI module for index
25    use index_DBI_cache;    # faster DBI module using memory cache
26  my $index;  my $index;
27    
28  my %opts;  my %opts;
# Line 33  getopts('d:m:qs', \%opts); Line 37  getopts('d:m:qs', \%opts);
37    
38  my $path;       # this is name of database  my $path;       # this is name of database
39    
40  Text::Iconv->raise_error(1);     # Conversion errors raise exceptions  Text::Iconv->raise_error(0);     # Conversion errors don't raise exceptions
41    
42  # this is encoding of all files on disk, including import_xml/*.xml file and  # this is encoding of all files on disk, including import_xml/*.xml file and
43  # filter/*.pm files! It will be used to store strings in perl internally!  # filter/*.pm files! It will be used to store strings in perl internally!
# Line 55  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 65  sub data2xml { Line 79  sub data2xml {
79          my $type = shift @_;          my $type = shift @_;
80          my $row = shift @_;          my $row = shift @_;
81          my $add_xml = shift @_;          my $add_xml = shift @_;
82            # needed to read values from configuration file
83            my $cfg = shift @_;
84            my $database = shift @_;
85    
86          my $xml;          my $xml;
87    
# Line 76  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 118  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 140  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                                            } elsif (lc($x->{type}) eq "lookup_val") {
319                                                    if ($lookup_key) {
320                                                            $lhash{$lookup_key} = $display;
321                                                    } else {
322                                                            print STDERR "WARNING: no lookup_key defined for  '$display'?";
323                                                  }                                                  }
                                         } else {  
                                                 $index->insert($field, $index_data, $path);  
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
390                    foreach my $x (@{$config->{indexer}->{$field}->{'config'}}) {
391    
392                  if ($display_data) {                          my $delimiter = x($x->{delimiter}) || ' ';
393                            my $val = $cfg->val($database, x($x->{content}));
394    
395                          if ($field eq "headline") {                          my ($s,$d,$i) = (1,1,0);        # swish, display default
396                                  $xml .= xmlify("headline", $display_data);                          $s = 0 if (lc($x->{type}) eq "display");
397                          } else {                          $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");
401    
402                                  # find field name (signular, plural)                          if ($val) {
403                                  my $field_name = "";                                  $display_data .= $delimiter.$val if ($d);
404                                  if ($config->{indexer}->{$field}->{name_singular} && $field_usage{$field} == 1) {                                  $swish_data .= $val if ($s);
405                                          $field_name = $config->{indexer}->{$field}->{name_singular}."#-#";                                  $index->insert($field, $val, $path) if ($i);
406                                  } elsif ($config->{indexer}->{$field}->{name_plural}) {                          }
407                                          $field_name = $config->{indexer}->{$field}->{name_plural}."#-#";  
408                                  } elsif ($config->{indexer}->{$field}->{name}) {                          if ($iterate_by_page) {
409                                          $field_name = $config->{indexer}->{$field}->{name}."#-#";                                  # FIXME data from config tag will appear just
410                                  } else {                                  # on first page!!!
411                                          print STDERR "WARNING: field '$field' doesn't have 'name' attribute!";                                  my $page = 0;
412                                    if ($display_data) {
413                                            $cache->{display_data}->{$field}->[$page] = $display_data;
414                                            $display_data = "";
415                                  }                                  }
416                                  if ($field_name) {                                  if ($swish_data) {
417                                          $html .= x($field_name);                                          $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                                  }                                  }
                                 $html .= $display_data."###\n";  
424                          }                          }
425                  }                  }
                 if ($swish_data) {  
                         # remove extra spaces  
                         $swish_data =~ s/ +/ /g;  
                         $swish_data =~ s/ +$//g;  
426    
427                          $xml .= xmlify($field."_swish", unac_string($codepage,$swish_data));                  # 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                                            $xml .= xmlify($field."_swish", unac_string($codepage,$swish_data));
453                                    }
454    
455                                    my $swish_exact_data = $cache->{swish_exact_data}->{$field}->[$page];
456                                    if ($swish_exact_data) {
457                                            $swish_exact_data =~ s/ +/ /g;
458                                            $swish_exact_data =~ s/ +$//g;
459    
460                                            # add delimiters before and after word.
461                                            # That is required to produce exact match
462                                            $xml .= xmlify($field."_swish_exact", unac_string($codepage,'xxbxx '.$swish_exact_data.' xxexx'));
463                                    }
464                                    
465                                    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                                    }
475                            }
476            
477                  }                  }
478                    
479                    if (! $iterate_by_page) {
480                            if ($display_data) {
481                                    if ($field eq "headline") {
482                                            $xml .= xmlify("headline", $display_data);
483                                    } else {
484    
485                                            # 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 233  $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          $config=XMLin("./import_xml/$type.xml", forcearray => [ $type2tag{$type} ], forcecontent => 1);          # extract just type basic
570            my $type_base = $type;
571            $type_base =~ s/_.+$//g;
572    
573            $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;                  my $total = shift || 1;
581                  my $p = int($current * 100 / $total);                  my $p = int($current * 100 / $total);
582                  if ($p != $last_p) {                  if ($p != $last_p) {
583                          printf STDERR ("%5d / %5d [%-51s] %-2d %% \r",$current,$total,"=" x ($p/2).">", $p );                          printf STDERR ("%5d / %5d [%-51s] %-2d %% \r",$current,$total,"=" x ($p/2).">", $p );
# Line 255  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          if ($type eq "isis") {          # erase cache for tags by order in this database
606            delete $cache->{tags_by_order};
607    
608            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!";
611    
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 278  print STDERR "using: $type...\n"; Line 674  print STDERR "using: $type...\n";
674    
675                                  my $swishpath = $path."#".int($row->{mfn});                                  my $swishpath = $path."#".int($row->{mfn});
676    
677                                  if (my $xml = data2xml($type,$row,$add_xml)) {                                  if (my $xml = data2xml($type_base,$row,$add_xml,$cfg,$database)) {
678                                          $xml = $cp2utf->convert($xml);                                          $xml = $cp2utf->convert($xml);
679                                          use bytes;      # as opposed to chars                                          use bytes;      # as opposed to chars
680                                          print "Path-Name: $swishpath\n";                                          print "Path-Name: $swishpath\n";
# Line 287  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 eq "excel") {          } elsif ($type_base eq "excel") {
693                  use Spreadsheet::ParseExcel;                  use Spreadsheet::ParseExcel;
694                  use Spreadsheet::ParseExcel::Utility qw(int2col);                  use Spreadsheet::ParseExcel::Utility qw(int2col);
695                                    
# Line 297  print STDERR "using: $type...\n"; Line 697  print STDERR "using: $type...\n";
697                  my $excel_file = $cfg -> val($database, 'excel_file') || die "$database doesn't have 'excel_file' defined!";                  my $excel_file = $cfg -> val($database, 'excel_file') || die "$database doesn't have 'excel_file' defined!";
698    
699                  my $sheet = x($config->{sheet}) || die "no sheet in $type.xml";                  my $sheet = x($config->{sheet}) || die "no sheet in $type.xml";
700                  my $start_row = x($config->{start_row}) || die "no start_row in $type.xml";                  my $start_row = x($config->{start_row}) - 1 || die "no start_row in $type.xml";
701    
702                  my $oBook = Spreadsheet::ParseExcel::Workbook->Parse($excel_file) || die "can't open Excel file '$excel_file'";                  my $oBook = Spreadsheet::ParseExcel::Workbook->Parse($excel_file) || die "can't open Excel file '$excel_file'";
703    
# Line 314  print STDERR "using: $type...\n"; Line 714  print STDERR "using: $type...\n";
714                  defined ($oWorksheet) || die "can't find sheet '$sheet' in $excel_file";                  defined ($oWorksheet) || die "can't find sheet '$sheet' in $excel_file";
715                  my $end_row = x($config->{end_row}) || $oWorksheet->{MaxRow};                  my $end_row = x($config->{end_row}) || $oWorksheet->{MaxRow};
716    
717                  for(my $iR = $oWorksheet->{MinRow} ; defined $end_row && $iR <= $end_row ; $iR++) {                  for(my $iR = $start_row ; defined $end_row && $iR <= $end_row ; $iR++) {
718                          my $row;                          my $row;
719                          for(my $iC = $oWorksheet->{MinCol} ; defined $oWorksheet->{MaxCol} && $iC <= $oWorksheet->{MaxCol} ; $iC++) {                          for(my $iC = $oWorksheet->{MinCol} ; defined $oWorksheet->{MaxCol} && $iC <= $oWorksheet->{MaxCol} ; $iC++) {
720                                  my $cell = $oWorksheet->{Cells}[$iR][$iC];                                  my $cell = $oWorksheet->{Cells}[$iR][$iC];
# Line 335  print STDERR "using: $type...\n"; Line 735  print STDERR "using: $type...\n";
735    
736                          next if (! $row);                          next if (! $row);
737    
738                          if (my $xml = data2xml($type,$row,$add_xml)) {                          if (my $xml = data2xml($type_base,$row,$add_xml,$cfg,$database)) {
739                                    $xml = $cp2utf->convert($xml);
740                                    use bytes;      # as opposed to chars
741                                    print "Path-Name: $swishpath\n";
742                                    print "Content-Length: ".(length($xml)+1)."\n";
743                                    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);                                  $xml = $cp2utf->convert($xml);
776                                  use bytes;      # as opposed to chars                                  use bytes;      # as opposed to chars
777                                  print "Path-Name: $swishpath\n";                                  print "Path-Name: $swishpath\n";
# Line 343  print STDERR "using: $type...\n"; Line 779  print STDERR "using: $type...\n";
779                                  print "Document-Type: XML\n\n$xml\n";                                  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 355  __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.54  
changed lines
  Added in v.188

  ViewVC Help
Powered by ViewVC 1.1.26