git.rot13.org Git - webpac/blob - all2xml.pl

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use OpenIsis;
   5 use Getopt::Std;
   6 use Data::Dumper;
   7 use XML::Simple;
   8 use Text::Unaccent 1.02;        # 1.01 won't compile on my platform,
   9 require Unicode::Map8;
  10 use DBI;
  11
  12 my $config=XMLin(undef, forcearray => [ 'isis' ], forcecontent => 1);
  13 my $dbh = DBI->connect("DBI:Pg:dbname=webpac","","") || die $DBI::errstr; # FIX
  14 # FIX; select relname from pg_class where relname like 'index_%' ;
  15 $dbh->begin_work || die $dbh->errstr();
  16
  17 $dbh->do("delete from index_author") || die $dbh->errstr();
  18 $dbh->do("delete from index_title") || die $dbh->errstr();
  19
  20 my %opts;
  21
  22 # usage:
  23 #       -d directory name
  24 #       -m multiple directories
  25 #       -q quiet
  26 #       -s run swish
  27
  28 getopts('d:m:qs', \%opts);
  29
  30 my $db_dir = $opts{d} || "ps";  # FIX
  31
  32 #die "usage: $0 -d [database_dir] -m [database1,database2] " if (! %opts);
  33
  34 #print Dumper($config->{indexer});
  35 #print "-" x 70,"\n";
  36
  37 # how to convert isis code page to UTF8?
  38 my $isis_map = Unicode::Map8->new($config->{isis_codepage}) || die;
  39
  40 sub isis2xml {
  41
  42         my $row = shift @_;
  43
  44         my $xml;
  45         $xml->{db_dir} = [ $db_dir ];   # FIX remove?
  46
  47         sub isis_sf {
  48                 my $row = shift @_;
  49                 my $isis_id = shift @_;
  50                 my $subfield = shift @_;
  51                 if ($row->{$isis_id}->[0]) {
  52                         my $sf = OpenIsis::subfields($row->{$isis_id}->[0]);
  53                         if (! defined $subfield || length($subfield) == 0) {
  54                                 # subfield list undef, empty or no defined subfields for this record
  55                                 my $all_sf = $row->{$isis_id}->[0];
  56                                 $all_sf =~ s/\^./ /g;   nuke definirions
  57                                 return $all_sf;
  58                         } elsif ($sf->{$subfield}) {
  59                                 return $sf->{$subfield};
  60                         }
  61                 }
  62         }
  63
  64         foreach my $field (keys %{$config->{indexer}}) {
  65
  66                 my $display_data = "";
  67                 my $swish_data = "";
  68                 my $index_data = "";
  69
  70                 foreach my $x (@{$config->{indexer}->{$field}->{isis}}) {
  71
  72                         my $display_tmp = "";
  73                         my $swish_tmp = "";
  74                         my $index_tmp = "";
  75
  76                         my $format = $x->{content};
  77                         my $s = 1;      # swish only
  78                         my $d = 1;      # display only
  79                         my $i = 0;      # index only
  80                         $s = 0 if (lc($x->{type}) eq "display");
  81                         $d = 0 if (lc($x->{type}) eq "swish");
  82                         ($s,$d,$i) = (0,0,1) if (lc($x->{type}) eq "index");
  83 #print STDERR "## s: $s d: $d i: $i ## $format ##\n";
  84                         # parse format
  85                         my $prefix = "";
  86                         if ($format =~ s/^([^\d]+)//) {
  87                                 $prefix = $1;
  88                         }
  89                         while ($format) {
  90                                 if ($format =~ s/^(\d\d\d)(\w?)//) {
  91                                         my $isis_tmp = isis_sf($row,$1,$2);
  92                                         if ($isis_tmp) {
  93 #                                               $display_tmp .= $prefix . "/$1/$2/".$isis_tmp if ($d);
  94                                                 $display_tmp .= $prefix . $isis_tmp if ($d);
  95                                                 $swish_tmp .= $isis_tmp." " if ($s);
  96                                                 $index_tmp .= $prefix . $isis_tmp if ($i);
  97 #print STDERR " $isis_tmp <--\n";
  98                                         }
  99                                         $prefix = "";
 100                                 } elsif ($format =~ s/^([^\d]+)//) {
 101                                         $prefix = $1;
 102                                 } else {
 103                                         print STDERR "WARNING: unparsed format '$format'\n";
 104                                         last;
 105                                 };
 106                         }
 107                         # add suffix
 108                         $display_tmp .= $prefix if ($display_tmp);
 109                         $index_tmp .= $prefix if ($index_tmp);
 110
 111 #                       $display_data .= $display_tmp if ($display_tmp ne "");
 112 #                       $swish_data .= $swish_tmp if ($swish_tmp ne "");
 113                         $display_data .= $display_tmp;
 114                         $swish_data .= $swish_tmp;
 115                         $index_data .= $index_tmp;
 116
 117                 }
 118 #print "--display:$display_data\n--swish:$swish_data\n";
 119                 #$xml->{$field."_display"} = $isis_map->tou($display_data)->utf8 if ($display_data);
 120                 #$xml->{$field."_swish"} = unac_string($config->{isis_codepage},$swish_data) if ($swish_data);
 121                 $xml->{$field."_display" } = [ $isis_map->tou($display_data)->utf8 ] if ($display_data);
 122                 $xml->{$field."_swish"} = [ unac_string($config->{isis_codepage},$swish_data) ] if ($swish_data);
 123
 124                 # index
 125                 if ($index_data && $index_data ne "") {
 126                         my $sql = "select $field from index_$field where upper($field)=upper(?)";
 127                         my $sth = $dbh->prepare($sql) || die $dbh->errstr();
 128                         $sth->execute($index_data) || die "SQL: $sql; ".$dbh->errstr();
 129 #print STDERR "--->$index_data<---\n";
 130                         if (! $sth->fetchrow_hashref) {
 131                                 my $sql = "insert into index_$field values (?)";
 132                                 my $sth = $dbh->prepare($sql) || die $dbh->errstr();
 133 #print STDERR "$sql: $index_data<!----\n";
 134                                 $sth->execute($index_data) || die "SQL: $sql; ".$dbh->errstr();
 135                         }
 136                 }
 137
 138         }
 139         if ($xml) {
 140                 return XMLout($xml, rootname => 'xml', keeproot => 0, noattr => 0 );
 141         } else {
 142                 return;
 143         }
 144 }
 145
 146 ##########################################################################
 147
 148 my $last_tell=0;
 149
 150 my @isis_dirs = ( '.' );        # use dirname as database name
 151
 152 if ($opts{m}) {
 153         @isis_dirs = split(/,/,$opts{m});
 154 }
 155
 156 my @isis_dbs;
 157
 158 foreach (@isis_dirs) {
 159         if (-e $config->{isis_data}."/$db_dir/$_/LIBRI") {
 160                 push @isis_dbs,$config->{isis_data}."/$db_dir/$_/LIBRI/LIBRI";
 161         }
 162         if (-e $config->{isis_data}."/$db_dir/$_/PERI") {
 163                 push @isis_dbs,$config->{isis_data}."/$db_dir/$_/PERI/PERI";
 164         }
 165         if (-e $config->{isis_data}."/$db_dir/$_/AMS") {
 166                 push @isis_dbs,$config->{isis_data}."/$db_dir/$_/AMS/AMS";
 167         }
 168         if (-e $config->{isis_data}."/$db_dir/$_/ARTI") {
 169 #               push @isis_dbs,$config->{isis_data}."/$db_dir/$_/ARTI/ARTI";
 170         }
 171 }
 172
 173 print STDERR "FATAL: Can't find isis database.\nPerhaps isis_data (".$config->{isis_data}.") has wrong value?\n" if (! @isis_dbs);
 174
 175 my $db;
 176
 177 foreach my $isis_db (@isis_dbs) {
 178
 179
 180         my $db = OpenIsis::open( $isis_db );
 181         if (0) {
 182 #       # FIX
 183 #       if (! $db ) {
 184                 print STDERR "WARNING: can't open '$isis_db'\n";
 185                 next ;
 186         }
 187
 188         my $max_rowid = OpenIsis::maxRowid( $db );
 189
 190         print STDERR "Reading database: $isis_db [$max_rowid rows]\n";
 191
 192         my $last_p = 0;
 193
 194 #       { my $row_id = 1;
 195 # FIX
 196         for (my $row_id = 1; $row_id <= $max_rowid; $row_id++ ) {
 197                 my $row = OpenIsis::read( $db, $row_id );
 198                 if ($row && $row->{mfn}) {
 199
 200                         # output current process indicator
 201                         my $p = int($row->{mfn} * 100 / $max_rowid);
 202                         if ($p != $last_p) {
 203                                 printf STDERR ("%5d / %5d [%-51s] %-2d %% \r",$row->{mfn},$max_rowid,"=" x ($p/2).">", $p ) if (! $opts{q});
 204                                 $last_p = $p;
 205                         }
 206
 207                         if (my $xml = isis2xml($row)) {
 208                                 my $path = $isis_db;
 209                                 $path =~ s#$config->{isis_data}/*##g;
 210                                 my $out = "Path-Name: $path#".$row->{mfn}."\n";
 211                                 $out .= "Content-Length: ".(length($xml)+1)."\n";
 212                                 $out .= "Document-Type: XML\n\n$xml\n";
 213                                 print $out;
 214                         }
 215                 }
 216         }
 217         print STDERR "\n";
 218 }
 219
 220 $dbh->commit || die $dbh->errstr();
 221
 222 1;
 223 __END__
 224 ##########################################################################
 225
 226 =head1 NAME
 227
 228 isis2xml.pl - read isis file and dump XML
 229
 230 =head1 DESCRIPTION
 231
 232 This command will read ISIS data file using OpenIsis perl module and
 233 create XML file for usage with I<SWISH-E>
 234 indexer. Dispite it's name, this script B<isn't general xml generator>
 235 from isis files (isis allready has something like that). Output of this
 236 script is tailor-made for SWISH-E.
 237
 238 =head1 AUTHOR
 239
 240 Dobrica Pavlinusic <dpavlin@rot13.org>
 241
 242 =head1 COPYRIGHT
 243
 244 GNU Public License (GPL) v2 or later
 245
 246 =head1 SEE ALSO
 247
 248 SWISH-E web site at http://www.swish-e.org
 249
 250 =cut