/[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 170 by dpavlin, Sun Nov 23 15:42:16 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 63  my %type2tag = ( Line 66  my %type2tag = (
66    
67  my $cache;      # for cacheing  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 100  sub data2xml { Line 109  sub data2xml {
109                  $cache->{tags_by_order}->{$type} = \@sorted_tags;                  $cache->{tags_by_order}->{$type} = \@sorted_tags;
110          }          }
111    
112            # lookup key
113            my $lookup_key;
114    
115          foreach my $field (@sorted_tags) {          foreach my $field (@sorted_tags) {
116    
117                  $field=x($field);                  $field=x($field);
# Line 120  sub data2xml { Line 132  sub data2xml {
132    
133                          my $repeat_off = 0;             # repeatable offset                          my $repeat_off = 0;             # repeatable offset
134    
135                          my ($s,$se,$d,$i) = (1,0,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");                          $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 138  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;
                         my $index_filter;  
157    
158                          sub mkformat {                          sub mkformat {
159                                  my $x = shift || die "mkformat needs tag reference";                                  my $x = shift || die "mkformat needs tag reference";
# Line 173  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};
# Line 219  sub data2xml { Line 256  sub data2xml {
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 346  foreach my $database ($cfg->Sections) { Line 398  foreach my $database ($cfg->Sections) {
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
# Line 596  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.170  
changed lines
  Added in v.177

  ViewVC Help
Powered by ViewVC 1.1.26