--- trunk/all2xml.pl 2004/04/02 23:31:25 298 +++ trunk2/all2all.pl 2004/07/21 16:58:27 392 @@ -1,955 +1,107 @@ #!/usr/bin/perl -w -use strict; -use OpenIsis; -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; - -$|=1; - -my $config_file = $0; -$config_file =~ s/\.pl$/.conf/; -$config_file = $ARGV[0] if (-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 -my $index; - -my %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 +=head1 NAME -Text::Iconv->raise_error(0); # Conversion errors don't raise exceptions +all2all.pl - basic script for all WebPAC needs -# 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'; +=cut -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]); -} +use strict; +use Data::Dumper; +use Carp; -# decode isis/excel or other import codepage -my $import2cp; +use lib './lib'; +use WebPAC; +use WebPAC::jsFind; + +my $webpac = new WebPAC( + code_page => 'ISO-8859-2', + limit_mfn => 100, +# debug => 1, +) || die; + +my $log = $webpac->_get_logger(); + +my $index = new WebPAC::jsFind( + index_path => './out/index', +) || die; -# outgoing xml must be in UTF-8 -my $cp2utf = Text::Iconv->new($codepage,'UTF-8'); +$|=1; -# mapping between data type and tag which specify -# format in XML file -my %type2tag = ( - 'isis' => 'isis', - 'excel' => 'column', - 'marc' => 'marc', - 'feed' => 'feed' +my $maxmfn = $webpac->open_isis( + filename => shift @ARGV || '/data/hidra/THS/THS', + lookup => [ + { 'key' => 'd:v900', 'val' => 'v250^a' }, +# { 'eval' => '"v901^a" eq "Područje"', 'key' => 'pa:v561^4:v562^4:v461^1', 'val' => 'v900' }, +# { 'eval '=> '"v901^a" eq "Mikrotezaurus"', 'key' => 'a:v561^4:v562^4:v461^1', 'val' => 'v900' }, +# { 'eval' => '"v901^a" eq "Deskriptor"', 'key' => 'a:v561^4:v562^4:v461^1', 'val' => 'v900' }, + { 'key' => 'a:v561^4:v562^4:v461^1', 'val' => 'v900' }, + { 'key' => '900_mfn:v900', 'val' => 'v000' }, + ], ); -my $cache; # for cacheing +$log->info("rows: $maxmfn"); -# 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; +$webpac->open_import_xml(type => 'isis_hidra_ths'); -my $last_field_name; # cache to prevent repeated fields +while (my $rec = $webpac->fetch_rec) { -sub data2xml { + my @ds = $webpac->data_structure($rec); - 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; - - 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; + if ($log->is_debug) { + $log->debug("rec = ",Dumper($rec)); + $log->debug("ds = ",Dumper(\@ds)); } - # 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; - } - } - } + next if (! @ds); + my $filename = $webpac->{'current_filename'}; - # 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); - } - return ($s,$se,$d,$i,$il); + if ($filename) { + open(OUT,"> $filename") || $log->logdie("can't open output '$filename': $!"); + print OUT $webpac->output( + template => 'html.tt', + data => \@ds, + ); + close(OUT); + } else { + print $webpac->output( + template => 'text.tt', + data => \@ds, + ); } - - # 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; + my $headline; + foreach my $ds (@ds) { + if ($ds->{'tag'} eq 'headline') { + $headline = join(" ",@{$ds->{'display'}}); + last; } - return $x; } - # 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 $line_delimiter; - - my ($swish,$display); - - my $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}; - 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 $f = $filename; + $f =~ s!out/!!; - $x = unroll_x($x); - - my $format = x($x->{content}); - my $delimiter = x($x->{delimiter}) || ' '; - - my $repeat_off = 0; # init repeatable offset - - 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 = $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 mkformat($$) { - my $x = shift || die "mkformat needs tag reference"; - my $data = shift || return; - 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; - 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 sprintf($fmt,@data); - } else { - #print STDERR "mkformat: [$data] can't be split on [$format_delimiter] to $nr fields!\n"; - return $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) { - my $tmp = $swish; - if ($filter && ($s || $se)) { - no strict 'refs'; - $tmp = join(" ",&$filter($tmp)) if ($s || $se); - } - - $swish_data .= $tmp if ($s && $tmp); - $swish_exact_data .= "xxbxx $tmp xxexx " if ($tmp && $tmp ne "" && $se); - } - - # 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 ($idisplay && !$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 { - if ($filter) { - no strict 'refs'; - $lookup_key = &$filter($display); - } else { - $lookup_key = $display; - } - } - } elsif (lc($x->{type}) eq "lookup_val") { - if ($lookup_key) { - if ($filter) { - no strict 'refs'; - $lhash{$lookup_key} = &$filter($display); - } else { - $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; - } - } - } - - 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 = (); - } - } + # save into index + foreach my $ds (@ds) { + next if (! $ds->{'swish'}); - # 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})); - - # 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); - $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 = ""; - } - } - } - - # 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)); - } - } + $index->insert( + index_name => $ds->{'tag'}, + path => $f, + headline => $headline, + words => join(" ",@{$ds->{'swish'}}) + ); } - # dump formatted output in - if ($html) { - #$xml .= xmlify("html",$html); - $xml .= ""; - } - - if ($xml) { - $xml .= $add_xml if ($add_xml); - return "\n$xml\n"; - } else { - return; - } -} - -########################################################################## +# print Dumper(\@ds); -# read configuration for this script -my $cfg = new Config::IniFiles( -file => $config_file ); - -# read global.conf configuration -my $cfg_global = new Config::IniFiles( -file => 'global.conf' ); - -# 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; } -foreach my $database ($cfg->Sections) { - - 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"; - # delete memory cache for lookup file - delete $cache->{lhash}; - } - - # 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"; - } - -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; - } - } - - 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]); - } - } - - # now read database -print STDERR "using: $type...\n"; - - # erase cache for tags by order in this database - delete $cache->{tags_by_order}; - - if ($type_base eq "isis") { - - 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; - } - } - - # 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}); - - 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") { - 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!"; - - 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++; - } - - 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") { - - require 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->{marc_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' with format '$format'"; - - # read MARC file in memory - $marc->nextmarc(-1); - - my $max_rec = $marc->marc_count(); - - for(my $i=1; $i<=$max_rec; $i++) { - - progress($i,$max_rec); - - # store value for marc_sf.pm - $main::cache->{marc_record} = $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"; - } - } - - print STDERR "\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); - } +if ($log->is_debug) { + $log->debug("lookup hash: ",Dumper($webpac->{'lookup'})); + $log->debug("data hash: ",Dumper($webpac->{'data'})); } -# call this to commit index $index->close; -1; -__END__ -########################################################################## - -=head1 NAME - -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 -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 -is best documentation. I even made considerable effort to comment parts -which are not intuitively clear, so... - -=head1 AUTHOR - -Dobrica Pavlinusic - -=head1 COPYRIGHT - -GNU Public License (GPL) v2 or later - -=head1 SEE ALSO - -SWISH-E web site at http://www.swish-e.org - -=cut