--- branches/tehnika/all2xml.pl 2004/03/14 19:44:57 286 +++ branches/tehnika/all2xml.pl 2005/01/27 21:17:47 652 @@ -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,12 +16,14 @@ 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; #use index_DBI; # default DBI module for index -use index_DBI_cache; # faster DBI module using memory cache +#use index_DBI_cache; # faster DBI module using memory cache +use index_DBI_filter; # filter support for indexes my $index; my %opts; @@ -139,12 +140,14 @@ } 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; } } @@ -168,6 +171,8 @@ ($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); } @@ -245,7 +250,7 @@ # what will separate last line from this one? if ($display_data && $x->{append}) { - $line_delimiter = ' '; + $line_delimiter = $delimiter; } elsif ($display_data) { $line_delimiter = '
'; } @@ -253,8 +258,6 @@ # init vars so that we go into while... ($swish,$display) = (1,1); - # placeholder for all repeatable entries for index - sub mkformat($$) { my $x = shift || die "mkformat needs tag reference"; my $data = shift || return; @@ -525,7 +528,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]; @@ -535,7 +538,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}; @@ -568,7 +571,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) { @@ -577,7 +580,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)); } } } @@ -614,9 +617,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) { @@ -628,6 +640,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 @@ -650,30 +666,62 @@ $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); } } @@ -688,66 +736,26 @@ 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 ); + my $db = new Biblio::Isis( isisdb => $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 $max_rowid = $db->count; - # 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"; + if (! $max_rowid) { + print STDERR "FATAL: can't read ISIS database: $isis_db, skipping...\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 ); - } - print STDERR "Reading database: $isis_db [$max_rowid rows]\n"; - my $path = $database; + $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}); @@ -761,10 +769,6 @@ } } } - # 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") { @@ -798,7 +802,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; } } @@ -824,42 +832,52 @@ } } elsif ($type_base eq "marc") { - require 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 ); - # read MARC file in memory - $marc->nextmarc(-1); + if (! $marc) { + print STDERR "FATAL: can't read MARC file: $marc_file, skipping...\n"; + next; + } - my $max_rec = $marc->marc_count(); + # count records in MARC file + sub marc_count { + my $filename = shift || die; + my $file = MARC::File::USMARC->in($filename) || return; + my $count = 0; + while ($file->skip()) { + $count++; + } + return $count; + } - for(my $i=1; $i<=$max_rec; $i++) { + my $count = marc_count($marc_file) || warn "no records in '$marc_file'?"; - progress($i,$max_rec); + my $i = 1; - # store value for marc_sf.pm - $main::cache->{marc_record} = $i; + while( my $rec = $marc->next() ) { + + 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"; print "Content-Length: ".(length($xml)+1)."\n"; print "Document-Type: XML\n\n$xml\n"; } + + $i++; } print STDERR "\n"; @@ -918,14 +936,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 -records using MARC module and optionally Micro$oft Excel files to +This command will read ISIS data file using Biblio::Isis perl module, MARC +records using MARC::File 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