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

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

  ViewVC Help
Powered by ViewVC 1.1.26