--- trunk2/all2all.pl 2004/06/16 11:29:37 353 +++ trunk2/all2all.pl 2004/06/17 01:44:25 366 @@ -2,7 +2,7 @@ =head1 NAME -all2all.pl - basic script for all WebPac needs +all2all.pl - basic script for all WebPAC needs =cut @@ -11,17 +11,18 @@ use Carp; use lib './lib'; -use WebPac; +use WebPAC; -my $webpac = new WebPac( +my $webpac = new WebPAC( code_page => 'ISO-8859-2', + limit_mfn => 5, + debug => 1, ) || die; $|=1; -print "reading database\n"; my $maxmfn = $webpac->open_isis( - filename => shift @ARGV || '/data/hidra/THS-500/THS', + 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' }, @@ -33,22 +34,34 @@ print "rows: $maxmfn\n\n"; -for (my $mfn = 1; $mfn <= $maxmfn; $mfn++) { - my $rec = $webpac->{'data'}->{$mfn} || die "no record with mfn $mfn"; +$webpac->open_import_xml(type => 'isis_hidra_ths'); - print "-- ",$webpac->fill_in($rec,'v250^a (v901^a)'),"\n"; +while (my $rec = $webpac->fetch_rec) { + + my $ds = $webpac->data_structure($rec); + + if(0) { + + print "-- ",$webpac->parse($rec,'v250^a / [v562^4] v562^a'),"\n"; + + print " ", + $webpac->parse($rec,'eval{v901^a eq "Deskriptor"}v250^a / [v562^4] v562^a'), + $webpac->parse($rec,'eval{v901^a ne "Deskriptor"}250a [251]'), + "\n"; my @t = $webpac->fill_in($rec,'v553^1;;v553^a'); print " Uži pojam: ",join("\t\n",@t),"\n" if (@t); - @t = $webpac->fill_in($rec,'[a:v251::];;[d:[a:v251::]]'); + @t = $webpac->fill_in($rec,'eval{v901^a eq "Područje"}[a:v251::];;[d:[a:v251::]]'); print " Područje: ",join("\t\n",@t),"\n" if (@t); - @t = $webpac->fill_in($rec,'[a:v561^4:v251:];;[d:[a:v561^4:v251:]]'); + @t = $webpac->fill_in($rec,'eval{v901^a eq "Mikrotezaurus"}[a:v561^4:v251:];;[d:[a:v561^4:v251:]]'); print " Mikrotezaurus: ",join("\t\n",@t),"\n" if (@t); - @t = $webpac->fill_in($rec,'[a:v561^4:v562^4:v900];;[d:[a:v561^4:v562^4:v900]]'); + @t = $webpac->fill_in($rec,'eval{v901^a eq "Deskriptor"}[a:v561^4:v562^4:v900];;[d:[a:v561^4:v562^4:v900]]'); print " Deskriptor: ",join("\t\n",@t),"\n" if (@t); + } + } print "## lookup ",Dumper($webpac->{'lookup'});