--- trunk/all2xml.pl 2004/03/07 22:51:14 234 +++ trunk/all2xml.pl 2005/01/16 18:35:24 632 @@ -1,11 +1,10 @@ #!/usr/bin/perl -w use strict; -use OpenIsis; +use Biblio::Isis; use Getopt::Std; use Data::Dumper; use XML::Simple; -use Text::Unaccent 1.02; # 1.01 won't compile on my platform, use Text::Iconv; use Config::IniFiles; use Encode; @@ -17,6 +16,7 @@ my $config_file = $0; $config_file =~ s/\.pl$/.conf/; +$config_file = $ARGV[0] if ($ARGV[0] && -f $ARGV[0]); die "FATAL: can't find configuration file '$config_file'" if (! -e $config_file); my $config; @@ -139,18 +139,72 @@ } else { print STDERR "WARNING: field '$field' doesn't have 'name' attribute!"; } + if ($field_name) { + $field_name = x($field_name); if (! $last_field_name) { - $last_field_name = x($field_name); + $last_field_name = $field_name; return $last_field_name; } elsif ($field_name ne $last_field_name) { - $last_field_name = x($field_name); + $last_field_name = $field_name; return $last_field_name; } } } + # init variables for different types + sub init_visible_type($) { + my $type = shift; + + # swish, swish_exact, display, index, index_lookup + # swish and display defaults + my ($s,$se,$d,$i,$il) = (1,0,1,0,0); + if (lc($type) eq "display") { + $s = 0; + } elsif (lc($type) eq "swish") { + $d = 0; + } elsif (lc($type) eq "index") { + ($s,$se,$d,$i) = (0,1,0,1); + } elsif (lc($type) eq "swish_exact") { + ($s,$se,$d,$i) = (0,1,0,0); + } elsif (lc($type) =~ /^lookup/) { + ($s,$se,$d,$i,$il) = (0,1,0,0,1); + } elsif ($type) { + print STDERR "WARNING: unknown type: $type\n"; + } + return ($s,$se,$d,$i,$il); + } + + + # convert + # + # + # , + # 200a + # + # + # to + # + # 200a + # + # but without loosing spaces in delimiter (becasue + # new XML::Simple strips spaces in attribute values + # as defined in XML specification) + # + sub unroll_x($) { + my $x = shift; + + if (defined $x->{value}) { + my ($v,$d) = ($x->{value}->{content}, $x->{delimiter}->{content}); + delete $x->{value}; + delete $x->{delimiter}; + $x->{content} = $v; + $x->{delimiter} = $d; + } + return $x; + } + # begin real work: go field by field foreach my $field (@sorted_tags) { @@ -184,23 +238,18 @@ foreach my $x (@{$config->{indexer}->{$field}->{$tag}}) { + $x = unroll_x($x); + my $format = x($x->{content}); my $delimiter = x($x->{delimiter}) || ' '; my $repeat_off = 0; # init repeatable offset - # swish, swish_exact, display, index, index_lookup - # swish and display defaults - my ($s,$se,$d,$i,$il) = (1,0,1,0,0); - $s = 0 if (lc($x->{type}) eq "display"); - $d = 0 if (lc($x->{type}) eq "swish"); - ($s,$se,$d,$i) = (0,1,0,1) if (lc($x->{type}) eq "index"); - ($s,$se,$d,$i) = (0,1,0,0) if (lc($x->{type}) eq "swish_exact"); - ($s,$se,$d,$i,$il) = (0,1,0,0,1) if (lc($x->{type}) =~ /^lookup/); + my ($s,$se,$d,$i,$il) = init_visible_type($x->{type}); # what will separate last line from this one? if ($display_data && $x->{append}) { - $line_delimiter = ' '; + $line_delimiter = $delimiter; } elsif ($display_data) { $line_delimiter = '
'; } @@ -210,23 +259,10 @@ # placeholder for all repeatable entries for index - sub chk_eval($) { - my $data = shift || return; - if ($data =~ s/eval{([^}]+)}//) { - if (eval "$1") { - return $data; - } else { - return undef; - } - } else { - return $data; - } - } - sub mkformat($$) { my $x = shift || die "mkformat needs tag reference"; my $data = shift || return; - my $format_name = x($x->{format_name}) || return chk_eval($data); + my $format_name = x($x->{format_name}) || return $data; my $fmt = x($config->{format}->{$format_name}->{content}) || die " is not defined!"; my $format_delimiter = x($x->{format_delimiter}); my @data; @@ -239,10 +275,10 @@ if ($fmt) { my $nr = scalar $fmt =~ s/%s/%s/g; if (($#data+1) == $nr) { - return chk_eval(sprintf($fmt,@data)); + return sprintf($fmt,@data); } else { #print STDERR "mkformat: [$data] can't be split on [$format_delimiter] to $nr fields!\n"; - return chk_eval($data); + return $data; } } else { print STDERR "usage of link '$format_name' without defined format ( tag)\n"; @@ -270,7 +306,7 @@ $display = $new_display; $cache->{lhash}->{$display} = $new_display; } else { - print STDERR "WARNING: lookup for '$display' didn't find anything.\n"; +# print STDERR "WARNING: lookup for '$display' didn't find anything.\n"; $display = ""; $cache->{lhash}->{$display} = $null; } @@ -291,17 +327,14 @@ } # type="swish" ; field for swish if ($swish) { - my $tmp; + my $tmp = $swish; if ($filter && ($s || $se)) { no strict 'refs'; - my $tmp = join(" ",&$filter($swish)) if ($s || $se); - } else { - $tmp = $swish; + $tmp = join(" ",&$filter($tmp)) if ($s || $se); } - $tmp = chk_eval($tmp); - $swish_data .= $tmp if ($s); - $swish_exact_data .= "xxbxx $tmp xxexx " if ($se && $tmp ne ""); + $swish_data .= $tmp if ($s && $tmp); + $swish_exact_data .= "xxbxx $tmp xxexx " if ($tmp && $tmp ne "" && $se); } # type="display" ; field for display @@ -334,7 +367,7 @@ no strict 'refs'; $idisplay = &$filter($idisplay); } - push @index_data, $idisplay if (! $iterate_by_page); + push @index_data, $idisplay if ($idisplay && !$iterate_by_page); } # store fields in lookup @@ -433,19 +466,17 @@ # now try to parse variables from configuration file foreach my $x (@{$config->{indexer}->{$field}->{'config'}}) { + $x = unroll_x($x); + my $delimiter = x($x->{delimiter}) || ' '; my $val = $cfg->val($database, x($x->{content})); - my ($s,$d,$i) = (1,1,0); # swish, display default - $s = 0 if (lc($x->{type}) eq "display"); - $d = 0 if (lc($x->{type}) eq "swish"); - # no support for swish exact in config. - # IMHO, it's useless - ($s,$d,$i) = (0,0,1) if (lc($x->{type}) eq "index"); + # FIXME index_lookup is not supported! + my ($s,$se,$d,$i,$il) = init_visible_type($x->{type}); if ($val) { $display_data .= $delimiter.$val if ($d); - $swish_data .= $val if ($s); + $swish_data .= " ".$val if ($s); $index->insert($field, $val, $path) if ($i); } @@ -498,7 +529,7 @@ $swish_data =~ s/ +/ /g; $swish_data =~ s/ +$//g; - $xml .= xmlify($field."_swish", unac_string($codepage,$swish_data)); + $xml .= xmlify($field."_swish", my_unac_string($codepage,$swish_data)); } my $swish_exact_data = $cache->{swish_exact_data}->{$field}->[$page]; @@ -508,7 +539,7 @@ # add delimiters before and after word. # That is required to produce exact match - $xml .= xmlify($field."_swish_exact", unac_string($codepage,$swish_exact_data)); + $xml .= xmlify($field."_swish_exact", my_unac_string($codepage,$swish_exact_data)); } my $idel = $cache->{index_delimiter}->{$field}; @@ -541,7 +572,7 @@ $swish_data =~ s/ +/ /g; $swish_data =~ s/ +$//g; - $xml .= xmlify($field."_swish", unac_string($codepage,$swish_data)); + $xml .= xmlify($field."_swish", my_unac_string($codepage,$swish_data)); } if ($swish_exact_data) { @@ -550,7 +581,7 @@ # add delimiters before and after word. # That is required to produce exact match - $xml .= xmlify($field."_swish_exact", unac_string($codepage,$swish_exact_data)); + $xml .= xmlify($field."_swish_exact", my_unac_string($codepage,$swish_exact_data)); } } } @@ -587,9 +618,18 @@ my $show_progress = $cfg_global->val('global', 'show_progress'); -my $unac_filter = $cfg_global->val('global', 'unac_filter'); -if ($unac_filter) { - require $unac_filter; +my $my_unac_filter = $cfg_global->val('global', 'my_unac_filter'); +if ($my_unac_filter) { + print STDERR "using $my_unac_filter to filter characters for search\n"; + require $my_unac_filter; +} else { + print STDERR "### fallback to default my_unac_string!\n"; + eval q{ + sub main::my_unac_string($$) { + my ($charset, $string) = (@_); + return $string; + } + }; } foreach my $database ($cfg->Sections) { @@ -601,6 +641,10 @@ my $lookup_file = $cfg -> val($database, 'lookup_newfile'); # optional if ($lookup_file) { #tie %lhash, 'GDBM_File', $lookup_file, &GDBM_NEWDB, 0644; + if (! -e $lookup_file) { + open(LOOKUP, "> $lookup_file") || die "can't create $lookup_file': $!"; + close(LOOKUP); + } tie %lhash, 'TDB_File', $lookup_file, TDB_CLEAR_IF_FIRST, O_RDWR, 0644; print STDERR "creating lookup file '$lookup_file'\n"; # delete memory cache for lookup file @@ -621,32 +665,64 @@ my $type_base = $type; $type_base =~ s/_.+$//g; - $config=XMLin("./import_xml/$type.xml", forcearray => [ $type2tag{$type_base}, 'config', 'format' ], forcecontent => 1); + $config=XMLin("./import_xml/$type.xml", ForceArray => [ $type2tag{$type_base}, 'config', 'format' ], ForceContent => 1 ); + + # helper for progress bar + sub fmt_time { + my $t = shift || 0; + my $out = ""; + + my ($ss,$mm,$hh) = gmtime($t); + $out .= "${hh}h" if ($hh); + $out .= sprintf("%02d:%02d", $mm,$ss); + $out .= " " if ($hh == 0); + return $out; + } # output current progress indicator my $last_p = 0; + my $start_t = time(); sub progress { return if (! $show_progress); my $current = shift; my $total = shift || 1; my $p = int($current * 100 / $total); - if ($p != $last_p) { - printf STDERR ("%5d / %5d [%-51s] %-2d %% \r",$current,$total,"=" x ($p/2).">", $p ); + if ($p < $last_p || $current == 1) { + $start_t = time(); + $last_p = 0; + } elsif ($p != $last_p) { + my $rate = ($current / (time() - $start_t || 1)); + my $eta = ($total-$current) / ($rate || 1); + printf STDERR ("%5d [%-38s] %-5d %0.1f/s %s\r",$current,"=" x ($p/3)."$p%>", $total, $rate, fmt_time($eta)); $last_p = $p; } } my $fake_dir = 1; + my $fake_pos = 0; + my $last_fake_t = time(); sub fakeprogress { return if (! $show_progress); my $current = shift @_; - my @ind = ('-','\\','|','/','-','\\','|','/', '-'); + my @ind = ('-','\\','|','/','-','\\','|','/'); + + if ($current < $fake_pos) { + $start_t = time(); + $last_fake_t = 0; + $fake_dir = 1; + $fake_pos = 0; + } + + if (time()-$last_fake_t >= 1) { + $last_fake_t = time(); + $fake_pos += $fake_dir; + $fake_dir = -$fake_dir if ($fake_pos > 38); + } - $last_p += $fake_dir; - $fake_dir = -$fake_dir if ($last_p > 1000 || $last_p < 0); - if ($last_p % 10 == 0) { - printf STDERR ("%5d / %5s [%-51s]\r",$current,"?"," " x ($last_p/20).$ind[($last_p/20) % $#ind]); + if ($current % 10 == 0) { + my $rate = ($current / (time() - $start_t || 1)); + printf STDERR ("%5d [%-38s] %0.1f/s\r",$current, " " x $fake_pos .$ind[($current / 10) % 8], $rate); } } @@ -661,66 +737,21 @@ my $isis_db = $cfg -> val($database, 'isis_db') || die "$database doesn't have 'isis_db' defined!"; $import2cp = Text::Iconv->new($config->{isis_codepage},$codepage); - my $db = OpenIsis::open( $isis_db ); - - # check if .txt database for OpenIsis is zero length, - # if so, erase it and re-open database - sub check_txt_db { - my $isis_db = shift || die "need isis database name"; - my $reopen = 0; - - if (-e $isis_db.".TXT") { - print STDERR "WARNING: removing $isis_db.TXT OpenIsis database...\n"; - unlink $isis_db.".TXT" || warn "FATAL: unlink error on '$isis_db.TXT': $!"; - $reopen++; - } - if (-e $isis_db.".PTR") { - print STDERR "WARNING: removing $isis_db.PTR OpenIsis database...\n"; - unlink $isis_db.".PTR" || warn "FATAL: unlink error on '$isis_db.PTR': $!"; - $reopen++; - } - return OpenIsis::open( $isis_db ) if ($reopen); - } - - # EOF error - if ($db == -1) { - $db = check_txt_db($isis_db); - if ($db == -1) { - print STDERR "FATAL: OpenIsis can't open zero size file $isis_db\n"; - next; - } - } + my $db = new Biblio::Isis( isisdb => $isis_db ); - # OpenIsis::ERR_BADF - if ($db == -4) { - print STDERR "FATAL: OpenIsis can't find file $isis_db\n"; - next; - # OpenIsis::ERR_IO - } elsif ($db == -5) { - print STDERR "FATAL: OpenIsis can't access file $isis_db\n"; - next; - } elsif ($db < 0) { - print STDERR "FATAL: OpenIsis unknown error $db with file $isis_db\n"; - next; - } - - my $max_rowid = OpenIsis::maxRowid( $db ); - - # if 0 records, try to rease isis .txt database - if ($max_rowid == 0) { - # force removal of database - $db = check_txt_db($isis_db); - $max_rowid = OpenIsis::maxRowid( $db ); - } + my $max_rowid = $db->count || die "can't find maxmfn"; print STDERR "Reading database: $isis_db [$max_rowid rows]\n"; my $path = $database; for (my $row_id = 1; $row_id <= $max_rowid; $row_id++ ) { - my $row = OpenIsis::read( $db, $row_id ); - if ($row && $row->{mfn}) { - + my $row = $db->to_hash( $row_id ); + if ($row) { + + $row->{mfn} = $row_id; + $row->{record} = $db->{record}; + progress($row->{mfn}, $max_rowid); my $swishpath = $path."#".int($row->{mfn}); @@ -734,15 +765,12 @@ } } } - # for this to work with current version of OpenIsis (0.9.0) - # you might need my patch from - # http://www.rot13.org/~dpavlin/projects/openisis-0.9.0-perl_close.diff - OpenIsis::close($db); print STDERR "\n"; } elsif ($type_base eq "excel") { - use Spreadsheet::ParseExcel; - use Spreadsheet::ParseExcel::Utility qw(int2col); + require Spreadsheet::ParseExcel; + require Spreadsheet::ParseExcel::Utility; + import Spreadsheet::ParseExcel::Utility qw(int2col); $import2cp = Text::Iconv->new($config->{excel_codepage},$codepage); my $excel_file = $cfg -> val($database, 'excel_file') || die "$database doesn't have 'excel_file' defined!"; @@ -770,7 +798,11 @@ for(my $iC = $oWorksheet->{MinCol} ; defined $oWorksheet->{MaxCol} && $iC <= $oWorksheet->{MaxCol} ; $iC++) { my $cell = $oWorksheet->{Cells}[$iR][$iC]; if ($cell) { - $row->{int2col($iC)} = $cell->Value; + # this conversion is a cludge. + # Files from Excell could have + # characters which don't fit into + # destination encoding. + $row->{int2col($iC)} = $utf2cp->convert($cell->Value) || $cell->Value; } } @@ -796,36 +828,40 @@ } } elsif ($type_base eq "marc") { - use MARC; + require MARC::File::USMARC; $import2cp = Text::Iconv->new($config->{marc_codepage},$codepage); my $marc_file = $cfg -> val($database, 'marc_file') || die "$database doesn't have 'marc_file' defined!"; # optional argument is format - my $format = x($config->{marc_format}) || 'usmarc'; - + warn "marc_format is no longer used!" if ($config->{marc_format}); print STDERR "Reading MARC file '$marc_file'\n"; - my $marc = new MARC; - my $nr = $marc->openmarc({ - file=>$marc_file, format=>$format - }) || die "Can't open MARC file '$marc_file' with format '$format'"; + my $marc = MARC::File::USMARC->in( $marc_file ) + || die "Can't open MARC file '$marc_file': ".$MARC::File::ERROR; - # read MARC file in memory - $marc->nextmarc(-1); + # count records in MARC file + sub marc_count { + my $filename = shift || die; + my $file = MARC::File::USMARC->in($filename) || die $MARC::File::ERROR; + my $count = 0; + while ($file->skip()) { + $count++; + } + return $count; + } - my $max_rec = $marc->marc_count(); + my $count = marc_count($marc_file) || warn "no records in '$marc_file'?"; - for(my $i=1; $i<=$max_rec; $i++) { + my $i = 0; - progress($i,$max_rec); + while( my $rec = $marc->next() ) { - # store value for marc_sf.pm - $main::cache->{marc_record} = $i; + progress($i++,$count); my $swishpath = $database."#".$i; - if (my $xml = data2xml($type_base,$marc,$add_xml,$cfg,$database)) { + if (my $xml = data2xml($type_base,$rec,$add_xml,$cfg,$database)) { $xml = $cp2utf->convert($xml); use bytes; # as opposed to chars print "Path-Name: $swishpath\n"; @@ -890,14 +926,21 @@ all2xml.pl - read various file formats and dump XML for SWISH-E +=head1 SYNOPSYS + + $ all2xml.pl [test.conf] + =head1 DESCRIPTION -This command will read ISIS data file using OpenIsis perl module, MARC +This command will read ISIS data file using IsisDB perl module, MARC records using MARC module and optionally Micro$oft Excel files to create one XML file for usage with I indexer. Dispite it's name, this script B from isis files (isis allready has something like that). Output of this script is tailor-made for SWISH-E. +If no configuration file is specified, it will use default one called +C. + =head1 BUGS Documentation is really lacking. However, in true Open Source spirit, source