/[webpac]/trunk/all2xml.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /trunk/all2xml.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1 by dpavlin, Sun Nov 24 20:52:11 2002 UTC revision 9 by dpavlin, Sat Jan 11 19:55:30 2003 UTC
# Line 5  use OpenIsis; Line 5  use OpenIsis;
5  use Getopt::Std;  use Getopt::Std;
6  use Data::Dumper;  use Data::Dumper;
7  use XML::Simple;  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  my $config=XMLin();  $dbh->do("delete from index_author") || die $dbh->errstr();
18    $dbh->do("delete from index_title") || die $dbh->errstr();
 print Dumper($config);  
19    
20  my %opts;  my %opts;
21    
22  getopts('d:m:q', \%opts);  # 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 $db_dir = $opts{d};                  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  die "usage: $0 -d [database_dir] -m [database1,database2] " if (! %opts);          }
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;  my $last_tell=0;
149    
# Line 31  if ($opts{m}) { Line 156  if ($opts{m}) {
156  my @isis_dbs;  my @isis_dbs;
157    
158  foreach (@isis_dirs) {  foreach (@isis_dirs) {
159          if (-e "$common::isis_data/$db_dir/$_/LIBRI") {          if (-e $config->{isis_data}."/$db_dir/$_/LIBRI") {
160                  push @isis_dbs,"$common::isis_data/$db_dir/$_/LIBRI/LIBRI";                  push @isis_dbs,$config->{isis_data}."/$db_dir/$_/LIBRI/LIBRI";
161          }          }
162          if (-e "$common::isis_data/$db_dir/$_/PERI") {          if (-e $config->{isis_data}."/$db_dir/$_/PERI") {
163                  push @isis_dbs,"$common::isis_data/$db_dir/$_/PERI/PERI";                  push @isis_dbs,$config->{isis_data}."/$db_dir/$_/PERI/PERI";
164          }          }
165          if (-e "$common::isis_data/$db_dir/$_/AMS") {          if (-e $config->{isis_data}."/$db_dir/$_/AMS") {
166                  push @isis_dbs,"$common::isis_data/$db_dir/$_/AMS/AMS";                  push @isis_dbs,$config->{isis_data}."/$db_dir/$_/AMS/AMS";
167          }          }
168          if (-e "$common::isis_data/$db_dir/$_/ARTI") {          if (-e $config->{isis_data}."/$db_dir/$_/ARTI") {
169  #               push @isis_dbs,"$common::isis_data/$db_dir/$_/ARTI/ARTI";  #               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) {  foreach my $isis_db (@isis_dbs) {
178    
179          my $db = OpenIsis::open( "$isis_db" ) || warn "can't open '$isis_db'";  
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 );          my $max_rowid = OpenIsis::maxRowid( $db );
189    
190          my $last_pcnt = 0;          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++ ) {          for (my $row_id = 1; $row_id <= $max_rowid; $row_id++ ) {
197                  my $row = OpenIsis::read( $db, $row_id );                  my $row = OpenIsis::read( $db, $row_id );
198                    if ($row && $row->{mfn}) {
199    
200                  # output current process indicator                          # output current process indicator
201                  my $pcnt = int($row->{mfn} * 100 / $max_rowid);                          my $p = int($row->{mfn} * 100 / $max_rowid);
202                  if ($pcnt != $last_pcnt) {                          if ($p != $last_p) {
203                          printf STDERR ("%5d / %5d -- %-2d %%\n",$row->{mfn},$max_rowid,$pcnt) if (! $opts{q});                                  printf STDERR ("%5d / %5d [%-51s] %-2d %% \r",$row->{mfn},$max_rowid,"=" x ($p/2).">", $p ) if (! $opts{q});
204                          $last_pcnt = $pcnt;                                  $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

Legend:
Removed from v.1  
changed lines
  Added in v.9

  ViewVC Help
Powered by ViewVC 1.1.26