/[webpac]/trunk2/all2all.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/all2all.pl

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

revision 43 by dpavlin, Sat Mar 22 22:43:05 2003 UTC revision 188 by dpavlin, Sat Nov 29 19:07:00 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 18  die "FATAL: can't find configuration fil Line 21  die "FATAL: can't find configuration fil
21    
22  my $config;  my $config;
23    
24  use index_DBI;  # there is no other, right now ;-)  #use index_DBI;         # default DBI module for index
25    use index_DBI_cache;    # faster DBI module using memory cache
26  my $index = new index_DBI();    # open index  my $index;
27    
28  my %opts;  my %opts;
29    
# Line 34  getopts('d:m:qs', \%opts); Line 37  getopts('d:m:qs', \%opts);
37    
38  my $path;       # this is name of database  my $path;       # this is name of database
39    
40  Text::Iconv->raise_error(1);     # Conversion errors raise exceptions  Text::Iconv->raise_error(0);     # Conversion errors don't raise exceptions
41    
42  # this is encoding of all files on disk, including import_xml/*.xml file and  # this is encoding of all files on disk, including import_xml/*.xml file and
43  # filter/*.pm files! It will be used to store strings in perl internally!  # filter/*.pm files! It will be used to store strings in perl internally!
# Line 46  sub x { Line 49  sub x {
49          return $utf2cp->convert($_[0]);          return $utf2cp->convert($_[0]);
50  }  }
51    
52  # decode isis import codepage  # decode isis/excel or other import codepage
53  my $isis2cp;  my $import2cp;
54    
55  # outgoing xml must be in UTF-8  # outgoing xml must be in UTF-8
56  my $cp2utf = Text::Iconv->new($codepage,'UTF-8');  my $cp2utf = Text::Iconv->new($codepage,'UTF-8');
57    
58  sub isis2xml {  # mapping between data type and tag which specify
59    # format in XML file
60    my %type2tag = (
61            'isis' => 'isis',
62            'excel' => 'column',
63            'marc' => 'marc',
64            '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 {
76    
77          use xmlify;          use xmlify;
78    
79            my $type = shift @_;
80          my $row = shift @_;          my $row = shift @_;
81          my $add_xml = shift @_;          my $add_xml = shift @_;
82            # needed to read values from configuration file
83            my $cfg = shift @_;
84            my $database = shift @_;
85    
86          my $xml;          my $xml;
87    
# Line 69  sub isis2xml { Line 93  sub isis2xml {
93    
94          # sort subrouting using order="" attribute          # sort subrouting using order="" attribute
95          sub by_order {          sub by_order {
96                  return 0 if (! $config->{indexer}->{$a}->{order});                  my $va = $config->{indexer}->{$a}->{order} ||
97                  return 0 if (! $config->{indexer}->{$b}->{order});                          $config->{indexer}->{$a};
98                    my $vb = $config->{indexer}->{$b}->{order} ||
99                            $config->{indexer}->{$b};
100    
101                    return $va <=> $vb;
102            }
103    
104                  return $config->{indexer}->{$a}->{order} <=>          my @sorted_tags;
105                          $config->{indexer}->{$b}->{order} ;          if ($cache->{tags_by_order}) {
106                    @sorted_tags = @{$cache->{tags_by_order}};
107            } else {
108                    @sorted_tags = sort by_order keys %{$config->{indexer}};
109                    $cache->{tags_by_order} = \@sorted_tags;
110          }          }
111    
112          foreach my $field (sort by_order keys %{$config->{indexer}}) {          # lookup key
113            my $lookup_key;
114    
115                  $field=x($field);          # cache for field in pages
116            delete $cache->{display_data};
117            delete $cache->{swish_data};
118            delete $cache->{swish_exact_data};
119            delete $cache->{index_data};
120            delete $cache->{index_delimiter};
121            my @page_fields;        # names of fields
122    
123    
124            # subs used to produce output
125    
126            sub get_field_name($$$) {
127                    my ($config,$field,$field_usage) = @_;
128    
129                    # find field name (signular, plural)
130                    my $field_name = "";
131                    if ($config->{indexer}->{$field}->{name_singular} && $field_usage == 1) {
132                            $field_name = $config->{indexer}->{$field}->{name_singular};
133                    } elsif ($config->{indexer}->{$field}->{name_plural}) {
134                            $field_name = $config->{indexer}->{$field}->{name_plural};
135                    } elsif ($config->{indexer}->{$field}->{name}) {
136                            $field_name = $config->{indexer}->{$field}->{name};
137                    } else {
138                            print STDERR "WARNING: field '$field' doesn't have 'name' attribute!";
139                    }
140                    if ($field_name) {
141                            return x($field_name);
142                    }
143            }
144    
145    
146            # begin real work: go field by field
147            foreach my $field (@sorted_tags) {
148    
149                    $field=x($field);
150                  $field_usage{$field}++;                  $field_usage{$field}++;
151    
152                  my $swish_data = "";                  my $swish_data = "";
153                    my $swish_exact_data = "";
154                  my $display_data = "";                  my $display_data = "";
155                    my @index_data;
156                  my $line_delimiter;                  my $line_delimiter;
157    
158                  my ($swish,$display);                  my ($swish,$display);
159    
160                  foreach my $x (@{$config->{indexer}->{$field}->{isis}}) {                  my $tag = $type2tag{$type} || die "can't find which tag to use for type $type";
161    
162                    # is this field page-by-page?
163                    my $iterate_by_page = $config->{indexer}->{$field}->{iterate_by_page};
164                    push @page_fields,$field if ($iterate_by_page);
165                    my %page_max = ();
166                    # default line_delimiter if using
167                    my $page_line_delimiter = $config->{indexer}->{$field}->{page_line_delimiter} || '<br/>';
168                    $cache->{index_delimiter}->{$field} = $config->{indexer}->{$field}->{index_delimiter};
169    
170                    foreach my $x (@{$config->{indexer}->{$field}->{$tag}}) {
171    
172                          my $format = x($x->{content});                          my $format = x($x->{content});
173                          my $delimiter = x($x->{delimiter}) || ' ';                          my $delimiter = x($x->{delimiter}) || ' ';
174    
175                          my $isis_i = 0;         # isis repeatable offset                          my $repeat_off = 0;     # init repeatable offset
176    
177                          my ($s,$d,$i) = (1,1,0);        # swish, display default                          # swish, swish_exact, display, index, index_lookup
178                            # swish and display defaults
179                            my ($s,$se,$d,$i,$il) = (1,0,1,0,0);
180                          $s = 0 if (lc($x->{type}) eq "display");                          $s = 0 if (lc($x->{type}) eq "display");
181                          $d = 0 if (lc($x->{type}) eq "swish");                          $d = 0 if (lc($x->{type}) eq "swish");
182                          ($s,$d,$i) = (0,0,1) if (lc($x->{type}) eq "index");                          ($s,$se,$d,$i) = (0,1,0,1) if (lc($x->{type}) eq "index");
183                            ($s,$se,$d,$i) = (0,1,0,0) if (lc($x->{type}) eq "swish_exact");
184                            ($s,$se,$d,$i,$il) = (0,1,0,0,1) if (lc($x->{type}) =~ /^lookup/);
185    
186                          # what will separate last line from this one?                          # what will separate last line from this one?
187                          if ($display_data && $x->{append} && $x->{append} eq "1") {                          if ($display_data && $x->{append}) {
188                                  $line_delimiter = ' ';                                  $line_delimiter = ' ';
189                          } elsif ($display_data) {                          } elsif ($display_data) {
190                                  $line_delimiter = '<br/>';                                  $line_delimiter = '<br/>';
# Line 110  sub isis2xml { Line 193  sub isis2xml {
193                          # init vars so that we go into while...                          # init vars so that we go into while...
194                          ($swish,$display) = (1,1);                          ($swish,$display) = (1,1);
195    
196                            # placeholder for all repeatable entries for index
197    
198                            sub mkformat {
199                                    my $x = shift || die "mkformat needs tag reference";
200                                    my $data = shift || return;
201                                    my $format_name = x($x->{format_name}) || return $data;
202                                    my $fmt = x($config->{format}->{$format_name}->{content}) || die "<format name=\"$format_name\"> is not defined!";
203                                    my $format_delimiter = x($x->{format_delimiter});
204                                    my @data;
205                                    if ($format_delimiter) {
206                                            @data = split(/$format_delimiter/,$data);
207                                    } else {
208                                            push @data,$data;
209                                    }
210    
211                                    if ($fmt) {
212                                            my $nr = scalar $fmt =~ s/%s/%s/g;
213                                            if (($#data+1) == $nr) {
214                                                    return sprintf($fmt,@data);
215                                            } else {
216                                                    print STDERR "mkformat: [$data] can't be split on [$format_delimiter] to $nr fields!\n";
217                                                    return $data;
218                                            }
219                                    } else {
220                                            print STDERR "usage of link '$format_name' without defined format (<link> tag)\n";
221                                    }
222                            }
223    
224                            # while because of repeatable fields
225                          while ($swish || $display) {                          while ($swish || $display) {
226                                  ($swish,$display) = parse_format($format,$row,$isis_i++,$isis2cp);                                  my $page = $repeat_off;
227                                    $page_max{$field} = $page if ($iterate_by_page && $page > ($page_max{$field} || 0));
228                                    ($swish,$display) = parse_format($type, $format,$row,$repeat_off++,$import2cp);
229                                    if ($repeat_off > 1000) {
230                                            print STDERR "loop (more than 1000 repeatable fields) deteced in $row, $format\n";
231                                            last;
232                                    }
233    
234                                    # is this field is lookup?
235                                    if ($display && $x->{lookup}) {
236                                            my $null = "<!-- null -->";
237                                            if ($use_lhash_cache) {
238                                                    if (!defined($cache->{lhash}->{$display})) {
239                                                            my $new_display = $lhash{$display};
240                                                            if (defined($new_display)) {
241    #print STDERR "lookup cache store '$display' = '$new_display'\n";
242                                                                    $display = $new_display;
243                                                                    $cache->{lhash}->{$display} = $new_display;
244                                                            } else {
245                                                                    print STDERR "WARNING: lookup for '$display' didn't find anything.\n";
246                                                                    $display = "";
247                                                                    $cache->{lhash}->{$display} = $null;
248                                                            }
249                                                    } else {
250                                                            $display = $cache->{lhash}->{$display};
251                                                    }
252                                            } else {
253                                                    $display = $lhash{$display} || $null;
254                                            }
255                                    }
256    
257                                  # filter="name" ; filter this field through                                  # filter="name" ; filter this field through
258                                  # filter/[name].pm                                  # filter/[name].pm
259                                  my $filter = $x->{filter};                                  my $filter = $x->{filter};
260                                  if ($filter) {                                  if ($filter && !$cache->{filter_loaded}->{$filter}) {
261                                          require "filter/".$filter.".pm";                                          require "filter/".$filter.".pm";
262                                            $cache->{filter_loaded}->{$filter}++;
263                                  }                                  }
264                                  # type="swish" ; field for swish                                  # type="swish" ; field for swish
265                                  if ($s && $swish) {                                  if ($swish) {
266                                          if ($filter) {                                          if ($filter && ($s || $se)) {
267                                                  no strict 'refs';                                                  no strict 'refs';
268                                                  $swish_data .= join(" ",&$filter($swish));                                                  my $tmp = join(" ",&$filter($swish)) if ($s || $se);
269                                                    $swish_data .= $tmp if ($s);
270                                                    $swish_exact_data .= $tmp if ($se);
271    
272                                          } else {                                          } else {
273                                                  $swish_data .= $swish;                                                  $swish_data .= $swish if ($s);
274                                                    $swish_exact_data .= $swish if ($se);
275                                          }                                          }
276                                  }                                  }
277    
# Line 133  sub isis2xml { Line 279  sub isis2xml {
279                                  if ($d && $display) {                                  if ($d && $display) {
280                                          if ($line_delimiter && $display_data) {                                          if ($line_delimiter && $display_data) {
281                                                  $display_data .= $line_delimiter;                                                  $display_data .= $line_delimiter;
                                                 undef $line_delimiter;  
282                                          }                                          }
283                                          if ($filter) {                                          if ($filter) {
284                                                  no strict 'refs';                                                  no strict 'refs';
285                                                  $display_data .= join($delimiter,&$filter($display));                                                  if ($display_data) {
286                                                            $display_data .= $delimiter.join($delimiter,mkformat($x,&$filter($display)));
287                                                    } else {
288                                                            $display_data = join($delimiter,mkformat($x,&$filter($display)));
289                                                    }
290                                          } else {                                          } else {
291                                                  if ($display_data) {                                                  if ($display_data) {
292                                                          $display_data .= $delimiter.$display;                                                          $display_data .= $delimiter.mkformat($x,$display);
293                                                  } else {                                                  } else {
294                                                          $display_data .= $display;                                                          $display_data = mkformat($x,$display);
295                                                  }                                                  }
296                                          }                                          }
297                                  }                                  }
298                                                                                                    
299                                  # type="index" ; insert into index                                  # type="index" ; insert into index
300                                    my $idisplay;
301                                  if ($i && $display) {                                  if ($i && $display) {
302                                          my $index_data = $display;                                          $idisplay = $display;
303                                          if ($filter) {                                          if ($filter) {
304                                                  no strict 'refs';                                                  no strict 'refs';
305                                                  foreach my $d (&$filter($index_data)) {                                                  $idisplay = &$filter($idisplay);
306                                                          $index->insert($field, $d, $path);                                          }
307                                            push @index_data, $idisplay if (! $iterate_by_page);
308                                    }
309    
310                                    # store fields in lookup
311                                    if ($il && $display) {
312                                            if (lc($x->{type}) eq "lookup_key") {
313                                                    if ($lookup_key) {
314                                                            print STDERR "WARNING: try to redefine lookup_key (keys shouldn't be repeatable fields!)";
315                                                    } else {
316                                                            $lookup_key = $display;
317                                                    }
318                                            } elsif (lc($x->{type}) eq "lookup_val") {
319                                                    if ($lookup_key) {
320                                                            $lhash{$lookup_key} = $display;
321                                                    } else {
322                                                            print STDERR "WARNING: no lookup_key defined for  '$display'?";
323                                                  }                                                  }
324                                          } else {                                          }
325                                                  $index->insert($field, $index_data, $path);  
326                                    }
327    
328                                    # store data for page-by-page repeatable fields
329                                    if ($iterate_by_page) {
330                                            sub iterate_fld($$$$$$) {
331                                                    my ($cache,$what,$field,$page,$data,$append) = @_;
332                                                    return if (!$data);
333    
334                                                    my $ldel = $page_line_delimiter;
335                                                    $ldel = " " if ($append);
336    #print STDERR "line delimiter: ",Dumper($ldel) if ($ldel);
337                                                    if (! $cache->{$what}->{$field}->[$page]) {
338                                                            $cache->{$what}->{$field}->[$page] = $data;
339                                                    } else {
340                                                            $cache->{$what}->{$field}->[$page] .= $ldel.$data;
341                                                    }
342                                            }
343    
344                                            if ($display_data) {
345                                                    iterate_fld($cache,'display_data',$field,$page,$display_data,$x->{append});
346                                            }
347                                                    $display_data = "";
348                                            if ($swish_data) {
349                                                    iterate_fld($cache,'swish_data',$field,$page,$swish_data,$x->{append});
350                                                    $swish_data = "";
351                                            }
352                                            if ($swish_exact_data) {
353                                                    iterate_fld($cache,'swish_exact_data',$field,$page,$swish_exact_data,$x->{append});
354                                                    $swish_exact_data = "";
355                                            }
356    
357                                            if ($idisplay) {
358                                                    my $ldel=$page_line_delimiter;
359                                                    my @index_data;
360                                                    if ($cache->{index_data}->{$field}->[$page]) {
361    
362                                                            @index_data = @{$cache->{index_data}->{$field}->[$page]};
363                                                    }
364                                                    if ($x->{append}) {
365                                                            $index_data[$#index_data] .= $idisplay;
366                                                    } else {
367                                                            push @index_data, $idisplay;
368                                                    }
369                                                    $idisplay = "";
370                                                    @{$cache->{index_data}->{$field}->[$page]} = @index_data;
371                                          }                                          }
372                                  }                                  }
373                          }                          }
374    
375                            if (! $iterate_by_page) {
376                                    my $idel = $x->{index_delimiter};
377                                    # fill data in index
378                                    foreach my $tmp (@index_data) {
379                                            my $i = $d = $tmp;
380                                            if ($idel && $tmp =~ m/$idel/) {
381                                                    ($i,$d) = split(/$idel/,$tmp);
382                                            }
383                                            $index->insert($field, $i, $d, $path);
384                                    }
385                                    @index_data = ();
386                            }
387                  }                  }
388    
389                    # now try to parse variables from configuration file
390                    foreach my $x (@{$config->{indexer}->{$field}->{'config'}}) {
391    
392                  if ($display_data) {                          my $delimiter = x($x->{delimiter}) || ' ';
393                            my $val = $cfg->val($database, x($x->{content}));
394    
395                            my ($s,$d,$i) = (1,1,0);        # swish, display default
396                            $s = 0 if (lc($x->{type}) eq "display");
397                            $d = 0 if (lc($x->{type}) eq "swish");
398                            # no support for swish exact in config.
399                            # IMHO, it's useless
400                            ($s,$d,$i) = (0,0,1) if (lc($x->{type}) eq "index");
401    
402                          if ($field eq "headline") {                          if ($val) {
403                                  $xml .= xmlify("headline", $display_data);                                  $display_data .= $delimiter.$val if ($d);
404                          } else {                                  $swish_data .= $val if ($s);
405                                    $index->insert($field, $val, $path) if ($i);
406                            }
407    
408                                  # find field name (signular, plural)                          if ($iterate_by_page) {
409                                  my $field_name = "";                                  # FIXME data from config tag will appear just
410                                  if ($config->{indexer}->{$field}->{name_singular} && $field_usage{$field} == 1) {                                  # on first page!!!
411                                          $field_name = $config->{indexer}->{$field}->{name_singular}."#-#";                                  my $page = 0;
412                                  } elsif ($config->{indexer}->{$field}->{name_plural}) {                                  if ($display_data) {
413                                          $field_name = $config->{indexer}->{$field}->{name_plural}."#-#";                                          $cache->{display_data}->{$field}->[$page] = $display_data;
414                                  } elsif ($config->{indexer}->{$field}->{name}) {                                          $display_data = "";
                                         $field_name = $config->{indexer}->{$field}->{name}."#-#";  
                                 } else {  
                                         print STDERR "WARNING: field '$field' doesn't have 'name' attribute!";  
415                                  }                                  }
416                                  if ($field_name) {                                  if ($swish_data) {
417                                          $html .= x($field_name);                                          $cache->{swish_data}->{$field}->[$page] = $swish_data;
418                                            $swish_data = "";
419                                    }
420                                    if ($swish_exact_data) {
421                                            $cache->{swish_exact_data}->{$field}->[$page] = $swish_exact_data;
422                                            $swish_exact_data = "";
423                                  }                                  }
                                 $html .= $display_data."###\n";  
424                          }                          }
425                  }                  }
                 if ($swish_data) {  
                         # remove extra spaces  
                         $swish_data =~ s/ +/ /g;  
                         $swish_data =~ s/ +$//g;  
426    
427                          $xml .= xmlify($field."_swish", unac_string($codepage,$swish_data));                  # save data page-by-page
428                    foreach my $field (@page_fields) {
429                            my $nr_pages = $page_max{$field} || next;
430    #print STDERR "field '$field' iterate over ",($nr_pages || 0)," pages...\n";
431    #print STDERR Dumper($cache->{display_data});
432                            for (my $page=0; $page <= $nr_pages; $page++) {
433    
434                                    my $display_data = $cache->{display_data}->{$field}->[$page];
435                                    if ($display_data) { # default
436                                            if ($field eq "headline") {
437                                                    $xml .= xmlify("headline", $display_data);
438                                            } else {
439    
440                                                    # fallback to empty field name if needed
441                                                    $html .= get_field_name($config,$field,$field_usage{$field}) || '';
442                                                    $html .= "#-#".$display_data."###\n";
443                                            }
444                                    }
445                                    
446                                    my $swish_data = $cache->{swish_data}->{$field}->[$page];
447                                    if ($swish_data) {
448                                            # remove extra spaces
449                                            $swish_data =~ s/ +/ /g;
450                                            $swish_data =~ s/ +$//g;
451    
452                                            $xml .= xmlify($field."_swish", unac_string($codepage,$swish_data));
453                                    }
454    
455                                    my $swish_exact_data = $cache->{swish_exact_data}->{$field}->[$page];
456                                    if ($swish_exact_data) {
457                                            $swish_exact_data =~ s/ +/ /g;
458                                            $swish_exact_data =~ s/ +$//g;
459    
460                                            # add delimiters before and after word.
461                                            # That is required to produce exact match
462                                            $xml .= xmlify($field."_swish_exact", unac_string($codepage,'xxbxx '.$swish_exact_data.' xxexx'));
463                                    }
464                                    
465                                    my $idel = $cache->{index_delimiter}->{$field};
466                                    foreach my $tmp (@{$cache->{index_data}->{$field}->[$page]}) {
467                                            my $i = $tmp;
468                                            my $d = $tmp;
469                                            if ($idel && $tmp =~ m/$idel/) {
470                                                    ($i,$d) = split(/$idel/,$tmp);
471                                            }
472                                            $index->insert($field, $i, $d, $path);
473    #print STDERR "index [$idel] $field: $i --> $d [$path]\n";
474                                    }
475                            }
476            
477                  }                  }
478                    
479                    if (! $iterate_by_page) {
480                            if ($display_data) {
481                                    if ($field eq "headline") {
482                                            $xml .= xmlify("headline", $display_data);
483                                    } else {
484    
485                                            # fallback to empty field name if needed
486                                            $html .= get_field_name($config,$field,$field_usage{$field}) || '';
487                                            $html .= "#-#".$display_data."###\n";
488                                    }
489                            }
490                            if ($swish_data) {
491                                    # remove extra spaces
492                                    $swish_data =~ s/ +/ /g;
493                                    $swish_data =~ s/ +$//g;
494    
495                                    $xml .= xmlify($field."_swish", unac_string($codepage,$swish_data));
496                            }
497    
498                            if ($swish_exact_data) {
499                                    $swish_exact_data =~ s/ +/ /g;
500                                    $swish_exact_data =~ s/ +$//g;
501    
502                                    # add delimiters before and after word.
503                                    # That is required to produce exact match
504                                    $xml .= xmlify($field."_swish_exact", unac_string($codepage,'xxbxx '.$swish_exact_data.' xxexx'));
505                            }
506                    }
507          }          }
508    
509          # dump formatted output in <html>          # dump formatted output in <html>
510          if ($html) {          if ($html) {
511                  $xml .= xmlify("html",$html);                  #$xml .= xmlify("html",$html);
512                    $xml .= "<html><![CDATA[ $html ]]></html>";
513          }          }
514                    
515          if ($xml) {          if ($xml) {
# Line 212  sub isis2xml { Line 522  sub isis2xml {
522    
523  ##########################################################################  ##########################################################################
524    
525    # read configuration for this script
526  my $cfg = new Config::IniFiles( -file => $config_file );  my $cfg = new Config::IniFiles( -file => $config_file );
527    
528    # read global.conf configuration
529    my $cfg_global = new Config::IniFiles( -file => 'global.conf' );
530    
531    # open index
532    $index = new index_DBI(
533                    $cfg_global->val('global', 'dbi_dbd'),
534                    $cfg_global->val('global', 'dbi_dsn'),
535                    $cfg_global->val('global', 'dbi_user'),
536                    $cfg_global->val('global', 'dbi_passwd') || '',
537            );
538    
539    my $show_progress = $cfg_global->val('global', 'show_progress');
540    
541    my $unac_filter = $cfg_global->val('global', 'unac_filter');
542    if ($unac_filter) {
543            require $unac_filter;
544    }
545    
546  foreach my $database ($cfg->Sections) {  foreach my $database ($cfg->Sections) {
547    
548          my $isis_db = $cfg -> val($database, 'isis_db') || die "$database doesn't have 'isis_db' defined!";          my $type = lc($cfg -> val($database, 'type')) || die "$database doesn't have 'type' defined";
         my $type = $cfg -> val($database, 'type') || die "$database doesn't have 'type' defined";  
549          my $add_xml = $cfg -> val($database, 'xml');    # optional          my $add_xml = $cfg -> val($database, 'xml');    # optional
550    
551          $config=XMLin("./import_xml/$type.xml", forcearray => [ 'isis' ], forcecontent => 1);          # create new lookup file
552            my $lookup_file = $cfg -> val($database, 'lookup_newfile'); # optional
553          $isis2cp = Text::Iconv->new($config->{isis_codepage},$codepage);          if ($lookup_file) {
554                    #tie %lhash, 'GDBM_File', $lookup_file, &GDBM_NEWDB, 0644;
555                    tie %lhash, 'TDB_File', $lookup_file, TDB_CLEAR_IF_FIRST, O_RDWR, 0644;
556                    print STDERR "creating lookup file '$lookup_file'\n";
557            }
558    
559          my $db = OpenIsis::open( $isis_db );          # open existing lookup file
560          if (0) {          $lookup_file = $cfg -> val($database, 'lookup_open'); # optional
561  #       # FIX          if ($lookup_file) {
562  #       if (! $db ) {                  #tie %lhash, 'GDBM_File', $lookup_file, &GDBM_READER, 0644;
563                  print STDERR "WARNING: can't open '$isis_db'\n";                  tie %lhash, 'TDB_File', $lookup_file, TDB_DEFAULT, O_RDWR, 0644;
564                  next ;                  print STDERR "opening lookup file '$lookup_file'\n";
565          }          }
566    
567          my $max_rowid = OpenIsis::maxRowid( $db );  print STDERR "reading ./import_xml/$type.xml\n";
568    
569          print STDERR "Reading database: $isis_db [$max_rowid rows]\n";          # extract just type basic
570            my $type_base = $type;
571            $type_base =~ s/_.+$//g;
572    
573          my $path = $database;                   # was $isis_db          $config=XMLin("./import_xml/$type.xml", forcearray => [ $type2tag{$type_base}, 'config', 'format' ], forcecontent => 1);
574    
575            # output current progress indicator
576          my $last_p = 0;          my $last_p = 0;
577            sub progress {
578                    return if (! $show_progress);
579                    my $current = shift;
580                    my $total = shift || 1;
581                    my $p = int($current * 100 / $total);
582                    if ($p != $last_p) {
583                            printf STDERR ("%5d / %5d [%-51s] %-2d %% \r",$current,$total,"=" x ($p/2).">", $p );
584                            $last_p = $p;
585                    }
586            }
587    
588            my $fake_dir = 1;
589            sub fakeprogress {
590                    return if (! $show_progress);
591                    my $current = shift @_;
592    
593                    my @ind = ('-','\\','|','/','-','\\','|','/', '-');
594    
595                    $last_p += $fake_dir;
596                    $fake_dir = -$fake_dir if ($last_p > 1000 || $last_p < 0);
597                    if ($last_p % 10 == 0) {
598                            printf STDERR ("%5d / %5s [%-51s]\r",$current,"?"," " x ($last_p/20).$ind[($last_p/20) % $#ind]);
599                    }
600            }
601    
602            # now read database
603    print STDERR "using: $type...\n";
604    
605  #       { my $row_id = 4514;          # erase cache for tags by order in this database
606  # FIX          delete $cache->{tags_by_order};
607          for (my $row_id = 1; $row_id <= $max_rowid; $row_id++ ) {  
608                  my $row = OpenIsis::read( $db, $row_id );          if ($type_base eq "isis") {
609                  if ($row && $row->{mfn}) {  
610                          # output current process indicator                  my $isis_db = $cfg -> val($database, 'isis_db') || die "$database doesn't have 'isis_db' defined!";
611                          my $p = int($row->{mfn} * 100 / $max_rowid);  
612                          if ($p != $last_p) {                  $import2cp = Text::Iconv->new($config->{isis_codepage},$codepage);
613                                  printf STDERR ("%5d / %5d [%-51s] %-2d %% \r",$row->{mfn},$max_rowid,"=" x ($p/2).">", $p ) if (! $opts{q});                  my $db = OpenIsis::open( $isis_db );
614                                  $last_p = $p;  
615                    # check if .txt database for OpenIsis is zero length,
616                    # if so, erase it and re-open database
617                    sub check_txt_db {
618                            my $isis_db = shift || die "need isis database name";
619                            my $reopen = 0;
620    
621                            if (-e $isis_db.".TXT") {
622                                    print STDERR "WARNING: removing $isis_db.TXT OpenIsis database...\n";
623                                    unlink $isis_db.".TXT" || warn "FATAL: unlink error on '$isis_db.TXT': $!";
624                                    $reopen++;
625                            }
626                            if (-e $isis_db.".PTR") {
627                                    print STDERR "WARNING: removing $isis_db.PTR OpenIsis database...\n";
628                                    unlink $isis_db.".PTR" || warn "FATAL: unlink error on '$isis_db.PTR': $!";
629                                    $reopen++;
630                          }                          }
631                            return OpenIsis::open( $isis_db ) if ($reopen);
632                    }
633    
634                          my $swishpath = $path."#".int($row->{mfn});                  # EOF error
635                    if ($db == -1) {
636                            $db = check_txt_db($isis_db);
637                            if ($db == -1) {
638                                    print STDERR "FATAL: OpenIsis can't open zero size file $isis_db\n";
639                                    next;
640                            }
641                    }
642    
643                    # OpenIsis::ERR_BADF
644                    if ($db == -4) {
645                            print STDERR "FATAL: OpenIsis can't find file $isis_db\n";
646                            next;
647                    # OpenIsis::ERR_IO
648                    } elsif ($db == -5) {
649                            print STDERR "FATAL: OpenIsis can't access file $isis_db\n";
650                            next;
651                    } elsif ($db < 0) {
652                            print STDERR "FATAL: OpenIsis unknown error $db with file $isis_db\n";
653                            next;
654                    }
655    
656                          if (my $xml = $cp2utf->convert(isis2xml($row,$add_xml."<path>$swishpath</path>"))) {                  my $max_rowid = OpenIsis::maxRowid( $db );
657    
658                    # if 0 records, try to rease isis .txt database
659                    if ($max_rowid == 0) {
660                            # force removal of database
661                            $db = check_txt_db($isis_db);
662                            $max_rowid = OpenIsis::maxRowid( $db );
663                    }
664    
665                    print STDERR "Reading database: $isis_db [$max_rowid rows]\n";
666    
667                    my $path = $database;
668    
669                    for (my $row_id = 1; $row_id <= $max_rowid; $row_id++ ) {
670                            my $row = OpenIsis::read( $db, $row_id );
671                            if ($row && $row->{mfn}) {
672            
673                                    progress($row->{mfn}, $max_rowid);
674    
675                                    my $swishpath = $path."#".int($row->{mfn});
676    
677                                    if (my $xml = data2xml($type_base,$row,$add_xml,$cfg,$database)) {
678                                            $xml = $cp2utf->convert($xml);
679                                            use bytes;      # as opposed to chars
680                                            print "Path-Name: $swishpath\n";
681                                            print "Content-Length: ".(length($xml)+1)."\n";
682                                            print "Document-Type: XML\n\n$xml\n";
683                                    }
684                            }
685                    }
686                    # for this to work with current version of OpenIsis (0.9.0)
687                    # you might need my patch from
688                    # http://www.rot13.org/~dpavlin/projects/openisis-0.9.0-perl_close.diff
689                    OpenIsis::close($db);
690                    print STDERR "\n";
691    
692            } elsif ($type_base eq "excel") {
693                    use Spreadsheet::ParseExcel;
694                    use Spreadsheet::ParseExcel::Utility qw(int2col);
695                    
696                    $import2cp = Text::Iconv->new($config->{excel_codepage},$codepage);
697                    my $excel_file = $cfg -> val($database, 'excel_file') || die "$database doesn't have 'excel_file' defined!";
698    
699                    my $sheet = x($config->{sheet}) || die "no sheet in $type.xml";
700                    my $start_row = x($config->{start_row}) - 1 || die "no start_row in $type.xml";
701    
702                    my $oBook = Spreadsheet::ParseExcel::Workbook->Parse($excel_file) || die "can't open Excel file '$excel_file'";
703    
704                    my $sheet_nr = 0;
705                    foreach my $oWks (@{$oBook->{Worksheet}}) {
706                            #print STDERR "-- SHEET $sheet_nr:", $oWks->{Name}, "\n";
707                            last if ($oWks->{Name} eq $sheet);
708                            $sheet_nr++;
709                    }
710    
711                    my $oWorksheet = $oBook->{Worksheet}[$sheet_nr];
712            
713                    print STDERR "using sheet: ",$oWorksheet->{Name},"\n";
714                    defined ($oWorksheet) || die "can't find sheet '$sheet' in $excel_file";
715                    my $end_row = x($config->{end_row}) || $oWorksheet->{MaxRow};
716    
717                    for(my $iR = $start_row ; defined $end_row && $iR <= $end_row ; $iR++) {
718                            my $row;
719                            for(my $iC = $oWorksheet->{MinCol} ; defined $oWorksheet->{MaxCol} && $iC <= $oWorksheet->{MaxCol} ; $iC++) {
720                                    my $cell = $oWorksheet->{Cells}[$iR][$iC];
721                                    if ($cell) {
722                                            $row->{int2col($iC)} = $cell->Value;
723                                    }
724                            }
725    
726                            progress($iR, $end_row);
727    
728    #                       print "row[$iR/$end_row] ";
729    #                       foreach (keys %{$row}) {
730    #                               print "$_: ",$row->{$_},"\t";
731    #                       }
732    #                       print "\n";
733    
734                            my $swishpath = $database."#".$iR;
735    
736                            next if (! $row);
737    
738                            if (my $xml = data2xml($type_base,$row,$add_xml,$cfg,$database)) {
739                                    $xml = $cp2utf->convert($xml);
740                                  use bytes;      # as opposed to chars                                  use bytes;      # as opposed to chars
741                                  print "Path-Name: $swishpath\n";                                  print "Path-Name: $swishpath\n";
742                                  print "Content-Length: ".(length($xml)+1)."\n";                                  print "Content-Length: ".(length($xml)+1)."\n";
743                                  print "Document-Type: XML\n\n$xml\n";                                  print "Document-Type: XML\n\n$xml\n";
744                          }                          }
745                  }                  }
746            } elsif ($type_base eq "marc") {
747    
748                    use MARC;
749                    
750                    $import2cp = Text::Iconv->new($config->{marc_codepage},$codepage);
751                    my $marc_file = $cfg -> val($database, 'marc_file') || die "$database doesn't have 'marc_file' defined!";
752    
753                    # optional argument is format
754                    my $format = x($config->{format}) || 'usmarc';
755    
756                    print STDERR "Reading MARC file '$marc_file'\n";
757    
758                    my $marc = new MARC;
759                    my $nr = $marc->openmarc({
760                                    file=>$marc_file, format=>$format
761                            }) || die "Can't open MARC file '$marc_file'";
762    
763                    my $i=0;        # record nr.
764    
765                    my $rec;
766    
767                    while ($marc->nextmarc(1)) {
768    
769                            # XXX
770                            fakeprogress($i++);
771    
772                            my $swishpath = $database."#".$i;
773    
774                            if (my $xml = data2xml($type_base,$marc,$add_xml,$cfg,$database)) {
775                                    $xml = $cp2utf->convert($xml);
776                                    use bytes;      # as opposed to chars
777                                    print "Path-Name: $swishpath\n";
778                                    print "Content-Length: ".(length($xml)+1)."\n";
779                                    print "Document-Type: XML\n\n$xml\n";
780                            }
781                    }
782            } elsif ($type_base eq "feed") {
783    
784                    $import2cp = Text::Iconv->new($config->{feed_codepage},$codepage);
785                    my $prog = x($config->{prog}) || die "$database doesn't have 'prog' defined!";
786    
787                    print STDERR "Reading feed from program '$prog'\n";
788    
789                    open(FEED,"feeds/$prog |") || die "can't start $prog: $!";
790    
791                    my $i=1;        # record nr.
792    
793                    my $data;
794                    my $line=1;
795    
796                    while (<FEED>) {
797                            chomp;
798    
799                            if (/^$/) {
800                                    my $swishpath = $database."#".$i++;
801    
802                                    if (my $xml = data2xml($type_base,$data,$add_xml,$cfg,$database)) {
803                                            $xml = $cp2utf->convert($xml);
804                                            use bytes;      # as opposed to chars
805                                            print "Path-Name: $swishpath\n";
806                                            print "Content-Length: ".(length($xml)+1)."\n";
807                                            print "Document-Type: XML\n\n$xml\n";
808                                    }
809                                    $line = 1;
810                                    $data = {};
811                                    next;
812                            }
813    
814                            $line = $1 if (s/^(\d+):\s*//);
815                            $data->{$line++} = $_;
816    
817                            fakeprogress($i);
818    
819                    }
820                    # close lookup
821                    untie %lhash if (%lhash);
822          }          }
         print STDERR "\n";  
823  }  }
824    
825  # call this to commit index  # call this to commit index
# Line 274  __END__ Line 831  __END__
831    
832  =head1 NAME  =head1 NAME
833    
834  isis2xml.pl - read isis file and dump XML  all2xml.pl - read various file formats and dump XML for SWISH-E
835    
836  =head1 DESCRIPTION  =head1 DESCRIPTION
837    
838  This command will read ISIS data file using OpenIsis perl module and  This command will read ISIS data file using OpenIsis perl module, MARC
839  create XML file for usage with I<SWISH-E>  records using MARC module and optionally Micro$oft Excel files to
840  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,
841  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
842  script is tailor-made for SWISH-E.  has something like that). Output of this script is tailor-made for SWISH-E.
843    
844    =head1 BUGS
845    
846    Documentation is really lacking. However, in true Open Source spirit, source
847    is best documentation. I even made considerable effort to comment parts
848    which are not intuitively clear, so...
849    
850  =head1 AUTHOR  =head1 AUTHOR
851    

Legend:
Removed from v.43  
changed lines
  Added in v.188

  ViewVC Help
Powered by ViewVC 1.1.26