/[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 74 by dpavlin, Sat Jul 5 22:37:30 2003 UTC revision 170 by dpavlin, Sun Nov 23 15:42:16 2003 UTC
# Line 61  my %type2tag = ( Line 61  my %type2tag = (
61          'feed' => 'feed'          'feed' => 'feed'
62  );  );
63    
64    my $cache;      # for cacheing
65    
66  sub data2xml {  sub data2xml {
67    
68          use xmlify;          use xmlify;
# Line 82  sub data2xml { Line 84  sub data2xml {
84    
85          # sort subrouting using order="" attribute          # sort subrouting using order="" attribute
86          sub by_order {          sub by_order {
87                  return 0 if (! $config->{indexer}->{$a}->{order});                  my $va = $config->{indexer}->{$a}->{order} ||
88                  return 0 if (! $config->{indexer}->{$b}->{order});                          $config->{indexer}->{$a};
89                    my $vb = $config->{indexer}->{$b}->{order} ||
90                            $config->{indexer}->{$b};
91    
92                    return $va <=> $vb;
93            }
94    
95                  return $config->{indexer}->{$a}->{order} <=>          my @sorted_tags;
96                          $config->{indexer}->{$b}->{order} ;          if ($cache->{tags_by_order}->{$type}) {
97                    @sorted_tags = @{$cache->{tags_by_order}->{$type}};
98            } else {
99                    @sorted_tags = sort by_order keys %{$config->{indexer}};
100                    $cache->{tags_by_order}->{$type} = \@sorted_tags;
101          }          }
102    
103          foreach my $field (sort by_order keys %{$config->{indexer}}) {          foreach my $field (@sorted_tags) {
104    
105                  $field=x($field);                  $field=x($field);
   
106                  $field_usage{$field}++;                  $field_usage{$field}++;
107    
108                  my $swish_data = "";                  my $swish_data = "";
109                    my $swish_exact_data = "";
110                  my $display_data = "";                  my $display_data = "";
111                  my $line_delimiter;                  my $line_delimiter;
112    
# Line 109  sub data2xml { Line 120  sub data2xml {
120    
121                          my $repeat_off = 0;             # repeatable offset                          my $repeat_off = 0;             # repeatable offset
122    
123                          my ($s,$d,$i) = (1,1,0);        # swish, display default                          my ($s,$se,$d,$i) = (1,0,1,0);  # swish, display default
124                          $s = 0 if (lc($x->{type}) eq "display");                          $s = 0 if (lc($x->{type}) eq "display");
125                          $d = 0 if (lc($x->{type}) eq "swish");                          $d = 0 if (lc($x->{type}) eq "swish");
126                            $se = 1 if (lc($x->{type}) eq "swish_exact");
127                          ($s,$d,$i) = (0,0,1) if (lc($x->{type}) eq "index");                          ($s,$d,$i) = (0,0,1) if (lc($x->{type}) eq "index");
128    
129                          # what will separate last line from this one?                          # what will separate last line from this one?
# Line 124  sub data2xml { Line 136  sub data2xml {
136                          # init vars so that we go into while...                          # init vars so that we go into while...
137                          ($swish,$display) = (1,1);                          ($swish,$display) = (1,1);
138    
139                          if ($swish || $display) {                          # placeholder for all repeatable entries for index
140                            my @index_data;
141                            my $index_filter;
142    
143                            sub mkformat {
144                                    my $x = shift || die "mkformat needs tag reference";
145                                    my $data = shift || return;
146                                    my $format_name = x($x->{format_name}) || return $data;
147                                    my $fmt = x($config->{format}->{$format_name}->{content}) || die "<format name=\"$format_name\"> is not defined!";
148                                    my $format_delimiter = x($x->{format_delimiter});
149                                    my @data;
150                                    if ($format_delimiter) {
151                                            @data = split(/$format_delimiter/,$data);
152                                    } else {
153                                            push @data,$data;
154                                    }
155    
156                                    if ($fmt) {
157                                            my $nr = scalar $fmt =~ s/%s/%s/g;
158                                            if (($#data+1) == $nr) {
159                                                    return sprintf($fmt,@data);
160                                            } else {
161                                                    print STDERR "mkformat: [$data] can't be split on [$format_delimiter] to $nr fields!\n";
162                                                    return $data;
163                                            }
164                                    } else {
165                                            print STDERR "usage of link '$format_name' without defined format (<link> tag)\n";
166                                    }
167                            }
168    
169                            # while because of repeatable fields
170                            while ($swish || $display) {
171                                  ($swish,$display) = parse_format($type, $format,$row,$repeat_off++,$import2cp);                                  ($swish,$display) = parse_format($type, $format,$row,$repeat_off++,$import2cp);
172                                    if ($repeat_off > 1000) {
173                                            print STDERR "loop (more than 1000 repeatable fields) deteced in $row, $format\n";
174                                            last;
175                                    }
176                                    
177                                  # filter="name" ; filter this field through                                  # filter="name" ; filter this field through
178                                  # filter/[name].pm                                  # filter/[name].pm
179                                  my $filter = $x->{filter};                                  my $filter = $x->{filter};
180                                  if ($filter) {                                  if ($filter && !$cache->{filter_loaded}->{$filter}) {
181                                          require "filter/".$filter.".pm";                                          require "filter/".$filter.".pm";
182                                            $cache->{filter_loaded}->{$filter}++;
183                                  }                                  }
184                                  # type="swish" ; field for swish                                  # type="swish" ; field for swish
185                                  if ($s && $swish) {                                  if ($swish) {
186                                          if ($filter) {                                          if ($filter && ($s || $se)) {
187                                                  no strict 'refs';                                                  no strict 'refs';
188                                                  $swish_data .= join(" ",&$filter($swish));                                                  my $tmp = join(" ",&$filter($swish)) if ($s || $se);
189                                                    $swish_data .= $tmp if ($s);
190                                                    $swish_exact_data .= $tmp if ($se);
191    
192                                          } else {                                          } else {
193                                                  $swish_data .= $swish;                                                  $swish_data .= $swish if ($s);
194                                                    $swish_exact_data .= $swish if ($se);
195                                          }                                          }
196                                  }                                  }
197    
# Line 150  sub data2xml { Line 203  sub data2xml {
203                                          }                                          }
204                                          if ($filter) {                                          if ($filter) {
205                                                  no strict 'refs';                                                  no strict 'refs';
206                                                  $display_data .= join($delimiter,&$filter($display));                                                  if ($display_data) {
207                                                            $display_data .= $delimiter.join($delimiter,mkformat($x,&$filter($display)));
208                                                    } else {
209                                                            $display_data = join($delimiter,mkformat($x,&$filter($display)));
210                                                    }
211                                          } else {                                          } else {
212                                                  if ($display_data) {                                                  if ($display_data) {
213                                                          $display_data .= $delimiter.$display;                                                          $display_data .= $delimiter.mkformat($x,$display);
214                                                  } else {                                                  } else {
215                                                          $display_data .= $display;                                                          $display_data = mkformat($x,$display);
216                                                  }                                                  }
217                                          }                                          }
218                                  }                                  }
219                                                                                                    
220                                  # type="index" ; insert into index                                  # type="index" ; insert into index
221                                  if ($i && $display) {                                  if ($i && $display) {
222                                          my $index_data = $display;                                          push @index_data, $display;
223                                          if ($filter) {                                          $index_filter = $filter if ($filter);
224                                                  no strict 'refs';                                  }
225                                                  foreach my $d (&$filter($index_data)) {                          }
226                                                          $index->insert($field, $d, $path);  
227                                                  }                          # fill data in index
228                                          } else {                          if (@index_data) {
229                                                  $index->insert($field, $index_data, $path);                                  if ($index_filter) {
230                                            no strict 'refs';
231                                            foreach my $d (@index_data) {
232                                                    $index->insert($field, &$index_filter($d), $path);
233                                            }
234                                    } else {
235                                            foreach my $d (@index_data) {
236                                                    $index->insert($field, $d, $path);
237                                          }                                          }
238                                  }                                  }
239                          }                          }
# Line 184  sub data2xml { Line 248  sub data2xml {
248                          my ($s,$d,$i) = (1,1,0);        # swish, display default                          my ($s,$d,$i) = (1,1,0);        # swish, display default
249                          $s = 0 if (lc($x->{type}) eq "display");                          $s = 0 if (lc($x->{type}) eq "display");
250                          $d = 0 if (lc($x->{type}) eq "swish");                          $d = 0 if (lc($x->{type}) eq "swish");
251                            # no support for swish exact in config.
252                            # IMHO, it's useless
253                          ($s,$d,$i) = (0,0,1) if (lc($x->{type}) eq "index");                          ($s,$d,$i) = (0,0,1) if (lc($x->{type}) eq "index");
254    
255                          if ($val) {                          if ($val) {
# Line 226  sub data2xml { Line 292  sub data2xml {
292                          $xml .= xmlify($field."_swish", unac_string($codepage,$swish_data));                          $xml .= xmlify($field."_swish", unac_string($codepage,$swish_data));
293                  }                  }
294    
295                    if ($swish_exact_data) {
296                            $swish_exact_data =~ s/ +/ /g;
297                            $swish_exact_data =~ s/ +$//g;
298    
299                            # add delimiters before and after word.
300                            # That is required to produce exact match
301                            $xml .= xmlify($field."_swish_exact", unac_string($codepage,'xxbxx '.$swish_exact_data.' xxexx'));
302                    }
303    
304    
305          }          }
306    
307          # dump formatted output in <html>          # dump formatted output in <html>
308          if ($html) {          if ($html) {
309                  $xml .= xmlify("html",$html);                  #$xml .= xmlify("html",$html);
310                    $xml .= "<html><![CDATA[ $html ]]></html>";
311          }          }
312                    
313          if ($xml) {          if ($xml) {
# Line 258  $index = new index_DBI( Line 334  $index = new index_DBI(
334                  $cfg_global->val('global', 'dbi_passwd') || '',                  $cfg_global->val('global', 'dbi_passwd') || '',
335          );          );
336    
337    my $show_progress = $cfg_global->val('global', 'show_progress');
338    
339    my $unac_filter = $cfg_global->val('global', 'unac_filter');
340    if ($unac_filter) {
341            require $unac_filter;
342    }
343    
344  foreach my $database ($cfg->Sections) {  foreach my $database ($cfg->Sections) {
345    
346          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 269  print STDERR "reading ./import_xml/$type Line 352  print STDERR "reading ./import_xml/$type
352          my $type_base = $type;          my $type_base = $type;
353          $type_base =~ s/_.+$//g;          $type_base =~ s/_.+$//g;
354    
355          $config=XMLin("./import_xml/$type.xml", forcearray => [ $type2tag{$type_base}, 'config' ], forcecontent => 1);          $config=XMLin("./import_xml/$type.xml", forcearray => [ $type2tag{$type_base}, 'config', 'format' ], forcecontent => 1);
356    
357          # output current progress indicator          # output current progress indicator
358          my $last_p = 0;          my $last_p = 0;
359          sub progress {          sub progress {
360                  #return if (! $opts{q});        # FIXME                  return if (! $show_progress);
361                  my $current = shift;                  my $current = shift;
362                  my $total = shift || 1;                  my $total = shift || 1;
363                  my $p = int($current * 100 / $total);                  my $p = int($current * 100 / $total);
# Line 286  print STDERR "reading ./import_xml/$type Line 369  print STDERR "reading ./import_xml/$type
369    
370          my $fake_dir = 1;          my $fake_dir = 1;
371          sub fakeprogress {          sub fakeprogress {
372                    return if (! $show_progress);
373                  my $current = shift @_;                  my $current = shift @_;
374    
375                  my @ind = ('-','\\','|','/','-','\\','|','/', '-');                  my @ind = ('-','\\','|','/','-','\\','|','/', '-');
# Line 307  print STDERR "using: $type...\n"; Line 391  print STDERR "using: $type...\n";
391                  $import2cp = Text::Iconv->new($config->{isis_codepage},$codepage);                  $import2cp = Text::Iconv->new($config->{isis_codepage},$codepage);
392                  my $db = OpenIsis::open( $isis_db );                  my $db = OpenIsis::open( $isis_db );
393    
394                    # check if .txt database for OpenIsis is zero length,
395                    # if so, erase it and re-open database
396                    sub check_txt_db {
397                            my $isis_db = shift || die "need isis database name";
398                            my $reopen = 0;
399    
400                            if (-e $isis_db.".TXT") {
401                                    print STDERR "WARNING: removing $isis_db.TXT OpenIsis database...\n";
402                                    unlink $isis_db.".TXT" || warn "FATAL: unlink error on '$isis_db.TXT': $!";
403                                    $reopen++;
404                            }
405                            if (-e $isis_db.".PTR") {
406                                    print STDERR "WARNING: removing $isis_db.PTR OpenIsis database...\n";
407                                    unlink $isis_db.".PTR" || warn "FATAL: unlink error on '$isis_db.PTR': $!";
408                                    $reopen++;
409                            }
410                            return OpenIsis::open( $isis_db ) if ($reopen);
411                    }
412    
413                    # EOF error
414                    if ($db == -1) {
415                            $db = check_txt_db($isis_db);
416                            if ($db == -1) {
417                                    print STDERR "FATAL: OpenIsis can't open zero size file $isis_db\n";
418                                    next;
419                            }
420                    }
421    
422                    # OpenIsis::ERR_BADF
423                    if ($db == -4) {
424                            print STDERR "FATAL: OpenIsis can't find file $isis_db\n";
425                            next;
426                    # OpenIsis::ERR_IO
427                    } elsif ($db == -5) {
428                            print STDERR "FATAL: OpenIsis can't access file $isis_db\n";
429                            next;
430                    } elsif ($db < 0) {
431                            print STDERR "FATAL: OpenIsis unknown error $db with file $isis_db\n";
432                            next;
433                    }
434    
435                  my $max_rowid = OpenIsis::maxRowid( $db );                  my $max_rowid = OpenIsis::maxRowid( $db );
436    
437                    # if 0 records, try to rease isis .txt database
438                    if ($max_rowid == 0) {
439                            # force removal of database
440                            $db = check_txt_db($isis_db);
441                            $max_rowid = OpenIsis::maxRowid( $db );
442                    }
443    
444                  print STDERR "Reading database: $isis_db [$max_rowid rows]\n";                  print STDERR "Reading database: $isis_db [$max_rowid rows]\n";
445    
446                  my $path = $database;                  my $path = $database;
# Line 330  print STDERR "using: $type...\n"; Line 462  print STDERR "using: $type...\n";
462                                  }                                  }
463                          }                          }
464                  }                  }
465                    # for this to work with current version of OpenIsis (0.9.0)
466                    # you might need my patch from
467                    # http://www.rot13.org/~dpavlin/projects/openisis-0.9.0-perl_close.diff
468                    OpenIsis::close($db);
469                  print STDERR "\n";                  print STDERR "\n";
470    
471          } elsif ($type_base eq "excel") {          } elsif ($type_base eq "excel") {
# Line 472  __END__ Line 608  __END__
608    
609  =head1 NAME  =head1 NAME
610    
611  isis2xml.pl - read isis file and dump XML  all2xml.pl - read various file formats and dump XML for SWISH-E
612    
613  =head1 DESCRIPTION  =head1 DESCRIPTION
614    
615  This command will read ISIS data file using OpenIsis perl module and  This command will read ISIS data file using OpenIsis perl module, MARC
616  create XML file for usage with I<SWISH-E>  records using MARC module and optionally Micro$oft Excel files to
617  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,
618  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
619  script is tailor-made for SWISH-E.  has something like that). Output of this script is tailor-made for SWISH-E.
620    
621    =head1 BUGS
622    
623    Documentation is really lacking. However, in true Open Source spirit, source
624    is best documentation. I even made considerable effort to comment parts
625    which are not intuitively clear, so...
626    
627  =head1 AUTHOR  =head1 AUTHOR
628    

Legend:
Removed from v.74  
changed lines
  Added in v.170

  ViewVC Help
Powered by ViewVC 1.1.26