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

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

  ViewVC Help
Powered by ViewVC 1.1.26