/[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 181 by dpavlin, Tue Nov 25 20:19:03 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}) {
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    
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                          ($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  #print STDERR "## s: $s d: $d i: $i ## $format ##\n";                            ($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?
183                            if ($display_data && $x->{append} && $x->{append} eq "1") {
184                                    $line_delimiter = ' ';
185                            } elsif ($display_data) {
186                                    $line_delimiter = '<br/>';
187                            }
188    
189                            # init vars so that we go into while...
190                            ($swish,$display) = (1,1);
191    
192                          # FIX: this is ugly, UGLY, cludge string is returned                          # placeholder for all repeatable entries for index
193                          # in UTF8 encoding , but as if source charset                          my @index_data;
194                          # is ISO8859-1 and not some other. This break other  
195                          # character encodings, so we convert it first                          sub mkformat {
196                          # back to ISO8859-1                                  my $x = shift || die "mkformat needs tag reference";
197                          $format = $cludge_codepage->convert($format);                                  my $data = shift || return;
198                                    my $format_name = x($x->{format_name}) || return $data;
199                          my ($swish,$display) = parse_format($format,$row);                                  my $fmt = x($config->{format}->{$format_name}->{content}) || die "<format name=\"$format_name\"> is not defined!";
200  #print STDERR "s: $swish\nd: $display\n" if ($swish);                                  my $format_delimiter = x($x->{format_delimiter});
201                                    my @data;
202  #print STDERR "swish: $swish<-- display: $display<--\n";                                  if ($format_delimiter) {
203                                            @data = split(/$format_delimiter/,$data);
                         # filter="name" ; filter this field through  
                         # filter/[name].pm  
                         my $filter;  
                         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));  
204                                  } else {                                  } else {
205                                          $swish_data .= $swish if ($s && $swish);                                          push @data,$data;
206                                  }                                  }
                         }  
