/[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 56 by dpavlin, Wed Jun 25 12:09:27 2003 UTC revision 153 by dpavlin, Sun Nov 16 22:42:41 2003 UTC
# Line 18  die "FATAL: can't find configuration fil Line 18  die "FATAL: can't find configuration fil
18    
19  my $config;  my $config;
20    
21  use index_DBI;  # there is no other, right now ;-)  #use index_DBI;         # default DBI module for index
22    use index_DBI_cache;    # faster DBI module using memory cache
23  my $index;  my $index;
24    
25  my %opts;  my %opts;
# Line 33  getopts('d:m:qs', \%opts); Line 34  getopts('d:m:qs', \%opts);
34    
35  my $path;       # this is name of database  my $path;       # this is name of database
36    
37  Text::Iconv->raise_error(1);     # Conversion errors raise exceptions  Text::Iconv->raise_error(0);     # Conversion errors don't raise exceptions
38    
39  # 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
40  # 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 56  my $cp2utf = Text::Iconv->new($codepage,
56  # format in XML file  # format in XML file
57  my %type2tag = (  my %type2tag = (
58          'isis' => 'isis',          'isis' => 'isis',
59          'excel' => 'column'          'excel' => 'column',
60            'marc' => 'marc',
61            'feed' => 'feed'
62  );  );
63    
64  sub data2xml {  sub data2xml {
# Line 65  sub data2xml { Line 68  sub data2xml {
68          my $type = shift @_;          my $type = shift @_;
69          my $row = shift @_;          my $row = shift @_;
70          my $add_xml = shift @_;          my $add_xml = shift @_;
71            # needed to read values from configuration file
72            my $cfg = shift @_;
73            my $database = shift @_;
74    
75          my $xml;          my $xml;
76    
# Line 76  sub data2xml { Line 82  sub data2xml {
82    
83          # sort subrouting using order="" attribute          # sort subrouting using order="" attribute
84          sub by_order {          sub by_order {
85                  return 0 if (! $config->{indexer}->{$a}->{order});                  my $va = $config->{indexer}->{$a}->{order} ||
86                  return 0 if (! $config->{indexer}->{$b}->{order});                          $config->{indexer}->{$a};
87                    my $vb = $config->{indexer}->{$b}->{order} ||
88                            $config->{indexer}->{$b};
89    
90                  return $config->{indexer}->{$a}->{order} <=>                  return $va <=> $vb;
                         $config->{indexer}->{$b}->{order} ;  
91          }          }
92    
93          foreach my $field (sort by_order keys %{$config->{indexer}}) {          foreach my $field (sort by_order keys %{$config->{indexer}}) {
94    
95                  $field=x($field);                  $field=x($field);
   
96                  $field_usage{$field}++;                  $field_usage{$field}++;
97    
98                  my $swish_data = "";                  my $swish_data = "";
# Line 118  sub data2xml { Line 124  sub data2xml {
124                          # init vars so that we go into while...                          # init vars so that we go into while...
125                          ($swish,$display) = (1,1);                          ($swish,$display) = (1,1);
126    
127                          if ($swish || $display) {                          # placeholder for all repeatable entries for index
128                            my @index_data;
129                            my $index_filter;
130    
131                            sub mkformat {
132                                    my $x = shift || die "mkformat needs tag reference";
133                                    my $data = shift || return;
134                                    my $format_name = x($x->{format_name}) || return $data;
135                                    my $fmt = x($config->{format}->{$format_name}->{content}) || die "<format name=\"$format_name\"> is not defined!";
136                                    my $format_delimiter = x($x->{format_delimiter});
137                                    my @data;
138                                    if ($format_delimiter) {
139                                            @data = split(/$format_delimiter/,$data);
140                                    } else {
141                                            push @data,$data;
142                                    }
143    
144                                    if ($fmt) {
145                                            my $nr = scalar $fmt =~ s/%s/%s/g;
146                                            if (($#data+1) == $nr) {
147                                                    return sprintf($fmt,@data);
148                                            } else {
149                                                    print STDERR "mkformat: [$data] can't be split on [$format_delimiter] to $nr fields!\n";
150                                                    return $data;
151                                            }
152                                    } else {
153                                            print STDERR "usage of link '$format_name' without defined format (<link> tag)\n";
154                                    }
155                            }
156    
157                            # while because of repeatable fields
158                            while ($swish || $display) {
159                                  ($swish,$display) = parse_format($type, $format,$row,$repeat_off++,$import2cp);                                  ($swish,$display) = parse_format($type, $format,$row,$repeat_off++,$import2cp);
160                                    if ($repeat_off > 1000) {
161                                            print STDERR "loop (more than 1000 repeatable fields) deteced in $row, $format\n";
162                                            last;
163                                    }
164                                    
165                                  # filter="name" ; filter this field through                                  # filter="name" ; filter this field through
166                                  # filter/[name].pm                                  # filter/[name].pm
167                                  my $filter = $x->{filter};                                  my $filter = $x->{filter};
# Line 144  sub data2xml { Line 186  sub data2xml {
186                                          }                                          }
187                                          if ($filter) {                                          if ($filter) {
188                                                  no strict 'refs';                                                  no strict 'refs';
189                                                  $display_data .= join($delimiter,&$filter($display));                                                  if ($display_data) {
190                                                            $display_data .= $delimiter.join($delimiter,mkformat($x,&$filter($display)));
191                                                    } else {
192                                                            $display_data = join($delimiter,mkformat($x,&$filter($display)));
193                                                    }
194                                          } else {                                          } else {
195                                                  if ($display_data) {                                                  if ($display_data) {
196                                                          $display_data .= $delimiter.$display;                                                          $display_data .= $delimiter.mkformat($x,$display);
197                                                  } else {                                                  } else {
198                                                          $display_data .= $display;                                                          $display_data = mkformat($x,$display);
199                                                  }                                                  }
200                                          }                                          }
201                                  }                                  }
202                                                                                                    
203                                  # type="index" ; insert into index                                  # type="index" ; insert into index
204                                  if ($i && $display) {                                  if ($i && $display) {
205                                          my $index_data = $display;                                          push @index_data, $display;
206                                          if ($filter) {                                          $index_filter = $filter if ($filter);
207                                                  no strict 'refs';                                  }
208                                                  foreach my $d (&$filter($index_data)) {                          }
209                                                          $index->insert($field, $d, $path);  
210                                                  }                          # fill data in index
211                                          } else {                          if (@index_data) {
212                                                  $index->insert($field, $index_data, $path);                                  if ($index_filter) {
213                                            no strict 'refs';
214                                            foreach my $d (@index_data) {
215                                                    $index->insert($field, &$index_filter($d), $path);
216                                            }
217                                    } else {
218                                            foreach my $d (@index_data) {
219                                                    $index->insert($field, $d, $path);
220                                          }                                          }
221                                  }                                  }
222                          }                          }
223                  }                  }
224    
225                    # now try to parse variables from configuration file
226                    foreach my $x (@{$config->{indexer}->{$field}->{'config'}}) {
227    
228                            my $delimiter = x($x->{delimiter}) || ' ';
229                            my $val = $cfg->val($database, x($x->{content}));
230    
231                            my ($s,$d,$i) = (1,1,0);        # swish, display default
232                            $s = 0 if (lc($x->{type}) eq "display");
233                            $d = 0 if (lc($x->{type}) eq "swish");
234                            ($s,$d,$i) = (0,0,1) if (lc($x->{type}) eq "index");
235    
236                            if ($val) {
237                                    $display_data .= $delimiter.$val if ($d);
238                                    $swish_data .= $val if ($s);
239                                    $index->insert($field, $val, $path) if ($i);
240                            }
241    
242                    }
243    
244    
245                  if ($display_data) {                  if ($display_data) {
246    
# Line 206  sub data2xml { Line 278  sub data2xml {
278    
279          # dump formatted output in <html>          # dump formatted output in <html>
280          if ($html) {          if ($html) {
281                  $xml .= xmlify("html",$html);                  #$xml .= xmlify("html",$html);
282                    $xml .= "<html><![CDATA[ $html ]]></html>";
283          }          }
284                    
285          if ($xml) {          if ($xml) {
# Line 233  $index = new index_DBI( Line 306  $index = new index_DBI(
306                  $cfg_global->val('global', 'dbi_passwd') || '',                  $cfg_global->val('global', 'dbi_passwd') || '',
307          );          );
308    
309    my $show_progress = $cfg_global->val('global', 'show_progress');
310    
311  foreach my $database ($cfg->Sections) {  foreach my $database ($cfg->Sections) {
312    
313          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";
# Line 240  foreach my $database ($cfg->Sections) { Line 315  foreach my $database ($cfg->Sections) {
315    
316  print STDERR "reading ./import_xml/$type.xml\n";  print STDERR "reading ./import_xml/$type.xml\n";
317    
318          $config=XMLin("./import_xml/$type.xml", forcearray => [ $type2tag{$type} ], forcecontent => 1);          # extract just type basic
319            my $type_base = $type;
320            $type_base =~ s/_.+$//g;
321    
322            $config=XMLin("./import_xml/$type.xml", forcearray => [ $type2tag{$type_base}, 'config', 'format' ], forcecontent => 1);
323    
324          # output current progress indicator          # output current progress indicator
325          my $last_p = 0;          my $last_p = 0;
326          sub progress {          sub progress {
327                  #return if (! $opts{q});        # FIXME                  return if (! $show_progress);
328                  my $current = shift;                  my $current = shift;
329                  my $total = shift;                  my $total = shift || 1;
330                  my $p = int($current * 100 / $total);                  my $p = int($current * 100 / $total);
331                  if ($p != $last_p) {                  if ($p != $last_p) {
332                          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 334  print STDERR "reading ./import_xml/$type
334                  }                  }
335          }          }
336    
337            my $fake_dir = 1;
338            sub fakeprogress {
339                    return if (! $show_progress);
340                    my $current = shift @_;
341    
342                    my @ind = ('-','\\','|','/','-','\\','|','/', '-');
343    
344                    $last_p += $fake_dir;
345                    $fake_dir = -$fake_dir if ($last_p > 1000 || $last_p < 0);
346                    if ($last_p % 10 == 0) {
347                            printf STDERR ("%5d / %5s [%-51s]\r",$current,"?"," " x ($last_p/20).$ind[($last_p/20) % $#ind]);
348                    }
349            }
350    
351          # now read database          # now read database
352  print STDERR "using: $type...\n";  print STDERR "using: $type...\n";
353    
354          if ($type eq "isis") {          if ($type_base eq "isis") {
355    
356                  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!";
357    
358                  $import2cp = Text::Iconv->new($config->{isis_codepage},$codepage);                  $import2cp = Text::Iconv->new($config->{isis_codepage},$codepage);
359                  my $db = OpenIsis::open( $isis_db );                  my $db = OpenIsis::open( $isis_db );
360    
361                    # check if .txt database for OpenIsis is zero length,
362                    # if so, erase it and re-open database
363                    sub check_txt_db {
364                            my $isis_db = shift || die "need isis database name";
365                            my $reopen = 0;
366    
367                            if (-e $isis_db.".TXT") {
368                                    print STDERR "WARNING: removing $isis_db.TXT OpenIsis database...\n";
369                                    unlink $isis_db.".TXT" || warn "FATAL: unlink error on '$isis_db.TXT': $!";
370                                    $reopen++;
371                            }
372                            if (-e $isis_db.".PTR") {
373                                    print STDERR "WARNING: removing $isis_db.PTR OpenIsis database...\n";
374                                    unlink $isis_db.".PTR" || warn "FATAL: unlink error on '$isis_db.PTR': $!";
375                                    $reopen++;
376                            }
377                            return OpenIsis::open( $isis_db ) if ($reopen);
378                    }
379    
380                    # EOF error
381                    if ($db == -1) {
382                            $db = check_txt_db($isis_db);
383                            if ($db == -1) {
384                                    print STDERR "FATAL: OpenIsis can't open zero size file $isis_db\n";
385                                    next;
386                            }
387                    }
388    
389                    # OpenIsis::ERR_BADF
390                    if ($db == -4) {
391                            print STDERR "FATAL: OpenIsis can't find file $isis_db\n";
392                            next;
393                    # OpenIsis::ERR_IO
394                    } elsif ($db == -5) {
395                            print STDERR "FATAL: OpenIsis can't access file $isis_db\n";
396                            next;
397                    } elsif ($db < 0) {
398                            print STDERR "FATAL: OpenIsis unknown error $db with file $isis_db\n";
399                            next;
400                    }
401    
402                  my $max_rowid = OpenIsis::maxRowid( $db );                  my $max_rowid = OpenIsis::maxRowid( $db );
403    
404                    # if 0 records, try to rease isis .txt database
405                    if ($max_rowid == 0) {
406                            # force removal of database
407                            $db = check_txt_db($isis_db);
408                            $max_rowid = OpenIsis::maxRowid( $db );
409                    }
410    
411                  print STDERR "Reading database: $isis_db [$max_rowid rows]\n";                  print STDERR "Reading database: $isis_db [$max_rowid rows]\n";
412    
413                  my $path = $database;                  my $path = $database;
# Line 278  print STDERR "using: $type...\n"; Line 420  print STDERR "using: $type...\n";
420    
421                                  my $swishpath = $path."#".int($row->{mfn});                                  my $swishpath = $path."#".int($row->{mfn});
422    
423                                  if (my $xml = data2xml($type,$row,$add_xml)) {                                  if (my $xml = data2xml($type_base,$row,$add_xml,$cfg,$database)) {
424                                          $xml = $cp2utf->convert($xml);                                          $xml = $cp2utf->convert($xml);
425                                          use bytes;      # as opposed to chars                                          use bytes;      # as opposed to chars
426                                          print "Path-Name: $swishpath\n";                                          print "Path-Name: $swishpath\n";
# Line 287  print STDERR "using: $type...\n"; Line 429  print STDERR "using: $type...\n";
429                                  }                                  }
430                          }                          }
431                  }                  }
432                    # for this to work with current version of OpenIsis (0.9.0)
433                    # you might need my patch from
434                    # http://www.rot13.org/~dpavlin/projects/openisis-0.9.0-perl_close.diff
435                    OpenIsis::close($db);
436                  print STDERR "\n";                  print STDERR "\n";
437    
438          } elsif ($type eq "excel") {          } elsif ($type_base eq "excel") {
439                  use Spreadsheet::ParseExcel;                  use Spreadsheet::ParseExcel;
440                  use Spreadsheet::ParseExcel::Utility qw(int2col);                  use Spreadsheet::ParseExcel::Utility qw(int2col);
441                                    
# Line 335  print STDERR "using: $type...\n"; Line 481  print STDERR "using: $type...\n";
481    
482                          next if (! $row);                          next if (! $row);
483    
484                          if (my $xml = data2xml($type,$row,$add_xml)) {                          if (my $xml = data2xml($type_base,$row,$add_xml,$cfg,$database)) {
485                                    $xml = $cp2utf->convert($xml);
486                                    use bytes;      # as opposed to chars
487                                    print "Path-Name: $swishpath\n";
488                                    print "Content-Length: ".(length($xml)+1)."\n";
489                                    print "Document-Type: XML\n\n$xml\n";
490                            }
491                    }
492            } elsif ($type_base eq "marc") {
493    
494                    use MARC;
495                    
496                    $import2cp = Text::Iconv->new($config->{marc_codepage},$codepage);
497                    my $marc_file = $cfg -> val($database, 'marc_file') || die "$database doesn't have 'marc_file' defined!";
498    
499                    # optional argument is format
500                    my $format = x($config->{format}) || 'usmarc';
501    
502                    print STDERR "Reading MARC file '$marc_file'\n";
503    
504                    my $marc = new MARC;
505                    my $nr = $marc->openmarc({
506                                    file=>$marc_file, format=>$format
507                            }) || die "Can't open MARC file '$marc_file'";
508    
509                    my $i=0;        # record nr.
510    
511                    my $rec;
512    
513                    while ($marc->nextmarc(1)) {
514    
515                            # XXX
516                            fakeprogress($i++);
517    
518                            my $swishpath = $database."#".$i;
519    
520                            if (my $xml = data2xml($type_base,$marc,$add_xml,$cfg,$database)) {
521                                  $xml = $cp2utf->convert($xml);                                  $xml = $cp2utf->convert($xml);
522                                  use bytes;      # as opposed to chars                                  use bytes;      # as opposed to chars
523                                  print "Path-Name: $swishpath\n";                                  print "Path-Name: $swishpath\n";
# Line 343  print STDERR "using: $type...\n"; Line 525  print STDERR "using: $type...\n";
525                                  print "Document-Type: XML\n\n$xml\n";                                  print "Document-Type: XML\n\n$xml\n";
526                          }                          }
527                  }                  }
528            } elsif ($type_base eq "feed") {
529    
530                    $import2cp = Text::Iconv->new($config->{feed_codepage},$codepage);
531                    my $prog = x($config->{prog}) || die "$database doesn't have 'prog' defined!";
532    
533                    print STDERR "Reading feed from program '$prog'\n";
534    
535                    open(FEED,"feeds/$prog |") || die "can't start $prog: $!";
536    
537                    my $i=1;        # record nr.
538    
539                    my $data;
540                    my $line=1;
541    
542                    while (<FEED>) {
543                            chomp;
544    
545                            if (/^$/) {
546                                    my $swishpath = $database."#".$i++;
547    
548                                    if (my $xml = data2xml($type_base,$data,$add_xml,$cfg,$database)) {
549                                            $xml = $cp2utf->convert($xml);
550                                            use bytes;      # as opposed to chars
551                                            print "Path-Name: $swishpath\n";
552                                            print "Content-Length: ".(length($xml)+1)."\n";
553                                            print "Document-Type: XML\n\n$xml\n";
554                                    }
555                                    $line = 1;
556                                    $data = {};
557                                    next;
558                            }
559    
560                            $line = $1 if (s/^(\d+):\s*//);
561                            $data->{$line++} = $_;
562    
563                            fakeprogress($i);
564    
565                    }
566          }          }
567  }  }
568    
# Line 355  __END__ Line 575  __END__
575    
576  =head1 NAME  =head1 NAME
577    
578  isis2xml.pl - read isis file and dump XML  all2xml.pl - read various file formats and dump XML for SWISH-E
579    
580  =head1 DESCRIPTION  =head1 DESCRIPTION
581    
582  This command will read ISIS data file using OpenIsis perl module and  This command will read ISIS data file using OpenIsis perl module, MARC
583  create XML file for usage with I<SWISH-E>  records using MARC module and optionally Micro$oft Excel files to
584  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,
585  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
586  script is tailor-made for SWISH-E.  has something like that). Output of this script is tailor-made for SWISH-E.
587    
588    =head1 BUGS
589    
590    Documentation is really lacking. However, in true Open Source spirit, source
591    is best documentation. I even made considerable effort to comment parts
592    which are not intuitively clear, so...
593    
594  =head1 AUTHOR  =head1 AUTHOR
595    

Legend:
Removed from v.56  
changed lines
  Added in v.153

  ViewVC Help
Powered by ViewVC 1.1.26