/[webpac]/trunk/all2xml.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /trunk/all2xml.pl

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

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

Legend:
Removed from v.20  
changed lines
  Added in v.178

  ViewVC Help
Powered by ViewVC 1.1.26