/[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 90 by dpavlin, Sun Jul 13 13:22:50 2003 UTC revision 164 by dpavlin, Sat Nov 22 22:04:05 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 124  sub data2xml { Line 126  sub data2xml {
126                          # init vars so that we go into while...                          # init vars so that we go into while...
127                          ($swish,$display) = (1,1);                          ($swish,$display) = (1,1);
128    
129                            # placeholder for all repeatable entries for index
130                            my @index_data;
131                            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 139  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 156  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                                  }                                  }
208                                                                                                    
209                                  # type="index" ; insert into index                                  # type="index" ; insert into index
210                                  if ($i && $display) {                                  if ($i && $display) {
211                                          my $index_data = $display;                                          push @index_data, $display;
212                                          if ($filter) {                                          $index_filter = $filter if ($filter);
213                                                  no strict 'refs';                                  }
214                                                  foreach my $d (&$filter($index_data)) {                          }
215                                                          $index->insert($field, $d, $path);  
216                                                  }                          # fill data in index
217                                          } else {                          if (@index_data) {
218                                                  $index->insert($field, $index_data, $path);                                  if ($index_filter) {
219                                            no strict 'refs';
220                                            foreach my $d (@index_data) {
221                                                    $index->insert($field, &$index_filter($d), $path);
222                                            }
223                                    } else {
224                                            foreach my $d (@index_data) {
225                                                    $index->insert($field, $d, $path);
226                                          }                                          }
227                                  }                                  }
228                          }                          }
# Line 190  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 232  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 265  $index = new index_DBI( Line 323  $index = new index_DBI(
323                  $cfg_global->val('global', 'dbi_passwd') || '',                  $cfg_global->val('global', 'dbi_passwd') || '',
324          );          );
325    
326    my $show_progress = $cfg_global->val('global', 'show_progress');
327    
328    my $unac_filter = $cfg_global->val('global', 'unac_filter');
329    if ($unac_filter) {
330            require $unac_filter;
331    }
332    
333  foreach my $database ($cfg->Sections) {  foreach my $database ($cfg->Sections) {
334    
335          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 276  print STDERR "reading ./import_xml/$type Line 341  print STDERR "reading ./import_xml/$type
341          my $type_base = $type;          my $type_base = $type;
342          $type_base =~ s/_.+$//g;          $type_base =~ s/_.+$//g;
343    
344          $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);
345    
346          # output current progress indicator          # output current progress indicator
347          my $last_p = 0;          my $last_p = 0;
348          sub progress {          sub progress {
349                  #return if (! $opts{q});        # FIXME                  return if (! $show_progress);
350                  my $current = shift;                  my $current = shift;
351                  my $total = shift || 1;                  my $total = shift || 1;
352                  my $p = int($current * 100 / $total);                  my $p = int($current * 100 / $total);
# Line 293  print STDERR "reading ./import_xml/$type Line 358  print STDERR "reading ./import_xml/$type
358    
359          my $fake_dir = 1;          my $fake_dir = 1;
360          sub fakeprogress {          sub fakeprogress {
361                    return if (! $show_progress);
362                  my $current = shift @_;                  my $current = shift @_;
363    
364                  my @ind = ('-','\\','|','/','-','\\','|','/', '-');                  my @ind = ('-','\\','|','/','-','\\','|','/', '-');
# Line 314  print STDERR "using: $type...\n"; Line 380  print STDERR "using: $type...\n";
380                  $import2cp = Text::Iconv->new($config->{isis_codepage},$codepage);                  $import2cp = Text::Iconv->new($config->{isis_codepage},$codepage);
381                  my $db = OpenIsis::open( $isis_db );                  my $db = OpenIsis::open( $isis_db );
382    
383                    # check if .txt database for OpenIsis is zero length,
384                    # if so, erase it and re-open database
385                    sub check_txt_db {
386                            my $isis_db = shift || die "need isis database name";
387                            my $reopen = 0;
388    
389                            if (-e $isis_db.".TXT") {
390                                    print STDERR "WARNING: removing $isis_db.TXT OpenIsis database...\n";
391                                    unlink $isis_db.".TXT" || warn "FATAL: unlink error on '$isis_db.TXT': $!";
392                                    $reopen++;
393                            }
394                            if (-e $isis_db.".PTR") {
395                                    print STDERR "WARNING: removing $isis_db.PTR OpenIsis database...\n";
396                                    unlink $isis_db.".PTR" || warn "FATAL: unlink error on '$isis_db.PTR': $!";
397                                    $reopen++;
398                            }
399                            return OpenIsis::open( $isis_db ) if ($reopen);
400                    }
401    
402                    # EOF error
403                    if ($db == -1) {
404                            $db = check_txt_db($isis_db);
405                            if ($db == -1) {
406                                    print STDERR "FATAL: OpenIsis can't open zero size file $isis_db\n";
407                                    next;
408                            }
409                    }
410    
411                    # OpenIsis::ERR_BADF
412                    if ($db == -4) {
413                            print STDERR "FATAL: OpenIsis can't find file $isis_db\n";
414                            next;
415                    # OpenIsis::ERR_IO
416                    } elsif ($db == -5) {
417                            print STDERR "FATAL: OpenIsis can't access file $isis_db\n";
418                            next;
419                    } elsif ($db < 0) {
420                            print STDERR "FATAL: OpenIsis unknown error $db with file $isis_db\n";
421                            next;
422                    }
423    
424                  my $max_rowid = OpenIsis::maxRowid( $db );                  my $max_rowid = OpenIsis::maxRowid( $db );
425    
426                    # if 0 records, try to rease isis .txt database
427                    if ($max_rowid == 0) {
428                            # force removal of database
429                            $db = check_txt_db($isis_db);
430                            $max_rowid = OpenIsis::maxRowid( $db );
431                    }
432    
433                  print STDERR "Reading database: $isis_db [$max_rowid rows]\n";                  print STDERR "Reading database: $isis_db [$max_rowid rows]\n";
434    
435                  my $path = $database;                  my $path = $database;
# Line 337  print STDERR "using: $type...\n"; Line 451  print STDERR "using: $type...\n";
451                                  }                                  }
452                          }                          }
453                  }                  }
454                    # for this to work with current version of OpenIsis (0.9.0)
455                    # you might need my patch from
456                    # http://www.rot13.org/~dpavlin/projects/openisis-0.9.0-perl_close.diff
457                    OpenIsis::close($db);
458                  print STDERR "\n";                  print STDERR "\n";
459    
460          } elsif ($type_base eq "excel") {          } elsif ($type_base eq "excel") {

Legend:
Removed from v.90  
changed lines
  Added in v.164

  ViewVC Help
Powered by ViewVC 1.1.26