--- trunk/all2xml.pl 2003/01/11 06:14:48 5 +++ trunk/all2xml.pl 2004/01/31 21:03:06 207 @@ -6,101 +6,553 @@ use Data::Dumper; use XML::Simple; use Text::Unaccent 1.02; # 1.01 won't compile on my platform, -require Unicode::Map8; - -my $config=XMLin(undef, forcearray => [ 'isis' ], forcecontent => 1); +use Text::Iconv; +use Config::IniFiles; +use Encode; +#use GDBM_File; +use Fcntl; # for O_RDWR +use TDB_File; + +$|=1; + +my $config_file = $0; +$config_file =~ s/\.pl$/.conf/; +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 +my $index; my %opts; -getopts('d:m:q', \%opts); +# usage: +# -d directory name +# -m multiple directories +# -q quiet +# -s run swish + +getopts('d:m:qs', \%opts); + +my $path; # this is name of database + +Text::Iconv->raise_error(0); # Conversion errors don't raise exceptions + +# this is encoding of all files on disk, including import_xml/*.xml file and +# filter/*.pm files! It will be used to store strings in perl internally! +my $codepage = 'ISO-8859-2'; + +my $utf2cp = Text::Iconv->new('UTF-8',$codepage); +# this function will convert data from XML files to local encoding +sub x { + return $utf2cp->convert($_[0]); +} + +# decode isis/excel or other import codepage +my $import2cp; + +# outgoing xml must be in UTF-8 +my $cp2utf = Text::Iconv->new($codepage,'UTF-8'); + +# mapping between data type and tag which specify +# format in XML file +my %type2tag = ( + 'isis' => 'isis', + 'excel' => 'column', + 'marc' => 'marc', + 'feed' => 'feed' +); -my $db_dir = $opts{d} || "ps"; # FIX +my $cache; # for cacheing -#die "usage: $0 -d [database_dir] -m [database1,database2] " if (! %opts); +# lookup hash (tied to file) +my %lhash; +# this option will cache all lookup entries in memory. +# if you are tight on memory, turn this off +my $use_lhash_cache = 1; -#print Dumper($config->{indexer}); -#print "-" x 70,"\n"; +my $last_field_name; # cache to prevent repeated fields -# how to convert isis code page to UTF8? -my $isis_map = Unicode::Map8->new($config->{isis_codepage}) || die; +sub data2xml { -sub isis2xml { + use xmlify; + my $type = shift @_; my $row = shift @_; + my $add_xml = shift @_; + # needed to read values from configuration file + my $cfg = shift @_; + my $database = shift @_; my $xml; - sub isis_sf { - my $row = shift @_; - my $isis_id = shift @_; - my $subfield = shift @_; - if ($row->{$isis_id}->[0]) { - my $sf = OpenIsis::subfields($row->{$isis_id}->[0]); - if (! defined $subfield || length($subfield) == 0) { - # subfield list undef, empty or no defined subfields for this record - my $all_sf = $row->{$isis_id}->[0]; - $all_sf =~ s/\^./ /g; nuke definirions - return $all_sf; - } elsif ($sf->{$subfield}) { - return $sf->{$subfield}; + use parse_format; + + my $html = ""; # html formatted display output + + my %field_usage; # counter for usage of each field + + # sort subrouting using order="" attribute + sub by_order { + my $va = $config->{indexer}->{$a}->{order} || + $config->{indexer}->{$a}; + my $vb = $config->{indexer}->{$b}->{order} || + $config->{indexer}->{$b}; + + return $va <=> $vb; + } + + my @sorted_tags; + if ($cache->{tags_by_order}) { + @sorted_tags = @{$cache->{tags_by_order}}; + } else { + @sorted_tags = sort by_order keys %{$config->{indexer}}; + $cache->{tags_by_order} = \@sorted_tags; + } + + # lookup key + my $lookup_key; + + # cache for field in pages + delete $cache->{display_data}; + delete $cache->{swish_data}; + delete $cache->{swish_exact_data}; + delete $cache->{index_data}; + delete $cache->{index_delimiter}; + my @page_fields; # names of fields + + + # subs used to produce output + + sub get_field_name($$$) { + my ($config,$field,$field_usage) = @_; + + # find field name (signular, plural) + my $field_name = ""; + if ($config->{indexer}->{$field}->{name_singular} && $field_usage == 1) { + $field_name = $config->{indexer}->{$field}->{name_singular}; + } elsif ($config->{indexer}->{$field}->{name_plural}) { + $field_name = $config->{indexer}->{$field}->{name_plural}; + } elsif ($config->{indexer}->{$field}->{name}) { + $field_name = $config->{indexer}->{$field}->{name}; + } else { + print STDERR "WARNING: field '$field' doesn't have 'name' attribute!"; + } + if ($field_name) { + if (! $last_field_name) { + $last_field_name = x($field_name); + return $last_field_name; + } elsif ($field_name ne $last_field_name) { + $last_field_name = x($field_name); + return $last_field_name; } } } - foreach my $field (keys %{$config->{indexer}}) { + # begin real work: go field by field + foreach my $field (@sorted_tags) { + + $field=x($field); + $field_usage{$field}++; + + my $swish_data = ""; + my $swish_exact_data = ""; my $display_data = ""; - my $index_data = ""; + my @index_data; + my $line_delimiter; - foreach my $x (@{$config->{indexer}->{$field}->{isis}}) { + my ($swish,$display); - my $display_tmp = ""; - my $index_tmp = ""; + my $tag = $type2tag{$type} || die "can't find which tag to use for type $type"; - my $format = $x->{content}; - my $i = 1; # index only - my $d = 1; # display only - $i = 0 if (lc($x->{type}) eq "display"); - $d = 0 if (lc($x->{type}) eq "index"); -#print "## i: $i d: $d ## $format ##"; - # parse format - my $prefix = ""; - if ($format =~ s/^([^\d]+)//) { - $prefix = $1; - } - while ($format) { - if ($format =~ s/^(\d\d\d)(\w?)//) { - my $isis_tmp = isis_sf($row,$1,$2); - if ($isis_tmp) { -# $display_tmp .= $prefix . "/$1/$2/".$isis_tmp if ($d); - $display_tmp .= $prefix . $isis_tmp if ($d); - $index_tmp .= $isis_tmp." " if ($i); -#print " $isis_tmp <--\n"; - } - $prefix = ""; - } elsif ($format =~ s/^([^\d]+)//) { - $prefix = $1; + # is this field page-by-page? + my $iterate_by_page = $config->{indexer}->{$field}->{iterate_by_page}; + push @page_fields,$field if ($iterate_by_page); + my %page_max = (); + # default line_delimiter if using + my $page_line_delimiter = $config->{indexer}->{$field}->{page_line_delimiter} || '
'; + $cache->{index_delimiter}->{$field} = $config->{indexer}->{$field}->{index_delimiter}; + + my $format_name = $config->{indexer}->{$field}->{format_name}; + my $format_delimiter = $config->{indexer}->{$field}->{format_delimiter}; + if ($format_name && $format_delimiter) { + $cache->{format}->{$field}->{format_name} = $format_name; + $cache->{format}->{$field}->{format_delimiter} = $format_delimiter; + } + + foreach my $x (@{$config->{indexer}->{$field}->{$tag}}) { + + 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/); + + # what will separate last line from this one? + if ($display_data && $x->{append}) { + $line_delimiter = ' '; + } elsif ($display_data) { + $line_delimiter = '
'; + } + + # init vars so that we go into while... + ($swish,$display) = (1,1); + + # placeholder for all repeatable entries for index + + sub chk_eval($) { + my $data = shift; + if ($data =~ s/eval{([^}]+)}//) { + if (eval "$1") { + return $data; + } else { + return undef; + } } else { - print STDERR "WARNING: unparsed format '$format'\n"; + 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 $fmt = x($config->{format}->{$format_name}->{content}) || die " is not defined!"; + my $format_delimiter = x($x->{format_delimiter}); + my @data; + if ($format_delimiter) { + @data = split(/$format_delimiter/,$data); + } else { + push @data,$data; + } + + if ($fmt) { + my $nr = scalar $fmt =~ s/%s/%s/g; + if (($#data+1) == $nr) { + return chk_eval(sprintf($fmt,@data)); + } else { + #print STDERR "mkformat: [$data] can't be split on [$format_delimiter] to $nr fields!\n"; + return chk_eval($data); + } + } else { + print STDERR "usage of link '$format_name' without defined format ( tag)\n"; + } + } + + # while because of repeatable fields + while ($swish || $display) { + my $page = $repeat_off; + $page_max{$field} = $page if ($iterate_by_page && $page > ($page_max{$field} || 0)); + ($swish,$display) = parse_format($type, $format,$row,$repeat_off++,$import2cp); + if ($repeat_off > 1000) { + print STDERR "loop (more than 1000 repeatable fields) deteced in $row, $format\n"; last; - }; + } + + # is this field is lookup? + if ($display && $x->{lookup}) { + my $null = ""; + if ($use_lhash_cache) { + if (!defined($cache->{lhash}->{$display})) { + my $new_display = $lhash{$display}; + if (defined($new_display)) { +#print STDERR "lookup cache store '$display' = '$new_display'\n"; + $display = $new_display; + $cache->{lhash}->{$display} = $new_display; + } else { + print STDERR "WARNING: lookup for '$display' didn't find anything.\n"; + $display = ""; + $cache->{lhash}->{$display} = $null; + } + } else { + $display = $cache->{lhash}->{$display}; + } + } else { + $display = $lhash{$display} || $null; + } + } + + # filter="name" ; filter this field through + # filter/[name].pm + my $filter = $x->{filter}; + if ($filter && !$cache->{filter_loaded}->{$filter}) { + require "filter/".$filter.".pm"; + $cache->{filter_loaded}->{$filter}++; + } + # type="swish" ; field for swish + if ($swish) { + if ($filter && ($s || $se)) { + no strict 'refs'; + my $tmp = join(" ",&$filter($swish)) if ($s || $se); + $swish_data .= $tmp if ($s); + $swish_exact_data .= "xxbxx $tmp xxexx " if ($se && $tmp ne ""); + + } else { + $swish_data .= $swish if ($s); + $swish_exact_data .= "xxbxx $swish xxexx " if ($se && $swish ne ""); + } + } + + # type="display" ; field for display + if ($d && $display) { + my $ldel = $delimiter; + if ($line_delimiter && $display_data) { + $ldel = $line_delimiter; + } + if ($filter) { + no strict 'refs'; + my @arr; + foreach my $tmp (&$filter($display)) { + my $tmp2 = mkformat($x,$tmp); + push @arr,$tmp2 if ($tmp2); + } + $display_data .= $ldel if ($display_data && @arr); + $display_data .= join($delimiter,@arr); + } else { + $display_data .= $ldel if ($display_data); + my $tmp = mkformat($x,$display); + $display_data = $tmp if ($tmp); + } + } + + # type="index" ; insert into index + my $idisplay; + if ($i && $display) { + $idisplay = $display; + if ($filter) { + no strict 'refs'; + $idisplay = &$filter($idisplay); + } + push @index_data, $idisplay if (! $iterate_by_page); + } + + # store fields in lookup + if ($il && $display) { + if (lc($x->{type}) eq "lookup_key") { + if ($lookup_key) { + print STDERR "WARNING: try to redefine lookup_key (keys shouldn't be repeatable fields!)"; + } else { + $lookup_key = $display; + } + } elsif (lc($x->{type}) eq "lookup_val") { + if ($lookup_key) { + $lhash{$lookup_key} = $display; + } else { + print STDERR "WARNING: no lookup_key defined for '$display'?"; + } + } + + } + + # store data for page-by-page repeatable fields + if ($iterate_by_page) { + sub iterate_fld($$$$$$) { + my ($cache,$what,$field,$page,$data,$append) = @_; + return if (!$data); + + my $ldel = $page_line_delimiter; + $ldel = " " if ($append); +#print STDERR "line delimiter: ",Dumper($ldel) if ($ldel); + if (! $cache->{$what}->{$field}->[$page]) { + $cache->{$what}->{$field}->[$page] = $data; + } else { + $cache->{$what}->{$field}->[$page] .= $ldel.$data; + } + } + + if ($display_data) { + iterate_fld($cache,'display_data',$field,$page,$display_data,$x->{append}); + } + $display_data = ""; + if ($swish_data) { + iterate_fld($cache,'swish_data',$field,$page,$swish_data,$x->{append}); + $swish_data = ""; + } + if ($swish_exact_data) { + iterate_fld($cache,'swish_exact_data',$field,$page,$swish_exact_data,$x->{append}); + $swish_exact_data = ""; + } + + if ($idisplay) { + my $ldel=$page_line_delimiter; + my @index_data; + if ($cache->{index_data}->{$field}->[$page]) { + + @index_data = @{$cache->{index_data}->{$field}->[$page]}; + } + if ($x->{append}) { + if (@index_data) { + $index_data[$#index_data] .= $idisplay; + } else { + push @index_data, $idisplay; + } + } else { + push @index_data, $idisplay; + } + $idisplay = ""; + @{$cache->{index_data}->{$field}->[$page]} = @index_data; + } + } } - # add suffix - $display_tmp .= $prefix if ($display_tmp); -# $display_data .= $display_tmp if ($display_tmp ne ""); -# $index_data .= $index_tmp if ($index_tmp ne ""); - $display_data .= $display_tmp; - $index_data .= $index_tmp; + if (! $iterate_by_page) { + my $idel = $x->{index_delimiter}; + # fill data in index + foreach my $tmp (@index_data) { + my $i = $d = $tmp; + if ($idel && $tmp =~ m/$idel/) { + ($i,$d) = split(/$idel/,$tmp); + } + $index->insert($field, $i, $d, $path); + } + @index_data = (); + } + } + + # now try to parse variables from configuration file + foreach my $x (@{$config->{indexer}->{$field}->{'config'}}) { + 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"); + + if ($val) { + $display_data .= $delimiter.$val if ($d); + $swish_data .= $val if ($s); + $index->insert($field, $val, $path) if ($i); + } + + if ($iterate_by_page) { + # FIXME data from config tag will appear just + # on first page!!! + my $page = 0; + if ($display_data) { + $cache->{display_data}->{$field}->[$page] = $display_data; + $display_data = ""; + } + if ($swish_data) { + $cache->{swish_data}->{$field}->[$page] = $swish_data; + $swish_data = ""; + } + if ($swish_exact_data) { + $cache->{swish_exact_data}->{$field}->[$page] = $swish_exact_data; + $swish_exact_data = ""; + } + } } -#print "--display:$display_data\n--index:$index_data\n"; - $xml->{$field}->{display} .= $isis_map->tou($display_data)->utf8 if ($display_data); - $xml->{$field}->{index} .= unac_string($config->{isis_codepage},$index_data) if ($index_data); + + # save data page-by-page + foreach my $field (@page_fields) { + my $nr_pages = $page_max{$field} || next; +#print STDERR "field '$field' iterate over ",($nr_pages || 0)," pages...\n"; +#print STDERR Dumper($cache->{display_data}); + for (my $page=0; $page <= $nr_pages; $page++) { + my $display_data; + if ($cache->{format}->{$field}) { + my $tmp = mkformat($cache->{format}->{$field},$cache->{display_data}->{$field}->[$page]); + $display_data=$tmp if ($tmp); + } else { + $display_data = $cache->{display_data}->{$field}->[$page]; + } + if ($display_data) { # default + if ($field eq "headline") { + $xml .= xmlify("headline", $display_data); + } else { + + # fallback to empty field name if needed + $html .= get_field_name($config,$field,$field_usage{$field}) || ''; + $html .= "#-#".$display_data."###\n"; + } + } + + my $swish_data = $cache->{swish_data}->{$field}->[$page]; + if ($swish_data) { + # remove extra spaces + $swish_data =~ s/ +/ /g; + $swish_data =~ s/ +$//g; + + $xml .= xmlify($field."_swish", unac_string($codepage,$swish_data)); + } + + my $swish_exact_data = $cache->{swish_exact_data}->{$field}->[$page]; + if ($swish_exact_data) { + $swish_exact_data =~ s/ +/ /g; + $swish_exact_data =~ s/ +$//g; + + # add delimiters before and after word. + # That is required to produce exact match + $xml .= xmlify($field."_swish_exact", unac_string($codepage,$swish_exact_data)); + } + + my $idel = $cache->{index_delimiter}->{$field}; + foreach my $tmp (@{$cache->{index_data}->{$field}->[$page]}) { + my $i = $tmp; + my $d = $tmp; + if ($idel && $tmp =~ m/$idel/) { + ($i,$d) = split(/$idel/,$tmp); + } + $index->insert($field, $i, $d, $path); +#print STDERR "index [$idel] $field: $i --> $d [$path]\n"; + } + } + } + + if (! $iterate_by_page) { + if ($display_data) { + if ($field eq "headline") { + $xml .= xmlify("headline", $display_data); + } else { + + # fallback to empty field name if needed + $html .= get_field_name($config,$field,$field_usage{$field}) || ''; + $html .= "#-#".$display_data."###\n"; + } + } + if ($swish_data) { + # remove extra spaces + $swish_data =~ s/ +/ /g; + $swish_data =~ s/ +$//g; + + $xml .= xmlify($field."_swish", unac_string($codepage,$swish_data)); + } + + if ($swish_exact_data) { + $swish_exact_data =~ s/ +/ /g; + $swish_exact_data =~ s/ +$//g; + + # add delimiters before and after word. + # That is required to produce exact match + $xml .= xmlify($field."_swish_exact", unac_string($codepage,$swish_exact_data)); + } + } + } + + # dump formatted output in + if ($html) { + #$xml .= xmlify("html",$html); + $xml .= ""; } + if ($xml) { - return XMLout($xml, rootname => 'xml', noattr => 1 ); + $xml .= $add_xml if ($add_xml); + return "\n$xml\n"; } else { return; } @@ -108,75 +560,308 @@ ########################################################################## -my $last_tell=0; +# read configuration for this script +my $cfg = new Config::IniFiles( -file => $config_file ); -my @isis_dirs = ( '.' ); # use dirname as database name +# read global.conf configuration +my $cfg_global = new Config::IniFiles( -file => 'global.conf' ); -if ($opts{m}) { - @isis_dirs = split(/,/,$opts{m}); +# open index +$index = new index_DBI( + $cfg_global->val('global', 'dbi_dbd'), + $cfg_global->val('global', 'dbi_dsn'), + $cfg_global->val('global', 'dbi_user'), + $cfg_global->val('global', 'dbi_passwd') || '', + ); + +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 @isis_dbs; +foreach my $database ($cfg->Sections) { -foreach (@isis_dirs) { - if (-e $config->{isis_data}."/$db_dir/$_/LIBRI") { - push @isis_dbs,$config->{isis_data}."/$db_dir/$_/LIBRI/LIBRI"; + my $type = lc($cfg -> val($database, 'type')) || die "$database doesn't have 'type' defined"; + my $add_xml = $cfg -> val($database, 'xml'); # optional + + # create new lookup file + my $lookup_file = $cfg -> val($database, 'lookup_newfile'); # optional + if ($lookup_file) { + #tie %lhash, 'GDBM_File', $lookup_file, &GDBM_NEWDB, 0644; + tie %lhash, 'TDB_File', $lookup_file, TDB_CLEAR_IF_FIRST, O_RDWR, 0644; + print STDERR "creating lookup file '$lookup_file'\n"; } - if (-e $config->{isis_data}."/$db_dir/$_/PERI") { - push @isis_dbs,$config->{isis_data}."/$db_dir/$_/PERI/PERI"; + + # open existing lookup file + $lookup_file = $cfg -> val($database, 'lookup_open'); # optional + if ($lookup_file) { + #tie %lhash, 'GDBM_File', $lookup_file, &GDBM_READER, 0644; + tie %lhash, 'TDB_File', $lookup_file, TDB_DEFAULT, O_RDWR, 0644; + print STDERR "opening lookup file '$lookup_file'\n"; } - if (-e $config->{isis_data}."/$db_dir/$_/AMS") { - push @isis_dbs,$config->{isis_data}."/$db_dir/$_/AMS/AMS"; + +print STDERR "reading ./import_xml/$type.xml\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); + + # output current progress indicator + my $last_p = 0; + 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 ); + $last_p = $p; + } } - if (-e $config->{isis_data}."/$db_dir/$_/ARTI") { -# push @isis_dbs,$config->{isis_data}."/$db_dir/$_/ARTI/ARTI"; + + my $fake_dir = 1; + sub fakeprogress { + return if (! $show_progress); + my $current = shift @_; + + 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]); + } } -} -print STDERR "FATAL: Can't find isis database.\nPerhaps isis_data (".$config->{isis_data}.") has wrong value?\n" if (! @isis_dbs); + # now read database +print STDERR "using: $type...\n"; -my $db; + # erase cache for tags by order in this database + delete $cache->{tags_by_order}; -foreach my $isis_db (@isis_dbs) { + if ($type_base eq "isis") { + my $isis_db = $cfg -> val($database, 'isis_db') || die "$database doesn't have 'isis_db' defined!"; - my $db = OpenIsis::open( $isis_db ); - if (0) { -# # FIX -# if (! $db ) { - print STDERR "WARNING: can't open '$isis_db'\n"; - next ; - } + $import2cp = Text::Iconv->new($config->{isis_codepage},$codepage); + my $db = OpenIsis::open( $isis_db ); - my $max_rowid = OpenIsis::maxRowid( $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; - print STDERR "Reading database: $isis_db [$max_rowid rows]\n"; + 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); + } - my $last_p = 0; + # 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; + } + } + + # 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 ); + } + + 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}) { + + progress($row->{mfn}, $max_rowid); + + my $swishpath = $path."#".int($row->{mfn}); -# { my $row_id = 1; -# FIX - for (my $row_id = 1; $row_id <= $max_rowid; $row_id++ ) { - my $row = OpenIsis::read( $db, $row_id ); - if ($row && $row->{mfn}) { - - # output current process indicator - my $p = int($row->{mfn} * 100 / $max_rowid); - if ($p != $last_p) { - printf STDERR ("%5d / %5d [%-51s] %-2d %% \r",$row->{mfn},$max_rowid,"=" x ($p/2).">", $p ) if (! $opts{q}); - $last_p = $p; + 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"; + } } + } + # 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); + + $import2cp = Text::Iconv->new($config->{excel_codepage},$codepage); + my $excel_file = $cfg -> val($database, 'excel_file') || die "$database doesn't have 'excel_file' defined!"; + + my $sheet = x($config->{sheet}) || die "no sheet in $type.xml"; + my $start_row = x($config->{start_row}) - 1 || die "no start_row in $type.xml"; + + my $oBook = Spreadsheet::ParseExcel::Workbook->Parse($excel_file) || die "can't open Excel file '$excel_file'"; + + my $sheet_nr = 0; + foreach my $oWks (@{$oBook->{Worksheet}}) { + #print STDERR "-- SHEET $sheet_nr:", $oWks->{Name}, "\n"; + last if ($oWks->{Name} eq $sheet); + $sheet_nr++; + } - if (my $xml = isis2xml($row)) { - print "Path-Name: $isis_db#".$row->{mfn}."\n"; + my $oWorksheet = $oBook->{Worksheet}[$sheet_nr]; + + print STDERR "using sheet: ",$oWorksheet->{Name},"\n"; + defined ($oWorksheet) || die "can't find sheet '$sheet' in $excel_file"; + my $end_row = x($config->{end_row}) || $oWorksheet->{MaxRow}; + + for(my $iR = $start_row ; defined $end_row && $iR <= $end_row ; $iR++) { + my $row; + 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; + } + } + + progress($iR, $end_row); + +# print "row[$iR/$end_row] "; +# foreach (keys %{$row}) { +# print "$_: ",$row->{$_},"\t"; +# } +# print "\n"; + + my $swishpath = $database."#".$iR; + + next if (! $row); + + 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"; } } + } elsif ($type_base eq "marc") { + + use MARC; + + $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->{format}) || 'usmarc'; + + 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'"; + + my $i=0; # record nr. + + my $rec; + + while ($marc->nextmarc(1)) { + + # XXX + fakeprogress($i++); + + my $swishpath = $database."#".$i; + + if (my $xml = data2xml($type_base,$marc,$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"; + } + } + } elsif ($type_base eq "feed") { + + $import2cp = Text::Iconv->new($config->{feed_codepage},$codepage); + my $prog = x($config->{prog}) || die "$database doesn't have 'prog' defined!"; + + print STDERR "Reading feed from program '$prog'\n"; + + open(FEED,"feeds/$prog |") || die "can't start $prog: $!"; + + my $i=1; # record nr. + + my $data; + my $line=1; + + while () { + chomp; + + if (/^$/) { + my $swishpath = $database."#".$i++; + + if (my $xml = data2xml($type_base,$data,$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"; + } + $line = 1; + $data = {}; + next; + } + + $line = $1 if (s/^(\d+):\s*//); + $data->{$line++} = $_; + + fakeprogress($i); + + } + # close lookup + untie %lhash if (%lhash); } - print STDERR "\n"; } +# call this to commit index +$index->close; 1; __END__ @@ -184,15 +869,21 @@ =head1 NAME -isis2xml.pl - read isis file and dump XML +all2xml.pl - read various file formats and dump XML for SWISH-E =head1 DESCRIPTION -This command will read ISIS data file using OpenIsis perl module and -create 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. +This command will read ISIS data file using OpenIsis 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. + +=head1 BUGS + +Documentation is really lacking. However, in true Open Source spirit, source +is best documentation. I even made considerable effort to comment parts +which are not intuitively clear, so... =head1 AUTHOR