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

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

  ViewVC Help
Powered by ViewVC 1.1.26