207    
208                          # type="display" ; field for display                                  if ($fmt) {
209                          if ($d && $display) {                                          my $nr = scalar $fmt =~ s/%s/%s/g;
210                                  if ($filter) {                                          if (($#data+1) == $nr) {
211                                          $display_data .= join(" ",&filter($display));                                                  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 {                                  } else {
217                                          $display_data .= $display if ($s && $display);                                          print STDERR "usage of link '$format_name' without defined format (<link> tag)\n";
218                                  }                                  }
219                          }                          }
220                                            
221                          # type="index" ; insert into index                          # while because of repeatable fields
222                          if ($i && $display) {                          while ($swish || $display) {
223                                  my $index_data = $index_codepage->convert($display) || $display;                                  my $page = $repeat_off;
224                                  if ($filter) {                                  $page_max{$field} = $page if ($iterate_by_page && $page > ($page_max{$field} || 0));
225                                          foreach my $d (&filter($index_data)) {                                  ($swish,$display) = parse_format($type, $format,$row,$repeat_off++,$import2cp);
226                                                  $index->insert($field, $d, $db_dir);                                  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
255                                    # filter/[name].pm
256                                    my $filter = $x->{filter};
257                                    if ($filter && !$cache->{filter_loaded}->{$filter}) {
258                                            require "filter/".$filter.".pm";
259                                            $cache->{filter_loaded}->{$filter}++;
260                                    }
261                                    # type="swish" ; field for swish
262                                    if ($swish) {
263                                            if ($filter && ($s || $se)) {
264                                                    no strict 'refs';
265                                                    my $tmp = join(" ",&$filter($swish)) if ($s || $se);
266                                                    $swish_data .= $tmp if ($s);
267                                                    $swish_exact_data .= $tmp if ($se);
268    
269                                            } else {
270                                                    $swish_data .= $swish if ($s);
271                                                    $swish_exact_data .= $swish if ($se);
272                                            }
273                                    }
274    
275                                    # type="display" ; field for display
276                                    if ($d && $display) {
277                                            if ($line_delimiter && $display_data) {
278                                                    $display_data .= $line_delimiter;
279                                            }
280                                            if ($filter) {
281                                                    no strict 'refs';
282                                                    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 {
288                                                    if ($display_data) {
289                                                            $display_data .= $delimiter.mkformat($x,$display);
290                                                    } else {
291                                                            $display_data = mkformat($x,$display);
292                                                    }
293                                            }
294                                    }
295                                                    
296                                    # type="index" ; insert into index
297                                    if ($i && $display) {
298                                            if ($filter) {
299                                                    no strict 'refs';
300                                                    $display = &$filter($display);
301                                            }
302                                            if ($x->{append} && @index_data) {
303                                                    $index_data[$#index_data].=$display;
304                                            } else {
305                                                    push @index_data, $display;
306                                          }                                          }
                                 } else {  
                                         $index->insert($field, $index_data, $db_dir);  
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  #print STDERR "s_d: $swish_data\nd_d: $display_data\n" if ($swish_data);                          my $delimiter = x($x->{delimiter}) || ' ';
367                  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);  
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 .= $xml_codepage->convert($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) {  
                         my $i = Text::Iconv->new($config->{isis_codepage},'ISO8859-2');  
                         # remove extra spaces  
                         $swish_data =~ s/ +/ /g;  
                         $swish_data =~ s/ +$//g;  
400    
401                          $swish_data = $i->convert($swish_data);                  # save data page-by-page
402                          $xml .= xmlify($field."_swish",unac_string('ISO8859-2',$swish_data));                  foreach my $field (@page_fields) {
403                          #$swish_data = $isis_codepage->convert($swish_data)."##" || $swish_data;                          my $nr_pages = $page_max{$field} || next;
404                          #$xml .= xmlify($field."_swish",unac_string($config->{isis_codepage},$swish_data));  #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) {
 #print STDERR "x: $xml\n";  
479                  $xml .= $add_xml if ($add_xml);                  $xml .= $add_xml if ($add_xml);
480                  return "<xml>\n$xml</xml>\n";                  return "<xml>\n$xml</xml>\n";
481          } else {          } else {
# Line 187  sub isis2xml { Line 485  sub isis2xml {
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');          my $type = lc($cfg -> val($database, 'type')) || die "$database doesn't have 'type' defined";
512          my $type = $cfg -> val($database, 'type');          my $add_xml = $cfg -> val($database, 'xml');    # optional
         my $add_xml = $cfg -> val($database, 'xml');  
513    
514          # read configuration for this type          # create new lookup file
515          $config=XMLin("./import_xml/$type.xml", forcearray => [ 'isis' ], forcecontent => 1);          my $lookup_file = $cfg -> val($database, 'lookup_newfile'); # optional
516          $isis_codepage = Text::Iconv->new($config->{isis_codepage},'UTF8');          if ($lookup_file) {
517          $index_codepage = Text::Iconv->new($config->{isis_codepage},$config->{index_codepage});                  #tie %lhash, 'GDBM_File', $lookup_file, &GDBM_NEWDB, 0644;
518          $xml_codepage = Text::Iconv->new($cfg->val($database,'xml_codepage'),'UTF8');                  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                    $import2cp = Text::Iconv->new($config->{isis_codepage},$codepage);
576                    my $db = OpenIsis::open( $isis_db );
577    
578                    # check if .txt database for OpenIsis is zero length,
579                    # if so, erase it and re-open database
580                    sub check_txt_db {
581                            my $isis_db = shift || die "need isis database name";
582                            my $reopen = 0;
583    
584                            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 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  #       { my $row_id = 4514;                          progress($iR, $end_row);
690  # FIX  
691          for (my $row_id = 1; $row_id <= $max_rowid; $row_id++ ) {  #                       print "row[$iR/$end_row] ";
692                  my $row = OpenIsis::read( $db, $row_id );  #                       foreach (keys %{$row}) {
693                  if ($row && $row->{mfn}) {  #                               print "$_: ",$row->{$_},"\t";
694  #print STDERR "mfn: ",$row->{mfn},"\n";  #                       }
695                          # output current process indicator  #                       print "\n";
696                          my $p = int($row->{mfn} * 100 / $max_rowid);  
697                          if ($p != $last_p) {                          my $swishpath = $database."#".$iR;
698                                  printf STDERR ("%5d / %5d [%-51s] %-2d %% \r",$row->{mfn},$max_rowid,"=" x ($p/2).">", $p ) if (! $opts{q});  
699                                  $last_p = $p;                          next if (! $row);
700                          }  
701                            if (my $xml = data2xml($type_base,$row,$add_xml,$cfg,$database)) {
702                          if (my $xml = isis2xml($row,$add_xml)) {                                  $xml = $cp2utf->convert($xml);
703  #print STDERR "--ret-->$xml\n";                                  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 250  __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.20  
changed lines
  Added in v.181

  ViewVC Help
Powered by ViewVC 1.1.26