/[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 180 by dpavlin, Tue Nov 25 20:04:24 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            my @page_fields;        # names of fields
120    
121    
122            # subs used to produce output
123    
124            sub get_field_name($$$) {
125                    my ($config,$field,$field_usage) = @_;
126    
127                    # find field name (signular, plural)
128                    my $field_name = "";
129                    if ($config->{indexer}->{$field}->{name_singular} && $field_usage == 1) {
130                            $field_name = $config->{indexer}->{$field}->{name_singular};
131                    } elsif ($config->{indexer}->{$field}->{name_plural}) {
132                            $field_name = $config->{indexer}->{$field}->{name_plural};
133                    } elsif ($config->{indexer}->{$field}->{name}) {
134                            $field_name = $config->{indexer}->{$field}->{name};
135                    } else {
136                            print STDERR "WARNING: field '$field' doesn't have 'name' attribute!";
137                    }
138                    if ($field_name) {
139                            return x($field_name);
140                    }
141            }
142    
                 $field=x($field);  
143    
144            # begin real work: go field by field
145            foreach my $field (@sorted_tags) {
146    
147                    $field=x($field);
148                  $field_usage{$field}++;                  $field_usage{$field}++;
149    
150                  my $swish_data = "";                  my $swish_data = "";
151                    my $swish_exact_data = "";
152                  my $display_data = "";                  my $display_data = "";
153                  my $line_delimiter;                  my $line_delimiter;
154    
155                  my ($swish,$display);                  my ($swish,$display);
156    
157                  my $tag = $type2tag{$type} || die "can't find which tag to use for type $type";                  my $tag = $type2tag{$type} || die "can't find which tag to use for type $type";
158    
159                    # is this field page-by-page?
160                    my $iterate_by_page = $config->{indexer}->{$field}->{iterate_by_page};
161                    push @page_fields,$field if ($iterate_by_page);
162                    my %page_max = ();
163                    # default line_delimiter if using
164                    my $page_line_delimiter = $config->{indexer}->{$field}->{page_line_delimiter} || '<br/>';
165    
166                  foreach my $x (@{$config->{indexer}->{$field}->{$tag}}) {                  foreach my $x (@{$config->{indexer}->{$field}->{$tag}}) {
167    
168                          my $format = x($x->{content});                          my $format = x($x->{content});
169                          my $delimiter = x($x->{delimiter}) || ' ';                          my $delimiter = x($x->{delimiter}) || ' ';
170    
171                          my $repeat_off = 0;             # repeatable offset                          my $repeat_off = 0;     # init repeatable offset
172    
173                          my ($s,$d,$i) = (1,1,0);        # swish, display default                          # swish, swish_exact, display, index, index_lookup
174                            # swish and display defaults
175                            my ($s,$se,$d,$i,$il) = (1,0,1,0,0);
176                          $s = 0 if (lc($x->{type}) eq "display");                          $s = 0 if (lc($x->{type}) eq "display");
177                          $d = 0 if (lc($x->{type}) eq "swish");                          $d = 0 if (lc($x->{type}) eq "swish");
178                            $se = 1 if (lc($x->{type}) eq "swish_exact");
179                          ($s,$d,$i) = (0,0,1) if (lc($x->{type}) eq "index");                          ($s,$d,$i) = (0,0,1) if (lc($x->{type}) eq "index");
180                            $il = 1 if (lc($x->{type}) =~ /^lookup/);
181    
182    
183                          # what will separate last line from this one?                          # what will separate last line from this one?
184                          if ($display_data && $x->{append} && $x->{append} eq "1") {                          if ($display_data && $x->{append} && $x->{append} eq "1") {
# Line 118  sub data2xml { Line 190  sub data2xml {
190                          # init vars so that we go into while...                          # init vars so that we go into while...
191                          ($swish,$display) = (1,1);                          ($swish,$display) = (1,1);
192    
193                          if ($swish || $display) {                          # placeholder for all repeatable entries for index
194                            my @index_data;
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                                  if ($i && $display) {                                  if ($i && $display) {
                                         my $index_data = $display;  
299                                          if ($filter) {                                          if ($filter) {
300                                                  no strict 'refs';                                                  no strict 'refs';
301                                                  foreach my $d (&$filter($index_data)) {                                                  $display = &$filter($display);
302                                                          $index->insert($field, $d, $path);                                          }
303                                                  }                                          if ($x->{append} && @index_data) {
304                                                    $index_data[$#index_data].=$display;
305                                          } else {                                          } else {
306                                                  $index->insert($field, $index_data, $path);                                                  push @index_data, $display;
307                                            }
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                                                    }
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                                                    my $line_delimiter = $page_line_delimiter;
334                                                    $line_delimiter = " " if ($append);
335                                                    if (! $cache->{$what}->{$field}->[$page]) {
336                                                            $cache->{$what}->{$field}->[$page] = $data;
337                                                    } else {
338                                                            $cache->{$what}->{$field}->[$page] .= $line_delimiter.$data;
339                                                    }
340                                            }
341    
342                                            if ($display_data) {
343    print STDERR "line delimiter: ",Dumper($line_delimiter) if ($line_delimiter);
344                                                    iterate_fld($cache,'display_data',$field,$page,$display_data,$x->{append});
345                                            }
346                                                    $display_data = "";
347                                            if ($swish_data) {
348                                                    iterate_fld($cache,'swish_data',$field,$page,$swish_data,$x->{append});
349                                                    $swish_data = "";
350                                            }
351                                            if ($swish_exact_data) {
352                                                    iterate_fld($cache,'swish_exact_data',$field,$page,$swish_exact_data,$x->{append});
353                                                    $swish_exact_data = "";
354                                          }                                          }
355                                  }                                  }
356                          }                          }
357    
358                            # fill data in index
359                            foreach my $d (@index_data) {
360                                    $index->insert($field, $d, $path);
361                            }
362                  }                  }
363    
364                    # now try to parse variables from configuration file
365                    foreach my $x (@{$config->{indexer}->{$field}->{'config'}}) {
366    
367                  if ($display_data) {                          my $delimiter = x($x->{delimiter}) || ' ';
368                            my $val = $cfg->val($database, x($x->{content}));
369    
370                            my ($s,$d,$i) = (1,1,0);        # swish, display default
371                            $s = 0 if (lc($x->{type}) eq "display");
372                            $d = 0 if (lc($x->{type}) eq "swish");
373                            # no support for swish exact in config.
374                            # IMHO, it's useless
375                            ($s,$d,$i) = (0,0,1) if (lc($x->{type}) eq "index");
376    
377                          if ($field eq "headline") {                          if ($val) {
378                                  $xml .= xmlify("headline", $display_data);                                  $display_data .= $delimiter.$val if ($d);
379                          } else {                                  $swish_data .= $val if ($s);
380                                    $index->insert($field, $val, $path) if ($i);
381                            }
382    
383                                  # find field name (signular, plural)                          if ($iterate_by_page) {
384                                  my $field_name = "";                                  # FIXME data from config tag will appear just
385                                  if ($config->{indexer}->{$field}->{name_singular} && $field_usage{$field} == 1) {                                  # on first page!!!
386                                          $field_name = $config->{indexer}->{$field}->{name_singular}."#-#";                                  my $page = 0;
387                                  } elsif ($config->{indexer}->{$field}->{name_plural}) {                                  if ($display_data) {
388                                          $field_name = $config->{indexer}->{$field}->{name_plural}."#-#";                                          $cache->{display_data}->{$field}->[$page] = $display_data;
389                                  } elsif ($config->{indexer}->{$field}->{name}) {                                          $display_data = "";
                                         $field_name = $config->{indexer}->{$field}->{name}."#-#";  
                                 } else {  
                                         print STDERR "WARNING: field '$field' doesn't have 'name' attribute!";  
390                                  }                                  }
391                                  if ($field_name) {                                  if ($swish_data) {
392                                          $html .= x($field_name);                                          $cache->{swish_data}->{$field}->[$page] = $swish_data;
393                                            $swish_data = "";
394                                    }
395                                    if ($swish_exact_data) {
396                                            $cache->{swish_exact_data}->{$field}->[$page] = $swish_exact_data;
397                                            $swish_exact_data = "";
398                                  }                                  }
                                 $html .= $display_data."###\n";  
399                          }                          }
400                  }                  }
                 if ($swish_data) {  
                         # remove extra spaces  
                         $swish_data =~ s/ +/ /g;  
                         $swish_data =~ s/ +$//g;  
401    
402                          $xml .= xmlify($field."_swish", unac_string($codepage,$swish_data));                  # save data page-by-page
403                    foreach my $field (@page_fields) {
404                            my $nr_pages = $page_max{$field} || next;
405    #print STDERR "field '$field' iterate over ",($nr_pages || 0)," pages...\n";
406    #print STDERR Dumper($cache->{display_data});
407                            for (my $page=0; $page <= $nr_pages; $page++) {
408    
409                                    my $display_data = $cache->{display_data}->{$field}->[$page];
410                                    if ($display_data) { # default
411                                            if ($field eq "headline") {
412                                                    $xml .= xmlify("headline", $display_data);
413                                            } else {
414    
415                                                    # fallback to empty field name if needed
416                                                    $html .= get_field_name($config,$field,$field_usage{$field}) || '';
417                                                    $html .= "#-#".$display_data."###\n";
418                                            }
419                                    }
420                                    
421                                    my $swish_data = $cache->{swish_data}->{$field}->[$page];
422                                    if ($swish_data) {
423                                            # remove extra spaces
424                                            $swish_data =~ s/ +/ /g;
425                                            $swish_data =~ s/ +$//g;
426    
427                                            $xml .= xmlify($field."_swish", unac_string($codepage,$swish_data));
428                                    }
429    
430                                    my $swish_exact_data = $cache->{swish_exact_data}->{$field}->[$page];
431                                    if ($swish_exact_data) {
432                                            $swish_exact_data =~ s/ +/ /g;
433                                            $swish_exact_data =~ s/ +$//g;
434    
435                                            # add delimiters before and after word.
436                                            # That is required to produce exact match
437                                            $xml .= xmlify($field."_swish_exact", unac_string($codepage,'xxbxx '.$swish_exact_data.' xxexx'));
438                                    }
439                            }
440            
441                  }                  }
442                    
443                    if (! $iterate_by_page) {
444                            if ($display_data) {
445                                    if ($field eq "headline") {
446                                            $xml .= xmlify("headline", $display_data);
447                                    } else {
448    
449                                            # fallback to empty field name if needed
450                                            $html .= get_field_name($config,$field,$field_usage{$field}) || '';
451                                            $html .= "#-#".$display_data."###\n";
452                                    }
453                            }
454                            if ($swish_data) {
455                                    # remove extra spaces
456                                    $swish_data =~ s/ +/ /g;
457                                    $swish_data =~ s/ +$//g;
458    
459                                    $xml .= xmlify($field."_swish", unac_string($codepage,$swish_data));
460                            }
461    
462                            if ($swish_exact_data) {
463                                    $swish_exact_data =~ s/ +/ /g;
464                                    $swish_exact_data =~ s/ +$//g;
465    
466                                    # add delimiters before and after word.
467                                    # That is required to produce exact match
468                                    $xml .= xmlify($field."_swish_exact", unac_string($codepage,'xxbxx '.$swish_exact_data.' xxexx'));
469                            }
470                    }
471          }          }
472    
473          # dump formatted output in <html>          # dump formatted output in <html>
474          if ($html) {          if ($html) {
475                  $xml .= xmlify("html",$html);                  #$xml .= xmlify("html",$html);
476                    $xml .= "<html><![CDATA[ $html ]]></html>";
477          }          }
478                    
479          if ($xml) {          if ($xml) {
# Line 233  $index = new index_DBI( Line 500  $index = new index_DBI(
500                  $cfg_global->val('global', 'dbi_passwd') || '',                  $cfg_global->val('global', 'dbi_passwd') || '',
501          );          );
502    
503    my $show_progress = $cfg_global->val('global', 'show_progress');
504    
505    my $unac_filter = $cfg_global->val('global', 'unac_filter');
506    if ($unac_filter) {
507            require $unac_filter;
508    }
509    
510  foreach my $database ($cfg->Sections) {  foreach my $database ($cfg->Sections) {
511    
512          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";
513          my $add_xml = $cfg -> val($database, 'xml');    # optional          my $add_xml = $cfg -> val($database, 'xml');    # optional
514    
515            # create new lookup file
516            my $lookup_file = $cfg -> val($database, 'lookup_newfile'); # optional
517            if ($lookup_file) {
518                    #tie %lhash, 'GDBM_File', $lookup_file, &GDBM_NEWDB, 0644;
519                    tie %lhash, 'TDB_File', $lookup_file, TDB_CLEAR_IF_FIRST, O_RDWR, 0644;
520                    print STDERR "creating lookup file '$lookup_file'\n";
521            }
522    
523            # open existing lookup file
524            $lookup_file = $cfg -> val($database, 'lookup_open'); # optional
525            if ($lookup_file) {
526                    #tie %lhash, 'GDBM_File', $lookup_file, &GDBM_READER, 0644;
527                    tie %lhash, 'TDB_File', $lookup_file, TDB_DEFAULT, O_RDWR, 0644;
528                    print STDERR "opening lookup file '$lookup_file'\n";
529            }
530    
531  print STDERR "reading ./import_xml/$type.xml\n";  print STDERR "reading ./import_xml/$type.xml\n";
532    
533          $config=XMLin("./import_xml/$type.xml", forcearray => [ $type2tag{$type} ], forcecontent => 1);          # extract just type basic
534            my $type_base = $type;
535            $type_base =~ s/_.+$//g;
536    
537            $config=XMLin("./import_xml/$type.xml", forcearray => [ $type2tag{$type_base}, 'config', 'format' ], forcecontent => 1);
538    
539          # output current progress indicator          # output current progress indicator
540          my $last_p = 0;          my $last_p = 0;
541          sub progress {          sub progress {
542                  #return if (! $opts{q});        # FIXME                  return if (! $show_progress);
543                  my $current = shift;                  my $current = shift;
544                  my $total = shift;                  my $total = shift || 1;
545                  my $p = int($current * 100 / $total);                  my $p = int($current * 100 / $total);
546                  if ($p != $last_p) {                  if ($p != $last_p) {
547                          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 549  print STDERR "reading ./import_xml/$type
549                  }                  }
550          }          }
551    
552            my $fake_dir = 1;
553            sub fakeprogress {
554                    return if (! $show_progress);
555                    my $current = shift @_;
556    
557                    my @ind = ('-','\\','|','/','-','\\','|','/', '-');
558    
559                    $last_p += $fake_dir;
560                    $fake_dir = -$fake_dir if ($last_p > 1000 || $last_p < 0);
561                    if ($last_p % 10 == 0) {
562                            printf STDERR ("%5d / %5s [%-51s]\r",$current,"?"," " x ($last_p/20).$ind[($last_p/20) % $#ind]);
563                    }
564            }
565    
566          # now read database          # now read database
567  print STDERR "using: $type...\n";  print STDERR "using: $type...\n";
568    
569          if ($type eq "isis") {          # erase cache for tags by order in this database
570            delete $cache->{tags_by_order};
571    
572            if ($type_base eq "isis") {
573    
574                  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!";
575    
576                  $import2cp = Text::Iconv->new($config->{isis_codepage},$codepage);                  $import2cp = Text::Iconv->new($config->{isis_codepage},$codepage);
577                  my $db = OpenIsis::open( $isis_db );                  my $db = OpenIsis::open( $isis_db );
578    
579                    # check if .txt database for OpenIsis is zero length,
580                    # if so, erase it and re-open database
581                    sub check_txt_db {
582                            my $isis_db = shift || die "need isis database name";
583                            my $reopen = 0;
584    
585                            if (-e $isis_db.".TXT") {
586                                    print STDERR "WARNING: removing $isis_db.TXT OpenIsis database...\n";
587                                    unlink $isis_db.".TXT" || warn "FATAL: unlink error on '$isis_db.TXT': $!";
588                                    $reopen++;
589                            }
590                            if (-e $isis_db.".PTR") {
591                                    print STDERR "WARNING: removing $isis_db.PTR OpenIsis database...\n";
592                                    unlink $isis_db.".PTR" || warn "FATAL: unlink error on '$isis_db.PTR': $!";
593                                    $reopen++;
594                            }
595                            return OpenIsis::open( $isis_db ) if ($reopen);
596                    }
597    
598                    # EOF error
599                    if ($db == -1) {
600                            $db = check_txt_db($isis_db);
601                            if ($db == -1) {
602                                    print STDERR "FATAL: OpenIsis can't open zero size file $isis_db\n";
603                                    next;
604                            }
605                    }
606    
607                    # OpenIsis::ERR_BADF
608                    if ($db == -4) {
609                            print STDERR "FATAL: OpenIsis can't find file $isis_db\n";
610                            next;
611                    # OpenIsis::ERR_IO
612                    } elsif ($db == -5) {
613                            print STDERR "FATAL: OpenIsis can't access file $isis_db\n";
614                            next;
615                    } elsif ($db < 0) {
616                            print STDERR "FATAL: OpenIsis unknown error $db with file $isis_db\n";
617                            next;
618                    }
619    
620                  my $max_rowid = OpenIsis::maxRowid( $db );                  my $max_rowid = OpenIsis::maxRowid( $db );
621    
622                    # if 0 records, try to rease isis .txt database
623                    if ($max_rowid == 0) {
624                            # force removal of database
625                            $db = check_txt_db($isis_db);
626                            $max_rowid = OpenIsis::maxRowid( $db );
627                    }
628    
629                  print STDERR "Reading database: $isis_db [$max_rowid rows]\n";                  print STDERR "Reading database: $isis_db [$max_rowid rows]\n";
630    
631                  my $path = $database;                  my $path = $database;
# Line 278  print STDERR "using: $type...\n"; Line 638  print STDERR "using: $type...\n";
638    
639                                  my $swishpath = $path."#".int($row->{mfn});                                  my $swishpath = $path."#".int($row->{mfn});
640    
641                                  if (my $xml = data2xml($type,$row,$add_xml)) {                                  if (my $xml = data2xml($type_base,$row,$add_xml,$cfg,$database)) {
642                                          $xml = $cp2utf->convert($xml);                                          $xml = $cp2utf->convert($xml);
643                                          use bytes;      # as opposed to chars                                          use bytes;      # as opposed to chars
644                                          print "Path-Name: $swishpath\n";                                          print "Path-Name: $swishpath\n";
# Line 287  print STDERR "using: $type...\n"; Line 647  print STDERR "using: $type...\n";
647                                  }                                  }
648                          }                          }
649                  }                  }
650                    # for this to work with current version of OpenIsis (0.9.0)
651                    # you might need my patch from
652                    # http://www.rot13.org/~dpavlin/projects/openisis-0.9.0-perl_close.diff
653                    OpenIsis::close($db);
654                  print STDERR "\n";                  print STDERR "\n";
655    
656          } elsif ($type eq "excel") {          } elsif ($type_base eq "excel") {
657                  use Spreadsheet::ParseExcel;                  use Spreadsheet::ParseExcel;
658                  use Spreadsheet::ParseExcel::Utility qw(int2col);                  use Spreadsheet::ParseExcel::Utility qw(int2col);
659                                    
# Line 297  print STDERR "using: $type...\n"; Line 661  print STDERR "using: $type...\n";
661                  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!";
662    
663                  my $sheet = x($config->{sheet}) || die "no sheet in $type.xml";                  my $sheet = x($config->{sheet}) || die "no sheet in $type.xml";
664                  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";
665    
666                  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'";
667    
# Line 314  print STDERR "using: $type...\n"; Line 678  print STDERR "using: $type...\n";
678                  defined ($oWorksheet) || die "can't find sheet '$sheet' in $excel_file";                  defined ($oWorksheet) || die "can't find sheet '$sheet' in $excel_file";
679                  my $end_row = x($config->{end_row}) || $oWorksheet->{MaxRow};                  my $end_row = x($config->{end_row}) || $oWorksheet->{MaxRow};
680    
681                  for(my $iR = $oWorksheet->{MinRow} ; defined $end_row && $iR <= $end_row ; $iR++) {                  for(my $iR = $start_row ; defined $end_row && $iR <= $end_row ; $iR++) {
682                          my $row;                          my $row;
683                          for(my $iC = $oWorksheet->{MinCol} ; defined $oWorksheet->{MaxCol} && $iC <= $oWorksheet->{MaxCol} ; $iC++) {                          for(my $iC = $oWorksheet->{MinCol} ; defined $oWorksheet->{MaxCol} && $iC <= $oWorksheet->{MaxCol} ; $iC++) {
684                                  my $cell = $oWorksheet->{Cells}[$iR][$iC];                                  my $cell = $oWorksheet->{Cells}[$iR][$iC];
# Line 335  print STDERR "using: $type...\n"; Line 699  print STDERR "using: $type...\n";
699    
700                          next if (! $row);                          next if (! $row);
701    
702                          if (my $xml = data2xml($type,$row,$add_xml)) {                          if (my $xml = data2xml($type_base,$row,$add_xml,$cfg,$database)) {
703                                  $xml = $cp2utf->convert($xml);                                  $xml = $cp2utf->convert($xml);
704                                  use bytes;      # as opposed to chars                                  use bytes;      # as opposed to chars
705                                  print "Path-Name: $swishpath\n";                                  print "Path-Name: $swishpath\n";
# Line 343  print STDERR "using: $type...\n"; Line 707  print STDERR "using: $type...\n";
707                                  print "Document-Type: XML\n\n$xml\n";                                  print "Document-Type: XML\n\n$xml\n";
708                          }                          }
709                  }                  }
710            } elsif ($type_base eq "marc") {
711    
712                    use MARC;
713                    
714                    $import2cp = Text::Iconv->new($config->{marc_codepage},$codepage);
715                    my $marc_file = $cfg -> val($database, 'marc_file') || die "$database doesn't have 'marc_file' defined!";
716    
717                    # optional argument is format
718                    my $format = x($config->{format}) || 'usmarc';
719    
720                    print STDERR "Reading MARC file '$marc_file'\n";
721    
722                    my $marc = new MARC;
723                    my $nr = $marc->openmarc({
724                                    file=>$marc_file, format=>$format
725                            }) || die "Can't open MARC file '$marc_file'";
726    
727                    my $i=0;        # record nr.
728    
729                    my $rec;
730    
731                    while ($marc->nextmarc(1)) {
732    
733                            # XXX
734                            fakeprogress($i++);
735    
736                            my $swishpath = $database."#".$i;
737    
738                            if (my $xml = data2xml($type_base,$marc,$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 "feed") {
747    
748                    $import2cp = Text::Iconv->new($config->{feed_codepage},$codepage);
749                    my $prog = x($config->{prog}) || die "$database doesn't have 'prog' defined!";
750    
751                    print STDERR "Reading feed from program '$prog'\n";
752    
753                    open(FEED,"feeds/$prog |") || die "can't start $prog: $!";
754    
755                    my $i=1;        # record nr.
756    
757                    my $data;
758                    my $line=1;
759    
760                    while (<FEED>) {
761                            chomp;
762    
763                            if (/^$/) {
764                                    my $swishpath = $database."#".$i++;
765    
766                                    if (my $xml = data2xml($type_base,$data,$add_xml,$cfg,$database)) {
767                                            $xml = $cp2utf->convert($xml);
768                                            use bytes;      # as opposed to chars
769                                            print "Path-Name: $swishpath\n";
770                                            print "Content-Length: ".(length($xml)+1)."\n";
771                                            print "Document-Type: XML\n\n$xml\n";
772                                    }
773                                    $line = 1;
774                                    $data = {};
775                                    next;
776                            }
777    
778                            $line = $1 if (s/^(\d+):\s*//);
779                            $data->{$line++} = $_;
780    
781                            fakeprogress($i);
782    
783                    }
784                    # close lookup
785                    untie %lhash if (%lhash);
786          }          }
787  }  }
788    
# Line 355  __END__ Line 795  __END__
795    
796  =head1 NAME  =head1 NAME
797    
798  isis2xml.pl - read isis file and dump XML  all2xml.pl - read various file formats and dump XML for SWISH-E
799    
800  =head1 DESCRIPTION  =head1 DESCRIPTION
801    
802  This command will read ISIS data file using OpenIsis perl module and  This command will read ISIS data file using OpenIsis perl module, MARC
803  create XML file for usage with I<SWISH-E>  records using MARC module and optionally Micro$oft Excel files to
804  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,
805  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
806  script is tailor-made for SWISH-E.  has something like that). Output of this script is tailor-made for SWISH-E.
807    
808    =head1 BUGS
809    
810    Documentation is really lacking. However, in true Open Source spirit, source
811    is best documentation. I even made considerable effort to comment parts
812    which are not intuitively clear, so...
813    
814  =head1 AUTHOR  =head1 AUTHOR
815    

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

  ViewVC Help
Powered by ViewVC 1.1.26