/[webpac]/branches/drustvene/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 /branches/drustvene/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 177 by dpavlin, Mon Nov 24 01:19:15 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    # decode isis/excel or other import codepage
53    my $import2cp;
54    
55  #die "usage: $0 -d [database_dir] -m [database1,database2] " if (! %opts);  # outgoing xml must be in UTF-8
56    my $cp2utf = Text::Iconv->new($codepage,'UTF-8');
57    
58  #print Dumper($config->{indexer});  # mapping between data type and tag which specify
59  #print "-" x 70,"\n";  # 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  # how to convert isis code page to UTF8?  sub data2xml {
 my $isis_map = Unicode::Map8->new($config->{isis_codepage}) || die;  
76    
77  sub isis2xml {          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          foreach my $field (keys %{$config->{indexer}}) {          my @sorted_tags;
105            if ($cache->{tags_by_order}->{$type}) {
106                    @sorted_tags = @{$cache->{tags_by_order}->{$type}};
107            } else {
108                    @sorted_tags = sort by_order keys %{$config->{indexer}};
109                    $cache->{tags_by_order}->{$type} = \@sorted_tags;
110            }
111    
112            # lookup key
113            my $lookup_key;
114    
115            foreach my $field (@sorted_tags) {
116    
117                    $field=x($field);
118                    $field_usage{$field}++;
119    
                 my $display_data = "";  
120                  my $swish_data = "";                  my $swish_data = "";
121                  my $index_data = "";                  my $swish_exact_data = "";
122                    my $display_data = "";
123                    my $line_delimiter;
124    
125                    my ($swish,$display);
126    
127                  foreach my $x (@{$config->{indexer}->{$field}->{isis}}) {                  my $tag = $type2tag{$type} || die "can't find which tag to use for type $type";
128                    foreach my $x (@{$config->{indexer}->{$field}->{$tag}}) {
129    
130                          my $display_tmp = "";                          my $format = x($x->{content});
131                          my $swish_tmp = "";                          my $delimiter = x($x->{delimiter}) || ' ';
132                          my $index_tmp = "";  
133                            my $repeat_off = 0;             # repeatable offset
134                          my $format = $x->{content};  
135                          my $s = 1;      # swish only                          # swish, swish_exact, display, index, index_lookup
136                          my $d = 1;      # display only                          # swish and display defaults
137                          my $i = 0;      # index only                          my ($s,$se,$d,$i,$il) = (1,0,1,0,0);
138                          $s = 0 if (lc($x->{type}) eq "display");                          $s = 0 if (lc($x->{type}) eq "display");
139                          $d = 0 if (lc($x->{type}) eq "swish");                          $d = 0 if (lc($x->{type}) eq "swish");
140                            $se = 1 if (lc($x->{type}) eq "swish_exact");
141                          ($s,$d,$i) = (0,0,1) if (lc($x->{type}) eq "index");                          ($s,$d,$i) = (0,0,1) if (lc($x->{type}) eq "index");
142  #print STDERR "## s: $s d: $d i: $i ## $format ##\n";                            $il = 1 if (lc($x->{type}) =~ /^lookup/);
143                          # parse format  
144                          my $prefix = "";  
145                          if ($format =~ s/^([^\d]+)//) {                          # what will separate last line from this one?
146                                  $prefix = $1;                          if ($display_data && $x->{append} && $x->{append} eq "1") {
147                          }                                  $line_delimiter = ' ';
148                          while ($format) {                          } elsif ($display_data) {
149                                  if ($format =~ s/^(\d\d\d)(\w?)//) {                                  $line_delimiter = '<br/>';
150                                          my $isis_tmp = isis_sf($row,$1,$2);                          }
151                                          if ($isis_tmp) {  
152  #                                               $display_tmp .= $prefix . "/$1/$2/".$isis_tmp if ($d);                          # init vars so that we go into while...
153                                                  $display_tmp .= $prefix . $isis_tmp if ($d);                          ($swish,$display) = (1,1);
154                                                  $swish_tmp .= $isis_tmp." " if ($s);  
155                                                  $index_tmp .= $prefix . $isis_tmp if ($i);                          # placeholder for all repeatable entries for index
156  #print STDERR " $isis_tmp <--\n";                          my @index_data;
157                                          }  
158                                          $prefix = "";                          sub mkformat {
159                                  } elsif ($format =~ s/^([^\d]+)//) {                                  my $x = shift || die "mkformat needs tag reference";
160                                          $prefix = $1;                                  my $data = shift || return;
161                                    my $format_name = x($x->{format_name}) || return $data;
162                                    my $fmt = x($config->{format}->{$format_name}->{content}) || die "<format name=\"$format_name\"> is not defined!";
163                                    my $format_delimiter = x($x->{format_delimiter});
164                                    my @data;
165                                    if ($format_delimiter) {
166                                            @data = split(/$format_delimiter/,$data);
167                                    } else {
168                                            push @data,$data;
169                                    }
170    
171                                    if ($fmt) {
172                                            my $nr = scalar $fmt =~ s/%s/%s/g;
173                                            if (($#data+1) == $nr) {
174                                                    return sprintf($fmt,@data);
175                                            } else {
176                                                    print STDERR "mkformat: [$data] can't be split on [$format_delimiter] to $nr fields!\n";
177                                                    return $data;
178                                            }
179                                  } else {                                  } else {
180                                          print STDERR "WARNING: unparsed format '$format'\n";                                          print STDERR "usage of link '$format_name' without defined format (<link> tag)\n";
181                                    }
182                            }
183    
184                            # while because of repeatable fields
185                            while ($swish || $display) {
186                                    ($swish,$display) = parse_format($type, $format,$row,$repeat_off++,$import2cp);
187                                    if ($repeat_off > 1000) {
188                                            print STDERR "loop (more than 1000 repeatable fields) deteced in $row, $format\n";
189                                          last;                                          last;
190                                  };                                  }
191    
192                                    # is this field is lookup?
193                                    if ($display && $x->{lookup}) {
194                                            if ($use_lhash_cache) {
195                                                    if (!defined($cache->{lhash}->{$display})) {
196                                                            my $new_display = $lhash{$display};
197                                                            if ($new_display) {
198    #print STDERR "lookup cache store '$display' = '$new_display'\n";
199                                                                    $display = $new_display;
200                                                                    $cache->{lhash}->{$display} = $new_display;
201                                                            } else {
202                                                                    print STDERR "WARNING: lookup for '$display' didn't find anything.\n";
203                                                                    $display = "";
204                                                                    $cache->{lhash}->{$display} = "";
205                                                            }
206                                                    } else {
207                                                            $display = $cache->{lhash}->{$display};
208                                                    }
209                                            } else {
210                                                    $display = $lhash{$display} || "";
211                                            }
212                                    }
213    
214                                    # filter="name" ; filter this field through
215                                    # filter/[name].pm
216                                    my $filter = $x->{filter};
217                                    if ($filter && !$cache->{filter_loaded}->{$filter}) {
218                                            require "filter/".$filter.".pm";
219                                            $cache->{filter_loaded}->{$filter}++;
220                                    }
221                                    # type="swish" ; field for swish
222                                    if ($swish) {
223                                            if ($filter && ($s || $se)) {
224                                                    no strict 'refs';
225                                                    my $tmp = join(" ",&$filter($swish)) if ($s || $se);
226                                                    $swish_data .= $tmp if ($s);
227                                                    $swish_exact_data .= $tmp if ($se);
228    
229                                            } else {
230                                                    $swish_data .= $swish if ($s);
231                                                    $swish_exact_data .= $swish if ($se);
232                                            }
233                                    }
234    
235                                    # type="display" ; field for display
236                                    if ($d && $display) {
237                                            if ($line_delimiter && $display_data) {
238                                                    $display_data .= $line_delimiter;
239                                                    undef $line_delimiter;
240                                            }
241                                            if ($filter) {
242                                                    no strict 'refs';
243                                                    if ($display_data) {
244                                                            $display_data .= $delimiter.join($delimiter,mkformat($x,&$filter($display)));
245                                                    } else {
246                                                            $display_data = join($delimiter,mkformat($x,&$filter($display)));
247                                                    }
248                                            } else {
249                                                    if ($display_data) {
250                                                            $display_data .= $delimiter.mkformat($x,$display);
251                                                    } else {
252                                                            $display_data = mkformat($x,$display);
253                                                    }
254                                            }
255                                    }
256                                                    
257                                    # type="index" ; insert into index
258                                    if ($i && $display) {
259                                            if ($filter) {
260                                                    no strict 'refs';
261                                                    $display = &$filter($display);
262                                            }
263                                            if ($x->{append} && @index_data) {
264                                                    $index_data[$#index_data].=$display;
265                                            } else {
266                                                    push @index_data, $display;
267                                            }
268                                    }
269    
270                                    # store fields in lookup
271                                    if ($il && $display) {
272                                            if (lc($x->{type}) eq "lookup_key") {
273                                                    if ($lookup_key) {
274                                                            print STDERR "WARNING: try to redefine lookup_key (keys shouldn't be repeatable fields!)";
275                                                    } else {
276                                                            $lookup_key = $display;
277                                                    }
278                                            } elsif (lc($x->{type}) eq "lookup_val") {
279                                                    if ($lookup_key) {
280                                                            $lhash{$lookup_key} = $display;
281                                                    } else {
282                                                            print STDERR "WARNING: no lookup_key defined for  '$display'?";
283                                                    }
284                                            }
285                                    }
286                            }
287    
288                            # fill data in index
289                            foreach my $d (@index_data) {
290                                    $index->insert($field, $d, $path);
291                          }                          }
292                          # add suffix                  }
293                          $display_tmp .= $prefix if ($display_tmp);  
294                          $index_tmp .= $prefix if ($index_tmp);                  # now try to parse variables from configuration file
295                    foreach my $x (@{$config->{indexer}->{$field}->{'config'}}) {
296  #                       $display_data .= $display_tmp if ($display_tmp ne "");  
297  #                       $swish_data .= $swish_tmp if ($swish_tmp ne "");                          my $delimiter = x($x->{delimiter}) || ' ';
298                          $display_data .= $display_tmp;                          my $val = $cfg->val($database, x($x->{content}));
299                          $swish_data .= $swish_tmp;  
300                          $index_data .= $index_tmp;                          my ($s,$d,$i) = (1,1,0);        # swish, display default
301                            $s = 0 if (lc($x->{type}) eq "display");
302                  }                          $d = 0 if (lc($x->{type}) eq "swish");
303  #print "--display:$display_data\n--swish:$swish_data\n";                          # no support for swish exact in config.
304                  #$xml->{$field."_display"} = $isis_map->tou($display_data)->utf8 if ($display_data);                          # IMHO, it's useless
305                  #$xml->{$field."_swish"} = unac_string($config->{isis_codepage},$swish_data) if ($swish_data);                          ($s,$d,$i) = (0,0,1) if (lc($x->{type}) eq "index");
306                  $xml->{$field."_display" } = [ $isis_map->tou($display_data)->utf8 ] if ($display_data);  
307                  $xml->{$field."_swish"} = [ unac_string($config->{isis_codepage},$swish_data) ] if ($swish_data);                          if ($val) {
308                                    $display_data .= $delimiter.$val if ($d);
309                  # index                                  $swish_data .= $val if ($s);
310                  if ($index_data && $index_data ne "") {                                  $index->insert($field, $val, $path) if ($i);
311                          my $sql = "select $field from index_$field where upper($field)=upper(?)";                          }
312                          my $sth = $dbh->prepare($sql) || die $dbh->errstr();  
313                          $sth->execute($index_data) || die "SQL: $sql; ".$dbh->errstr();                  }
314  #print STDERR "--->$index_data<---\n";  
315                          if (! $sth->fetchrow_hashref) {  
316                                  my $sql = "insert into index_$field values (?)";                  if ($display_data) {
317                                  my $sth = $dbh->prepare($sql) || die $dbh->errstr();  
318  #print STDERR "$sql: $index_data<!----\n";                          if ($field eq "headline") {
319                                  $sth->execute($index_data) || die "SQL: $sql; ".$dbh->errstr();                                  $xml .= xmlify("headline", $display_data);
320                            } else {
321    
322                                    # find field name (signular, plural)
323                                    my $field_name = "";
324                                    if ($config->{indexer}->{$field}->{name_singular} && $field_usage{$field} == 1) {
325                                            $field_name = $config->{indexer}->{$field}->{name_singular}."#-#";
326                                    } elsif ($config->{indexer}->{$field}->{name_plural}) {
327                                            $field_name = $config->{indexer}->{$field}->{name_plural}."#-#";
328                                    } elsif ($config->{indexer}->{$field}->{name}) {
329                                            $field_name = $config->{indexer}->{$field}->{name}."#-#";
330                                    } else {
331                                            print STDERR "WARNING: field '$field' doesn't have 'name' attribute!";
332                                    }
333                                    if ($field_name) {
334                                            $html .= x($field_name);
335                                    }
336                                    $html .= $display_data."###\n";
337                          }                          }
338                  }                  }
339                    if ($swish_data) {
340                            # remove extra spaces
341                            $swish_data =~ s/ +/ /g;
342                            $swish_data =~ s/ +$//g;
343    
344                            $xml .= xmlify($field."_swish", unac_string($codepage,$swish_data));
345                    }
346    
347                    if ($swish_exact_data) {
348                            $swish_exact_data =~ s/ +/ /g;
349                            $swish_exact_data =~ s/ +$//g;
350    
351                            # add delimiters before and after word.
352                            # That is required to produce exact match
353                            $xml .= xmlify($field."_swish_exact", unac_string($codepage,'xxbxx '.$swish_exact_data.' xxexx'));
354                    }
355    
356    
357            }
358    
359            # dump formatted output in <html>
360            if ($html) {
361                    #$xml .= xmlify("html",$html);
362                    $xml .= "<html><![CDATA[ $html ]]></html>";
363          }          }
364            
365          if ($xml) {          if ($xml) {
366                  return XMLout($xml, rootname => 'xml', keeproot => 0, noattr => 0 );                  $xml .= $add_xml if ($add_xml);
367                    return "<xml>\n$xml</xml>\n";
368          } else {          } else {
369                  return;                  return;
370          }          }
# Line 145  sub isis2xml { Line 372  sub isis2xml {
372    
373  ##########################################################################  ##########################################################################
374    
375  my $last_tell=0;  # read configuration for this script
376    my $cfg = new Config::IniFiles( -file => $config_file );
377    
378  my @isis_dirs = ( '.' );        # use dirname as database name  # read global.conf configuration
379    my $cfg_global = new Config::IniFiles( -file => 'global.conf' );
380    
381  if ($opts{m}) {  # open index
382          @isis_dirs = split(/,/,$opts{m});  $index = new index_DBI(
383                    $cfg_global->val('global', 'dbi_dbd'),
384                    $cfg_global->val('global', 'dbi_dsn'),
385                    $cfg_global->val('global', 'dbi_user'),
386                    $cfg_global->val('global', 'dbi_passwd') || '',
387            );
388    
389    my $show_progress = $cfg_global->val('global', 'show_progress');
390    
391    my $unac_filter = $cfg_global->val('global', 'unac_filter');
392    if ($unac_filter) {
393            require $unac_filter;
394  }  }
395    
396  my @isis_dbs;  foreach my $database ($cfg->Sections) {
397    
398            my $type = lc($cfg -> val($database, 'type')) || die "$database doesn't have 'type' defined";
399            my $add_xml = $cfg -> val($database, 'xml');    # optional
400    
401  foreach (@isis_dirs) {          # create new lookup file
402          if (-e $config->{isis_data}."/$db_dir/$_/LIBRI") {          my $lookup_file = $cfg -> val($database, 'lookup_newfile'); # optional
403                  push @isis_dbs,$config->{isis_data}."/$db_dir/$_/LIBRI/LIBRI";          if ($lookup_file) {
404                    #tie %lhash, 'GDBM_File', $lookup_file, &GDBM_NEWDB, 0644;
405                    tie %lhash, 'TDB_File', $lookup_file, TDB_CLEAR_IF_FIRST, O_RDWR, 0644;
406                    print STDERR "creating lookup file '$lookup_file'\n";
407          }          }
408          if (-e $config->{isis_data}."/$db_dir/$_/PERI") {  
409                  push @isis_dbs,$config->{isis_data}."/$db_dir/$_/PERI/PERI";          # open existing lookup file
410            $lookup_file = $cfg -> val($database, 'lookup_open'); # optional
411            if ($lookup_file) {
412                    #tie %lhash, 'GDBM_File', $lookup_file, &GDBM_READER, 0644;
413                    tie %lhash, 'TDB_File', $lookup_file, TDB_DEFAULT, O_RDWR, 0644;
414                    print STDERR "opening lookup file '$lookup_file'\n";
415          }          }
416          if (-e $config->{isis_data}."/$db_dir/$_/AMS") {  
417                  push @isis_dbs,$config->{isis_data}."/$db_dir/$_/AMS/AMS";  print STDERR "reading ./import_xml/$type.xml\n";
418    
419            # extract just type basic
420            my $type_base = $type;
421            $type_base =~ s/_.+$//g;
422    
423            $config=XMLin("./import_xml/$type.xml", forcearray => [ $type2tag{$type_base}, 'config', 'format' ], forcecontent => 1);
424    
425            # output current progress indicator
426            my $last_p = 0;
427            sub progress {
428                    return if (! $show_progress);
429                    my $current = shift;
430                    my $total = shift || 1;
431                    my $p = int($current * 100 / $total);
432                    if ($p != $last_p) {
433                            printf STDERR ("%5d / %5d [%-51s] %-2d %% \r",$current,$total,"=" x ($p/2).">", $p );
434                            $last_p = $p;
435                    }
436          }          }
437          if (-e $config->{isis_data}."/$db_dir/$_/ARTI") {  
438  #               push @isis_dbs,$config->{isis_data}."/$db_dir/$_/ARTI/ARTI";          my $fake_dir = 1;
439            sub fakeprogress {
440                    return if (! $show_progress);
441                    my $current = shift @_;
442    
443                    my @ind = ('-','\\','|','/','-','\\','|','/', '-');
444    
445                    $last_p += $fake_dir;
446                    $fake_dir = -$fake_dir if ($last_p > 1000 || $last_p < 0);
447                    if ($last_p % 10 == 0) {
448                            printf STDERR ("%5d / %5s [%-51s]\r",$current,"?"," " x ($last_p/20).$ind[($last_p/20) % $#ind]);
449                    }
450          }          }
 }  
451    
452  print STDERR "FATAL: Can't find isis database.\nPerhaps isis_data (".$config->{isis_data}.") has wrong value?\n" if (! @isis_dbs);          # now read database
453    print STDERR "using: $type...\n";
454    
455  my $db;          if ($type_base eq "isis") {
456    
457  foreach my $isis_db (@isis_dbs) {                  my $isis_db = $cfg -> val($database, 'isis_db') || die "$database doesn't have 'isis_db' defined!";
458    
459                    $import2cp = Text::Iconv->new($config->{isis_codepage},$codepage);
460                    my $db = OpenIsis::open( $isis_db );
461    
462                    # check if .txt database for OpenIsis is zero length,
463                    # if so, erase it and re-open database
464                    sub check_txt_db {
465                            my $isis_db = shift || die "need isis database name";
466                            my $reopen = 0;
467    
468                            if (-e $isis_db.".TXT") {
469                                    print STDERR "WARNING: removing $isis_db.TXT OpenIsis database...\n";
470                                    unlink $isis_db.".TXT" || warn "FATAL: unlink error on '$isis_db.TXT': $!";
471                                    $reopen++;
472                            }
473                            if (-e $isis_db.".PTR") {
474                                    print STDERR "WARNING: removing $isis_db.PTR OpenIsis database...\n";
475                                    unlink $isis_db.".PTR" || warn "FATAL: unlink error on '$isis_db.PTR': $!";
476                                    $reopen++;
477                            }
478                            return OpenIsis::open( $isis_db ) if ($reopen);
479                    }
480    
481          my $db = OpenIsis::open( $isis_db );                  # EOF error
482          if (0) {                  if ($db == -1) {
483  #       # FIX                          $db = check_txt_db($isis_db);
484  #       if (! $db ) {                          if ($db == -1) {
485                  print STDERR "WARNING: can't open '$isis_db'\n";                                  print STDERR "FATAL: OpenIsis can't open zero size file $isis_db\n";
486                  next ;                                  next;
487          }                          }
488                    }
489    
490          my $max_rowid = OpenIsis::maxRowid( $db );                  # OpenIsis::ERR_BADF
491                    if ($db == -4) {
492                            print STDERR "FATAL: OpenIsis can't find file $isis_db\n";
493                            next;
494                    # OpenIsis::ERR_IO
495                    } elsif ($db == -5) {
496                            print STDERR "FATAL: OpenIsis can't access file $isis_db\n";
497                            next;
498                    } elsif ($db < 0) {
499                            print STDERR "FATAL: OpenIsis unknown error $db with file $isis_db\n";
500                            next;
501                    }
502    
503          print STDERR "Reading database: $isis_db [$max_rowid rows]\n";                  my $max_rowid = OpenIsis::maxRowid( $db );
504    
505          my $last_p = 0;                  # if 0 records, try to rease isis .txt database
506                    if ($max_rowid == 0) {
507                            # force removal of database
508                            $db = check_txt_db($isis_db);
509                            $max_rowid = OpenIsis::maxRowid( $db );
510                    }
511    
512                    print STDERR "Reading database: $isis_db [$max_rowid rows]\n";
513    
514  #       { my $row_id = 1;                  my $path = $database;
515  # FIX  
516          for (my $row_id = 1; $row_id <= $max_rowid; $row_id++ ) {                  for (my $row_id = 1; $row_id <= $max_rowid; $row_id++ ) {
517                  my $row = OpenIsis::read( $db, $row_id );                          my $row = OpenIsis::read( $db, $row_id );
518                  if ($row && $row->{mfn}) {                          if ($row && $row->{mfn}) {
519            
520                          # output current process indicator                                  progress($row->{mfn}, $max_rowid);
521                          my $p = int($row->{mfn} * 100 / $max_rowid);  
522                          if ($p != $last_p) {                                  my $swishpath = $path."#".int($row->{mfn});
523                                  printf STDERR ("%5d / %5d [%-51s] %-2d %% \r",$row->{mfn},$max_rowid,"=" x ($p/2).">", $p ) if (! $opts{q});  
524                                  $last_p = $p;                                  if (my $xml = data2xml($type_base,$row,$add_xml,$cfg,$database)) {
525                          }                                          $xml = $cp2utf->convert($xml);
526                                            use bytes;      # as opposed to chars
527                          if (my $xml = isis2xml($row)) {                                          print "Path-Name: $swishpath\n";
528                                  my $path = $isis_db;                                          print "Content-Length: ".(length($xml)+1)."\n";
529                                  $path =~ s#$config->{isis_data}/*##g;                                          print "Document-Type: XML\n\n$xml\n";
530                                  my $out = "Path-Name: $path#".$row->{mfn}."\n";                                  }
                                 $out .= "Content-Length: ".(length($xml)+1)."\n";  
                                 $out .= "Document-Type: XML\n\n$xml\n";  
                                 print $out;  
531                          }                          }
532                  }                  }
533                    # for this to work with current version of OpenIsis (0.9.0)
534                    # you might need my patch from
535                    # http://www.rot13.org/~dpavlin/projects/openisis-0.9.0-perl_close.diff
536                    OpenIsis::close($db);
537                    print STDERR "\n";
538    
539            } elsif ($type_base eq "excel") {
540                    use Spreadsheet::ParseExcel;
541                    use Spreadsheet::ParseExcel::Utility qw(int2col);
542                    
543                    $import2cp = Text::Iconv->new($config->{excel_codepage},$codepage);
544                    my $excel_file = $cfg -> val($database, 'excel_file') || die "$database doesn't have 'excel_file' defined!";
545    
546                    my $sheet = x($config->{sheet}) || die "no sheet in $type.xml";
547                    my $start_row = x($config->{start_row}) - 1 || die "no start_row in $type.xml";
548    
549                    my $oBook = Spreadsheet::ParseExcel::Workbook->Parse($excel_file) || die "can't open Excel file '$excel_file'";
550    
551                    my $sheet_nr = 0;
552                    foreach my $oWks (@{$oBook->{Worksheet}}) {
553                            #print STDERR "-- SHEET $sheet_nr:", $oWks->{Name}, "\n";
554                            last if ($oWks->{Name} eq $sheet);
555                            $sheet_nr++;
556                    }
557    
558                    my $oWorksheet = $oBook->{Worksheet}[$sheet_nr];
559            
560                    print STDERR "using sheet: ",$oWorksheet->{Name},"\n";
561                    defined ($oWorksheet) || die "can't find sheet '$sheet' in $excel_file";
562                    my $end_row = x($config->{end_row}) || $oWorksheet->{MaxRow};
563    
564                    for(my $iR = $start_row ; defined $end_row && $iR <= $end_row ; $iR++) {
565                            my $row;
566                            for(my $iC = $oWorksheet->{MinCol} ; defined $oWorksheet->{MaxCol} && $iC <= $oWorksheet->{MaxCol} ; $iC++) {
567                                    my $cell = $oWorksheet->{Cells}[$iR][$iC];
568                                    if ($cell) {
569                                            $row->{int2col($iC)} = $cell->Value;
570                                    }
571                            }
572    
573                            progress($iR, $end_row);
574    
575    #                       print "row[$iR/$end_row] ";
576    #                       foreach (keys %{$row}) {
577    #                               print "$_: ",$row->{$_},"\t";
578    #                       }
579    #                       print "\n";
580    
581                            my $swishpath = $database."#".$iR;
582    
583                            next if (! $row);
584    
585                            if (my $xml = data2xml($type_base,$row,$add_xml,$cfg,$database)) {
586                                    $xml = $cp2utf->convert($xml);
587                                    use bytes;      # as opposed to chars
588                                    print "Path-Name: $swishpath\n";
589                                    print "Content-Length: ".(length($xml)+1)."\n";
590                                    print "Document-Type: XML\n\n$xml\n";
591                            }
592                    }
593            } elsif ($type_base eq "marc") {
594    
595                    use MARC;
596                    
597                    $import2cp = Text::Iconv->new($config->{marc_codepage},$codepage);
598                    my $marc_file = $cfg -> val($database, 'marc_file') || die "$database doesn't have 'marc_file' defined!";
599    
600                    # optional argument is format
601                    my $format = x($config->{format}) || 'usmarc';
602    
603                    print STDERR "Reading MARC file '$marc_file'\n";
604    
605                    my $marc = new MARC;
606                    my $nr = $marc->openmarc({
607                                    file=>$marc_file, format=>$format
608                            }) || die "Can't open MARC file '$marc_file'";
609    
610                    my $i=0;        # record nr.
611    
612                    my $rec;
613    
614                    while ($marc->nextmarc(1)) {
615    
616                            # XXX
617                            fakeprogress($i++);
618    
619                            my $swishpath = $database."#".$i;
620    
621                            if (my $xml = data2xml($type_base,$marc,$add_xml,$cfg,$database)) {
622                                    $xml = $cp2utf->convert($xml);
623                                    use bytes;      # as opposed to chars
624                                    print "Path-Name: $swishpath\n";
625                                    print "Content-Length: ".(length($xml)+1)."\n";
626                                    print "Document-Type: XML\n\n$xml\n";
627                            }
628                    }
629            } elsif ($type_base eq "feed") {
630    
631                    $import2cp = Text::Iconv->new($config->{feed_codepage},$codepage);
632                    my $prog = x($config->{prog}) || die "$database doesn't have 'prog' defined!";
633    
634                    print STDERR "Reading feed from program '$prog'\n";
635    
636                    open(FEED,"feeds/$prog |") || die "can't start $prog: $!";
637    
638                    my $i=1;        # record nr.
639    
640                    my $data;
641                    my $line=1;
642    
643                    while (<FEED>) {
644                            chomp;
645    
646                            if (/^$/) {
647                                    my $swishpath = $database."#".$i++;
648    
649                                    if (my $xml = data2xml($type_base,$data,$add_xml,$cfg,$database)) {
650                                            $xml = $cp2utf->convert($xml);
651                                            use bytes;      # as opposed to chars
652                                            print "Path-Name: $swishpath\n";
653                                            print "Content-Length: ".(length($xml)+1)."\n";
654                                            print "Document-Type: XML\n\n$xml\n";
655                                    }
656                                    $line = 1;
657                                    $data = {};
658                                    next;
659                            }
660    
661                            $line = $1 if (s/^(\d+):\s*//);
662                            $data->{$line++} = $_;
663    
664                            fakeprogress($i);
665    
666                    }
667                    # close lookup
668                    untie %lhash if (%lhash);
669          }          }
         print STDERR "\n";  
670  }  }
671    
672  $dbh->commit || die $dbh->errstr();  # call this to commit index
673    $index->close;
674    
675  1;  1;
676  __END__  __END__
# Line 225  __END__ Line 678  __END__
678    
679  =head1 NAME  =head1 NAME
680    
681  isis2xml.pl - read isis file and dump XML  all2xml.pl - read various file formats and dump XML for SWISH-E
682    
683  =head1 DESCRIPTION  =head1 DESCRIPTION
684    
685  This command will read ISIS data file using OpenIsis perl module and  This command will read ISIS data file using OpenIsis perl module, MARC
686  create XML file for usage with I<SWISH-E>  records using MARC module and optionally Micro$oft Excel files to
687  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,
688  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
689  script is tailor-made for SWISH-E.  has something like that). Output of this script is tailor-made for SWISH-E.
690    
691    =head1 BUGS
692    
693    Documentation is really lacking. However, in true Open Source spirit, source
694    is best documentation. I even made considerable effort to comment parts
695    which are not intuitively clear, so...
696    
697  =head1 AUTHOR  =head1 AUTHOR
698    

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

  ViewVC Help
Powered by ViewVC 1.1.26