/[webpac]/branches/ffzg/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 /branches/ffzg/all2xml.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 135 by dpavlin, Wed Oct 29 21:27:00 2003 UTC revision 177 by dpavlin, Mon Nov 24 01:19:15 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 61  my %type2tag = ( Line 64  my %type2tag = (
64          'feed' => 'feed'          '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 90  sub data2xml { Line 101  sub data2xml {
101                  return $va <=> $vb;                  return $va <=> $vb;
102          }          }
103    
104          foreach my $field (sort by_order keys %{$config->{indexer}}) {          my @sorted_tags;
105            if ($cache->{tags_by_order}->{$type}) {
106                    @sorted_tags = @{$cache->{tags_by_order}->{$type}};
107            } else {
108                    @sorted_tags = sort by_order keys %{$config->{indexer}};
109                    $cache->{tags_by_order}->{$type} = \@sorted_tags;
110            }
111    
112            # lookup key
113            my $lookup_key;
114    
115            foreach my $field (@sorted_tags) {
116    
117                  $field=x($field);                  $field=x($field);
118                  $field_usage{$field}++;                  $field_usage{$field}++;
119    
120                  my $swish_data = "";                  my $swish_data = "";
121                    my $swish_exact_data = "";
122                  my $display_data = "";                  my $display_data = "";
123                  my $line_delimiter;                  my $line_delimiter;
124    
# Line 109  sub data2xml { Line 132  sub data2xml {
132    
133                          my $repeat_off = 0;             # repeatable offset                          my $repeat_off = 0;             # repeatable offset
134    
135                          my ($s,$d,$i) = (1,1,0);        # swish, display default                          # swish, swish_exact, display, index, index_lookup
136                            # swish and display defaults
137                            my ($s,$se,$d,$i,$il) = (1,0,1,0,0);
138                          $s = 0 if (lc($x->{type}) eq "display");                          $s = 0 if (lc($x->{type}) eq "display");
139                          $d = 0 if (lc($x->{type}) eq "swish");                          $d = 0 if (lc($x->{type}) eq "swish");
140                            $se = 1 if (lc($x->{type}) eq "swish_exact");
141                          ($s,$d,$i) = (0,0,1) if (lc($x->{type}) eq "index");                          ($s,$d,$i) = (0,0,1) if (lc($x->{type}) eq "index");
142                            $il = 1 if (lc($x->{type}) =~ /^lookup/);
143    
144    
145                          # what will separate last line from this one?                          # what will separate last line from this one?
146                          if ($display_data && $x->{append} && $x->{append} eq "1") {                          if ($display_data && $x->{append} && $x->{append} eq "1") {
# Line 126  sub data2xml { Line 154  sub data2xml {
154    
155                          # placeholder for all repeatable entries for index                          # placeholder for all repeatable entries for index
156                          my @index_data;                          my @index_data;
157                          my $index_filter;  
158                            sub mkformat {
159                                    my $x = shift || die "mkformat needs tag reference";
160                                    my $data = shift || return;
161                                    my $format_name = x($x->{format_name}) || return $data;
162                                    my $fmt = x($config->{format}->{$format_name}->{content}) || die "<format name=\"$format_name\"> is not defined!";
163                                    my $format_delimiter = x($x->{format_delimiter});
164                                    my @data;
165                                    if ($format_delimiter) {
166                                            @data = split(/$format_delimiter/,$data);
167                                    } else {
168                                            push @data,$data;
169                                    }
170    
171                                    if ($fmt) {
172                                            my $nr = scalar $fmt =~ s/%s/%s/g;
173                                            if (($#data+1) == $nr) {
174                                                    return sprintf($fmt,@data);
175                                            } else {
176                                                    print STDERR "mkformat: [$data] can't be split on [$format_delimiter] to $nr fields!\n";
177                                                    return $data;
178                                            }
179                                    } else {
180                                            print STDERR "usage of link '$format_name' without defined format (<link> tag)\n";
181                                    }
182                            }
183    
184                          # while because of repeatable fields                          # while because of repeatable fields
185                          while ($swish || $display) {                          while ($swish || $display) {
# Line 135  sub data2xml { Line 188  sub data2xml {
188                                          print STDERR "loop (more than 1000 repeatable fields) deteced in $row, $format\n";                                          print STDERR "loop (more than 1000 repeatable fields) deteced in $row, $format\n";
189                                          last;                                          last;
190                                  }                                  }
191                                    
192                                    # is this field is lookup?
193                                    if ($display && $x->{lookup}) {
194                                            if ($use_lhash_cache) {
195                                                    if (!defined($cache->{lhash}->{$display})) {
196                                                            my $new_display = $lhash{$display};
197                                                            if ($new_display) {
198    #print STDERR "lookup cache store '$display' = '$new_display'\n";
199                                                                    $display = $new_display;
200                                                                    $cache->{lhash}->{$display} = $new_display;
201                                                            } else {
202                                                                    print STDERR "WARNING: lookup for '$display' didn't find anything.\n";
203                                                                    $display = "";
204                                                                    $cache->{lhash}->{$display} = "";
205                                                            }
206                                                    } else {
207                                                            $display = $cache->{lhash}->{$display};
208                                                    }
209                                            } else {
210                                                    $display = $lhash{$display} || "";
211                                            }
212                                    }
213    
214                                  # filter="name" ; filter this field through                                  # filter="name" ; filter this field through
215                                  # filter/[name].pm                                  # filter/[name].pm
216                                  my $filter = $x->{filter};                                  my $filter = $x->{filter};
217                                  if ($filter) {                                  if ($filter && !$cache->{filter_loaded}->{$filter}) {
218                                          require "filter/".$filter.".pm";                                          require "filter/".$filter.".pm";
219                                            $cache->{filter_loaded}->{$filter}++;
220                                  }                                  }
221                                  # type="swish" ; field for swish                                  # type="swish" ; field for swish
222                                  if ($s && $swish) {                                  if ($swish) {
223                                          if ($filter) {                                          if ($filter && ($s || $se)) {
224                                                  no strict 'refs';                                                  no strict 'refs';
225                                                  $swish_data .= join(" ",&$filter($swish));                                                  my $tmp = join(" ",&$filter($swish)) if ($s || $se);
226                                                    $swish_data .= $tmp if ($s);
227                                                    $swish_exact_data .= $tmp if ($se);
228    
229                                          } else {                                          } else {
230                                                  $swish_data .= $swish;                                                  $swish_data .= $swish if ($s);
231                                                    $swish_exact_data .= $swish if ($se);
232                                          }                                          }
233                                  }                                  }
234    
# Line 160  sub data2xml { Line 240  sub data2xml {
240                                          }                                          }
241                                          if ($filter) {                                          if ($filter) {
242                                                  no strict 'refs';                                                  no strict 'refs';
243                                                  $display_data .= join($delimiter,&$filter($display));                                                  if ($display_data) {
244                                                            $display_data .= $delimiter.join($delimiter,mkformat($x,&$filter($display)));
245                                                    } else {
246                                                            $display_data = join($delimiter,mkformat($x,&$filter($display)));
247                                                    }
248                                          } else {                                          } else {
249                                                  if ($display_data) {                                                  if ($display_data) {
250                                                          $display_data .= $delimiter.$display;                                                          $display_data .= $delimiter.mkformat($x,$display);
251                                                  } else {                                                  } else {
252                                                          $display_data .= $display;                                                          $display_data = mkformat($x,$display);
253                                                  }                                                  }
254                                          }                                          }
255                                  }                                  }
256                                                                                                    
257                                  # type="index" ; insert into index                                  # type="index" ; insert into index
258                                  if ($i && $display) {                                  if ($i && $display) {
259                                          push @index_data, $display;                                          if ($filter) {
260                                          $index_filter = $filter if ($filter);                                                  no strict 'refs';
261                                                    $display = &$filter($display);
262                                            }
263                                            if ($x->{append} && @index_data) {
264                                                    $index_data[$#index_data].=$display;
265                                            } else {
266                                                    push @index_data, $display;
267                                            }
268                                  }                                  }
                         }  
269    
270                          # fill data in index                                  # store fields in lookup
271                          if (@index_data) {                                  if ($il && $display) {
272                                  if ($index_filter) {                                          if (lc($x->{type}) eq "lookup_key") {
273                                          no strict 'refs';                                                  if ($lookup_key) {
274                                          foreach my $d (@index_data) {                                                          print STDERR "WARNING: try to redefine lookup_key (keys shouldn't be repeatable fields!)";
275                                                  $index->insert($field, &$index_filter($d), $path);                                                  } else {
276                                          }                                                          $lookup_key = $display;
277                                  } else {                                                  }
278                                          foreach my $d (@index_data) {                                          } elsif (lc($x->{type}) eq "lookup_val") {
279                                                  $index->insert($field, $d, $path);                                                  if ($lookup_key) {
280                                                            $lhash{$lookup_key} = $display;
281                                                    } else {
282                                                            print STDERR "WARNING: no lookup_key defined for  '$display'?";
283                                                    }
284                                          }                                          }
285                                  }                                  }
286                          }                          }
287    
288                            # fill data in index
289                            foreach my $d (@index_data) {
290                                    $index->insert($field, $d, $path);
291                            }
292                  }                  }
293    
294                  # now try to parse variables from configuration file                  # now try to parse variables from configuration file
# Line 201  sub data2xml { Line 300  sub data2xml {
300                          my ($s,$d,$i) = (1,1,0);        # swish, display default                          my ($s,$d,$i) = (1,1,0);        # swish, display default
301                          $s = 0 if (lc($x->{type}) eq "display");                          $s = 0 if (lc($x->{type}) eq "display");
302                          $d = 0 if (lc($x->{type}) eq "swish");                          $d = 0 if (lc($x->{type}) eq "swish");
303                            # no support for swish exact in config.
304                            # IMHO, it's useless
305                          ($s,$d,$i) = (0,0,1) if (lc($x->{type}) eq "index");                          ($s,$d,$i) = (0,0,1) if (lc($x->{type}) eq "index");
306    
307                          if ($val) {                          if ($val) {
# Line 243  sub data2xml { Line 344  sub data2xml {
344                          $xml .= xmlify($field."_swish", unac_string($codepage,$swish_data));                          $xml .= xmlify($field."_swish", unac_string($codepage,$swish_data));
345                  }                  }
346    
347                    if ($swish_exact_data) {
348                            $swish_exact_data =~ s/ +/ /g;
349                            $swish_exact_data =~ s/ +$//g;
350    
351                            # add delimiters before and after word.
352                            # That is required to produce exact match
353                            $xml .= xmlify($field."_swish_exact", unac_string($codepage,'xxbxx '.$swish_exact_data.' xxexx'));
354                    }
355    
356    
357          }          }
358    
# Line 278  $index = new index_DBI( Line 388  $index = new index_DBI(
388    
389  my $show_progress = $cfg_global->val('global', 'show_progress');  my $show_progress = $cfg_global->val('global', 'show_progress');
390    
391    my $unac_filter = $cfg_global->val('global', 'unac_filter');
392    if ($unac_filter) {
393            require $unac_filter;
394    }
395    
396  foreach my $database ($cfg->Sections) {  foreach my $database ($cfg->Sections) {
397    
398          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";
399          my $add_xml = $cfg -> val($database, 'xml');    # optional          my $add_xml = $cfg -> val($database, 'xml');    # optional
400    
401            # create new lookup file
402            my $lookup_file = $cfg -> val($database, 'lookup_newfile'); # optional
403            if ($lookup_file) {
404                    #tie %lhash, 'GDBM_File', $lookup_file, &GDBM_NEWDB, 0644;
405                    tie %lhash, 'TDB_File', $lookup_file, TDB_CLEAR_IF_FIRST, O_RDWR, 0644;
406                    print STDERR "creating lookup file '$lookup_file'\n";
407            }
408    
409            # open existing lookup file
410            $lookup_file = $cfg -> val($database, 'lookup_open'); # optional
411            if ($lookup_file) {
412                    #tie %lhash, 'GDBM_File', $lookup_file, &GDBM_READER, 0644;
413                    tie %lhash, 'TDB_File', $lookup_file, TDB_DEFAULT, O_RDWR, 0644;
414                    print STDERR "opening lookup file '$lookup_file'\n";
415            }
416    
417  print STDERR "reading ./import_xml/$type.xml\n";  print STDERR "reading ./import_xml/$type.xml\n";
418    
419          # extract just type basic          # extract just type basic
420          my $type_base = $type;          my $type_base = $type;
421          $type_base =~ s/_.+$//g;          $type_base =~ s/_.+$//g;
422    
423          $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);
424    
425          # output current progress indicator          # output current progress indicator
426          my $last_p = 0;          my $last_p = 0;
# Line 533  print STDERR "using: $type...\n"; Line 664  print STDERR "using: $type...\n";
664                          fakeprogress($i);                          fakeprogress($i);
665    
666                  }                  }
667                    # close lookup
668                    untie %lhash if (%lhash);
669          }          }
670  }  }
671    

Legend:
Removed from v.135  
changed lines
  Added in v.177

  ViewVC Help
Powered by ViewVC 1.1.26