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

Legend:
Removed from v.42  
changed lines
  Added in v.181

  ViewVC Help
Powered by ViewVC 1.1.26