/[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 97 by dpavlin, Sun Jul 13 21:57:12 2003 UTC revision 163 by dpavlin, Thu Nov 20 21:23:40 2003 UTC
# Line 82  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 = "";
99                    my $swish_exact_data = "";
100                  my $display_data = "";                  my $display_data = "";
101                  my $line_delimiter;                  my $line_delimiter;
102    
# Line 109  sub data2xml { Line 110  sub data2xml {
110    
111                          my $repeat_off = 0;             # repeatable offset                          my $repeat_off = 0;             # repeatable offset
112    
113                          my ($s,$d,$i) = (1,1,0);        # swish, display default                          my ($s,$se,$d,$i) = (1,0,1,0);  # swish, display default
114                          $s = 0 if (lc($x->{type}) eq "display");                          $s = 0 if (lc($x->{type}) eq "display");
115                          $d = 0 if (lc($x->{type}) eq "swish");                          $d = 0 if (lc($x->{type}) eq "swish");
116                            $se = 1 if (lc($x->{type}) eq "swish_exact");
117                          ($s,$d,$i) = (0,0,1) if (lc($x->{type}) eq "index");                          ($s,$d,$i) = (0,0,1) if (lc($x->{type}) eq "index");
118    
119                          # what will separate last line from this one?                          # what will separate last line from this one?
# Line 128  sub data2xml { Line 130  sub data2xml {
130                          my @index_data;                          my @index_data;
131                          my $index_filter;                          my $index_filter;
132    
133                            sub mkformat {
134                                    my $x = shift || die "mkformat needs tag reference";
135                                    my $data = shift || return;
136                                    my $format_name = x($x->{format_name}) || return $data;
137                                    my $fmt = x($config->{format}->{$format_name}->{content}) || die "<format name=\"$format_name\"> is not defined!";
138                                    my $format_delimiter = x($x->{format_delimiter});
139                                    my @data;
140                                    if ($format_delimiter) {
141                                            @data = split(/$format_delimiter/,$data);
142                                    } else {
143                                            push @data,$data;
144                                    }
145    
146                                    if ($fmt) {
147                                            my $nr = scalar $fmt =~ s/%s/%s/g;
148                                            if (($#data+1) == $nr) {
149                                                    return sprintf($fmt,@data);
150                                            } else {
151                                                    print STDERR "mkformat: [$data] can't be split on [$format_delimiter] to $nr fields!\n";
152                                                    return $data;
153                                            }
154                                    } else {
155                                            print STDERR "usage of link '$format_name' without defined format (<link> tag)\n";
156                                    }
157                            }
158    
159                          # while because of repeatable fields                          # while because of repeatable fields
160                          while ($swish || $display) {                          while ($swish || $display) {
161                                  ($swish,$display) = parse_format($type, $format,$row,$repeat_off++,$import2cp);                                  ($swish,$display) = parse_format($type, $format,$row,$repeat_off++,$import2cp);
# Line 143  sub data2xml { Line 171  sub data2xml {
171                                          require "filter/".$filter.".pm";                                          require "filter/".$filter.".pm";
172                                  }                                  }
173                                  # type="swish" ; field for swish                                  # type="swish" ; field for swish
174                                  if ($s && $swish) {                                  if ($swish) {
175                                          if ($filter) {                                          if ($filter && ($s || $se)) {
176                                                  no strict 'refs';                                                  no strict 'refs';
177                                                  $swish_data .= join(" ",&$filter($swish));                                                  my $tmp = join(" ",&$filter($swish)) if ($s || $se);
178                                                    $swish_data .= $tmp if ($s);
179                                                    $swish_exact_data .= $tmp if ($se);
180    
181                                          } else {                                          } else {
182                                                  $swish_data .= $swish;                                                  $swish_data .= $swish if ($s);
183                                                    $swish_exact_data .= $swish if ($se);
184                                          }                                          }
185                                  }                                  }
186    
# Line 160  sub data2xml { Line 192  sub data2xml {
192                                          }                                          }
193                                          if ($filter) {                                          if ($filter) {
194                                                  no strict 'refs';                                                  no strict 'refs';
195                                                  $display_data .= join($delimiter,&$filter($display));                                                  if ($display_data) {
196                                                            $display_data .= $delimiter.join($delimiter,mkformat($x,&$filter($display)));
197                                                    } else {
198                                                            $display_data = join($delimiter,mkformat($x,&$filter($display)));
199                                                    }
200                                          } else {                                          } else {
201                                                  if ($display_data) {                                                  if ($display_data) {
202                                                          $display_data .= $delimiter.$display;                                                          $display_data .= $delimiter.mkformat($x,$display);
203                                                  } else {                                                  } else {
204                                                          $display_data .= $display;                                                          $display_data = mkformat($x,$display);
205                                                  }                                                  }
206                                          }                                          }
207                                  }                                  }
# Line 181  sub data2xml { Line 217  sub data2xml {
217                          if (@index_data) {                          if (@index_data) {
218                                  if ($index_filter) {                                  if ($index_filter) {
219                                          no strict 'refs';                                          no strict 'refs';
220                                          foreach my $d (&$index_filter(@index_data)) {                                          foreach my $d (@index_data) {
221                                                  $index->insert($field, $d, $path);                                                  $index->insert($field, &$index_filter($d), $path);
222                                          }                                          }
223                                  } else {                                  } else {
224                                          foreach my $d (@index_data) {                                          foreach my $d (@index_data) {
# Line 201  sub data2xml { Line 237  sub data2xml {
237                          my ($s,$d,$i) = (1,1,0);        # swish, display default                          my ($s,$d,$i) = (1,1,0);        # swish, display default
238                          $s = 0 if (lc($x->{type}) eq "display");                          $s = 0 if (lc($x->{type}) eq "display");
239                          $d = 0 if (lc($x->{type}) eq "swish");                          $d = 0 if (lc($x->{type}) eq "swish");
240                            # no support for swish exact in config.
241                            # IMHO, it's useless
242                          ($s,$d,$i) = (0,0,1) if (lc($x->{type}) eq "index");                          ($s,$d,$i) = (0,0,1) if (lc($x->{type}) eq "index");
243    
244                          if ($val) {                          if ($val) {
# Line 243  sub data2xml { Line 281  sub data2xml {
281                          $xml .= xmlify($field."_swish", unac_string($codepage,$swish_data));                          $xml .= xmlify($field."_swish", unac_string($codepage,$swish_data));
282                  }                  }
283    
284                    if ($swish_exact_data) {
285                            $swish_exact_data =~ s/ +/ /g;
286                            $swish_exact_data =~ s/ +$//g;
287    
288                            # add delimiters before and after word.
289                            # That is required to produce exact match
290                            $xml .= xmlify($field."_swish_exact", unac_string($codepage,'xxbxx '.$swish_exact_data.' xxexx'));
291                    }
292    
293    
294          }          }
295    
# Line 289  print STDERR "reading ./import_xml/$type Line 336  print STDERR "reading ./import_xml/$type
336          my $type_base = $type;          my $type_base = $type;
337          $type_base =~ s/_.+$//g;          $type_base =~ s/_.+$//g;
338    
339          $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);
340    
341          # output current progress indicator          # output current progress indicator
342          my $last_p = 0;          my $last_p = 0;
343          sub progress {          sub progress {
344                  # XXX return if ($show_progress ne "");                  return if (! $show_progress);
345                  my $current = shift;                  my $current = shift;
346                  my $total = shift || 1;                  my $total = shift || 1;
347                  my $p = int($current * 100 / $total);                  my $p = int($current * 100 / $total);
# Line 306  print STDERR "reading ./import_xml/$type Line 353  print STDERR "reading ./import_xml/$type
353    
354          my $fake_dir = 1;          my $fake_dir = 1;
355          sub fakeprogress {          sub fakeprogress {
356                    return if (! $show_progress);
357                  my $current = shift @_;                  my $current = shift @_;
358    
359                  my @ind = ('-','\\','|','/','-','\\','|','/', '-');                  my @ind = ('-','\\','|','/','-','\\','|','/', '-');
# Line 327  print STDERR "using: $type...\n"; Line 375  print STDERR "using: $type...\n";
375                  $import2cp = Text::Iconv->new($config->{isis_codepage},$codepage);                  $import2cp = Text::Iconv->new($config->{isis_codepage},$codepage);
376                  my $db = OpenIsis::open( $isis_db );                  my $db = OpenIsis::open( $isis_db );
377    
378                    # check if .txt database for OpenIsis is zero length,
379                    # if so, erase it and re-open database
380                    sub check_txt_db {
381                            my $isis_db = shift || die "need isis database name";
382                            my $reopen = 0;
383    
384                            if (-e $isis_db.".TXT") {
385                                    print STDERR "WARNING: removing $isis_db.TXT OpenIsis database...\n";
386                                    unlink $isis_db.".TXT" || warn "FATAL: unlink error on '$isis_db.TXT': $!";
387                                    $reopen++;
388                            }
389                            if (-e $isis_db.".PTR") {
390                                    print STDERR "WARNING: removing $isis_db.PTR OpenIsis database...\n";
391                                    unlink $isis_db.".PTR" || warn "FATAL: unlink error on '$isis_db.PTR': $!";
392                                    $reopen++;
393                            }
394                            return OpenIsis::open( $isis_db ) if ($reopen);
395                    }
396    
397                    # EOF error
398                    if ($db == -1) {
399                            $db = check_txt_db($isis_db);
400                            if ($db == -1) {
401                                    print STDERR "FATAL: OpenIsis can't open zero size file $isis_db\n";
402                                    next;
403                            }
404                    }
405    
406                    # OpenIsis::ERR_BADF
407                    if ($db == -4) {
408                            print STDERR "FATAL: OpenIsis can't find file $isis_db\n";
409                            next;
410                    # OpenIsis::ERR_IO
411                    } elsif ($db == -5) {
412                            print STDERR "FATAL: OpenIsis can't access file $isis_db\n";
413                            next;
414                    } elsif ($db < 0) {
415                            print STDERR "FATAL: OpenIsis unknown error $db with file $isis_db\n";
416                            next;
417                    }
418    
419                  my $max_rowid = OpenIsis::maxRowid( $db );                  my $max_rowid = OpenIsis::maxRowid( $db );
420    
421                    # if 0 records, try to rease isis .txt database
422                    if ($max_rowid == 0) {
423                            # force removal of database
424                            $db = check_txt_db($isis_db);
425                            $max_rowid = OpenIsis::maxRowid( $db );
426                    }
427    
428                  print STDERR "Reading database: $isis_db [$max_rowid rows]\n";                  print STDERR "Reading database: $isis_db [$max_rowid rows]\n";
429    
430                  my $path = $database;                  my $path = $database;
# Line 350  print STDERR "using: $type...\n"; Line 446  print STDERR "using: $type...\n";
446                                  }                                  }
447                          }                          }
448                  }                  }
449                    # for this to work with current version of OpenIsis (0.9.0)
450                    # you might need my patch from
451                    # http://www.rot13.org/~dpavlin/projects/openisis-0.9.0-perl_close.diff
452                    OpenIsis::close($db);
453                  print STDERR "\n";                  print STDERR "\n";
454    
455          } elsif ($type_base eq "excel") {          } elsif ($type_base eq "excel") {

Legend:
Removed from v.97  
changed lines
  Added in v.163

  ViewVC Help
Powered by ViewVC 1.1.26