--- branches/tehnika/all2xml.pl 2004/03/14 12:09:01 276 +++ branches/tehnika/all2xml.pl 2005/02/28 10:43:38 684 @@ -1,28 +1,30 @@ #!/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; #use GDBM_File; use Fcntl; # for O_RDWR use TDB_File; +use Carp; $|=1; 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; @@ -61,7 +63,7 @@ 'isis' => 'isis', 'excel' => 'column', 'marc' => 'marc', - 'feed' => 'feed' + 'feed' => 'feed', ); my $cache; # for cacheing @@ -111,6 +113,10 @@ $cache->{tags_by_order} = \@sorted_tags; } + if (! @sorted_tags) { + print STDERR "WARNING: no tags for this type found in import_xml file!\n"; + } + # lookup key my $lookup_key; @@ -139,17 +145,21 @@ } 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; @@ -166,10 +176,41 @@ ($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,7 +225,7 @@ my ($swish,$display); - my $tag = $type2tag{$type} || die "can't find which tag to use for type $type"; + my $tag = $cfg->val($database, 'import_xml_tag') || $type2tag{$type} || die "can't find which tag to use for type $type"; # is this field page-by-page? my $iterate_by_page = $config->{indexer}->{$field}->{iterate_by_page}; @@ -203,6 +244,8 @@ foreach my $x (@{$config->{indexer}->{$field}->{$tag}}) { + $x = unroll_x($x); + my $format = x($x->{content}); my $delimiter = x($x->{delimiter}) || ' '; @@ -212,7 +255,7 @@ # what will separate last line from this one? if ($display_data && $x->{append}) { - $line_delimiter = ' '; + $line_delimiter = $delimiter; } elsif ($display_data) { $line_delimiter = '
'; } @@ -220,8 +263,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; @@ -429,6 +470,8 @@ # 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})); @@ -490,7 +533,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]; @@ -500,7 +543,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}; @@ -533,7 +576,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) { @@ -542,7 +585,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)); } } } @@ -579,13 +622,26 @@ 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) { + # save database name in global variable path for later + # (need for index filter creation) + $path = $database; + my $type = lc($cfg -> val($database, 'type')) || die "$database doesn't have 'type' defined"; my $add_xml = $cfg -> val($database, 'xml'); # optional @@ -593,6 +649,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 @@ -607,43 +667,83 @@ print STDERR "opening lookup file '$lookup_file'\n"; } -print STDERR "reading ./import_xml/$type.xml\n"; + my $import_xml_type = $cfg->val($database, 'import_xml_file') || $type; + my $import_xml_file = "./import_xml/$import_xml_type.xml"; + + if (! -r $import_xml_file) { + print STDERR "ERROR: file $import_xml_file not readable skipping!\n"; + next; + } + + print STDERR "reading $import_xml_file\n"; # extract just type basic my $type_base = $type; $type_base =~ s/_.+$//g; - $config=XMLin("./import_xml/$type.xml", forcearray => [ $type2tag{$type_base}, 'config', 'format' ], forcecontent => 1); + my $tag = $cfg->val($database, 'import_xml_tag') || $type2tag{$type_base} || die "can't find which tag to use for type $type"; + $config=XMLin($import_xml_file, ForceArray => [ $tag, '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 = ('-','\\','|','/','-','\\','|','/'); - $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 < $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); + } + + 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); } } # now read database -print STDERR "using: $type...\n"; # erase cache for tags by order in this database delete $cache->{tags_by_order}; @@ -653,66 +753,24 @@ 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"; + if (! $db) { + 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 ); - } + my $max_rowid = $db->count if ($db); 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}); @@ -726,10 +784,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") { @@ -763,7 +817,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; } } @@ -787,44 +845,57 @@ print "Document-Type: XML\n\n$xml\n"; } } + + print STDERR "\n"; + } 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; + } + + # 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; + } - 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 = 1; - 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"; print "Content-Length: ".(length($xml)+1)."\n"; print "Document-Type: XML\n\n$xml\n"; } + + $i++; } print STDERR "\n"; @@ -869,6 +940,72 @@ } # close lookup untie %lhash if (%lhash); + + } elsif ($type_base eq "dbf") { + + my $dbf_file = $cfg -> val($database, 'dbf_file') || die "$database doesn't have 'dbf_file' defined!"; + my $dbf_codepage = $cfg -> val($database, 'dbf_codepage') || die "$database doesn't have 'dbf_codepage' defined!"; + my $dbf_mapping = $cfg -> val($database, 'dbf_mapping') || die "$database doesn't have 'dbf_mapping' defined!"; + + $import2cp = Text::Iconv->new($dbf_codepage,$codepage); + require XBase; + my $db = new XBase $dbf_file; + + if (! $db) { + print STDERR "ERROR: can't read DBF database: $dbf_file, skipping...\n"; + next; + } + + my $max_rowid = $db->last_record; + + print STDERR "Reading database: $dbf_file [$max_rowid rows]\n"; + + my %dbf2iso; + foreach my $m (split(/[\n\r]+/,$dbf_mapping)) { + my ($col,$fld) = split(/\s+/,$m,2); + $dbf2iso{$col} = $fld; + } + +#print STDERR "## dbf2iso: ",Dumper(\%dbf2iso),"\n## /dbf2iso\n"; + + # bad, bad... + require "to_hash.pm"; + + foreach my $row_id (0 .. $max_rowid) { + my $dbf_row = $db->get_record_as_hash($row_id); + if ($dbf_row) { + +#print STDERR "## dbf_row: ",Dumper($dbf_row),"\n## /dbf_row\n"; + # apply mapping from config file + # all unspecified records will get _ in + # front of them - _DELETE will be __DELETE + my $rec; + map { + my $new_fld = $dbf2iso{$_} || '_'.$_; + my $data = $dbf_row->{$_}; + push @{ $rec->{$new_fld} }, $data if ($data && $data !~ /^(?:\s+|\$a\.|)$/); + } keys %{$dbf_row}; +#print STDERR "## rec: ",Dumper($rec),"\n## /rec\n"; + my $row = to_hash($row_id+1, $rec); + + $row->{mfn} = $row_id+1; + $row->{record} = $rec; + +#print STDERR "## row: ",Dumper($row),"\n## /row\n"; + progress($row->{mfn}, $max_rowid); + + my $swishpath = $path."#".int($row->{mfn}); + + if (my $xml = data2xml($type_base,$row,$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"; + } + } + } + print STDERR "\n"; } } @@ -883,14 +1020,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