/[webpac2]/trunk/run.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/run.pl

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

revision 510 by dpavlin, Mon May 15 17:38:22 2006 UTC revision 607 by dpavlin, Tue Aug 1 14:15:50 2006 UTC
# Line 4  use strict; Line 4  use strict;
4    
5  use Cwd qw/abs_path/;  use Cwd qw/abs_path/;
6  use File::Temp qw/tempdir/;  use File::Temp qw/tempdir/;
 use Data::Dumper;  
7  use lib './lib';  use lib './lib';
8    
9  use WebPAC::Common 0.02;  use WebPAC::Common 0.02;
10  use WebPAC::Lookup;  use WebPAC::Lookup 0.03;
11  use WebPAC::Input 0.03;  use WebPAC::Input 0.07;
12  use WebPAC::Store 0.03;  use WebPAC::Store 0.03;
13  use WebPAC::Normalize::XML;  use WebPAC::Normalize 0.11;
 use WebPAC::Normalize::Set;  
14  use WebPAC::Output::TT;  use WebPAC::Output::TT;
15    use WebPAC::Validate;
16    use WebPAC::Output::MARC;
17  use YAML qw/LoadFile/;  use YAML qw/LoadFile/;
18  use Getopt::Long;  use Getopt::Long;
19  use File::Path;  use File::Path;
20  use Time::HiRes qw/time/;  use Time::HiRes qw/time/;
21  use File::Slurp;  use File::Slurp;
22    use Data::Dump qw/dump/;
23    use Storable qw/dclone/;
24    
25    use Proc::Queue size => 1;
26    use POSIX ":sys_wait_h"; # imports WNOHANG
27    
28  =head1 NAME  =head1 NAME
29    
# Line 53  or C<type> from input Line 58  or C<type> from input
58    
59  path to YAML configuration file  path to YAML configuration file
60    
 =item --force-set  
   
 force conversion C<< normalize->path >> in C<config.yml> from  
 C<.xml> to C<.pl>  
   
61  =item --stats  =item --stats
62    
63  disable indexing and dump statistics about field and subfield  disable indexing and dump statistics about field and subfield
64  usage for each input  usage for each input
65    
66    =item --validate path/to/validation_file
67    
68    turn on extra validation of imput records, see L<WebPAC::Validation>
69    
70    =item --marc-normalize conf/normalize/mapping.pl
71    
72    This option specifies normalisation file for MARC creation
73    
74    =item --marc-output out/marc/test.marc
75    
76    Optional path to output file
77    
78    =item --marc-lint
79    
80    By default turned on if C<--marc-normalize> is used. You can disable lint
81    messages with C<--no-marc-lint>.
82    
83    =item --marc-dump
84    
85    Force dump or input and marc record for debugging.
86    
87    =item --parallel 4
88    
89    Run databases in parallel (aproximatly same as number of processors in
90    machine if you want to use full load)
91    
92    =item --only-links
93    
94    Create just links
95    
96  =back  =back
97    
98  =cut  =cut
# Line 74  my $clean = 0; Line 104  my $clean = 0;
104  my $config = 'conf/config.yml';  my $config = 'conf/config.yml';
105  my $debug = 0;  my $debug = 0;
106  my $only_filter;  my $only_filter;
 my $force_set = 0;  
107  my $stats = 0;  my $stats = 0;
108    my $validate_path;
109    my ($marc_normalize, $marc_output);
110    my $marc_lint = 1;
111    my $marc_dump = 0;
112    my $parallel = 0;
113    my $only_links = 0;
114    
115  GetOptions(  GetOptions(
116          "limit=i" => \$limit,          "limit=i" => \$limit,
# Line 84  GetOptions( Line 119  GetOptions(
119          "one=s" => \$only_filter,          "one=s" => \$only_filter,
120          "only=s" => \$only_filter,          "only=s" => \$only_filter,
121          "config" => \$config,          "config" => \$config,
122          "debug" => \$debug,          "debug+" => \$debug,
         "force-set" => \$force_set,  
123          "stats" => \$stats,          "stats" => \$stats,
124            "validate=s" => \$validate_path,
125            "marc-normalize=s" => \$marc_normalize,
126            "marc-output=s" => \$marc_output,
127            "marc-lint!" => \$marc_lint,
128            "marc-dump!" => \$marc_dump,
129            "parallel=i" => \$parallel,
130            "only-links!" => \$only_links,
131  );  );
132    
133  $config = LoadFile($config);  $config = LoadFile($config);
134    
135  print "config = ",Dumper($config) if ($debug);  print "config = ",dump($config) if ($debug);
136    
137  die "no databases in config file!\n" unless ($config->{databases});  die "no databases in config file!\n" unless ($config->{databases});
138    
139  my $log = _new WebPAC::Common()->_get_logger();  my $log = _new WebPAC::Common()->_get_logger();
140  $log->info( "-" x 79 );  $log->info( "-" x 79 );
141    
142    my $validate;
143    $validate = new WebPAC::Validate(
144            path => $validate_path,
145    ) if ($validate_path);
146    
147  my $use_indexer = $config->{use_indexer} || 'hyperestraier';  my $use_indexer = $config->{use_indexer} || 'hyperestraier';
148  if ($stats) {  if ($stats) {
149          $log->debug("option --stats disables update of indexing engine...");          $log->debug("option --stats disables update of indexing engine...");
# Line 106  if ($stats) { Line 152  if ($stats) {
152          $log->info("using $use_indexer indexing engine...");          $log->info("using $use_indexer indexing engine...");
153  }  }
154    
155    # disable indexing when creating marc
156    $use_indexer = undef if ($marc_normalize);
157    
158  my $total_rows = 0;  my $total_rows = 0;
159  my $start_t = time();  my $start_t = time();
160    
161    my @links;
162    
163    if ($parallel) {
164            $log->info("Using $parallel processes for speedup");
165            Proc::Queue::size($parallel);
166    }
167    
168  while (my ($database, $db_config) = each %{ $config->{databases} }) {  while (my ($database, $db_config) = each %{ $config->{databases} }) {
169    
170          my ($only_database,$only_input) = split(m#/#, $only_filter);          my ($only_database,$only_input) = split(m#/#, $only_filter) if ($only_filter);
171          next if ($only_database && $database !~ m/$only_database/i);          next if ($only_database && $database !~ m/$only_database/i);
172    
173          my $indexer;          if ($parallel) {
174                    my $f=fork;
175                    if(defined ($f) and $f==0) {
176                            $log->info("Created processes $$ for speedup");
177                    } else {
178                            next;
179                    }
180            }
181    
182            my $indexer;
183          if ($use_indexer) {          if ($use_indexer) {
184                  my $indexer_config = $config->{$use_indexer} || $log->logdie("can't find '$use_indexer' part in confguration");                  my $indexer_config = $config->{$use_indexer} || $log->logdie("can't find '$use_indexer' part in confguration");
185                  $indexer_config->{database} = $database;                  $indexer_config->{database} = $database;
# Line 144  while (my ($database, $db_config) = each Line 208  while (my ($database, $db_config) = each
208    
209    
210          #          #
211            # store Hyper Estraier links to other databases
212            #
213            if (ref($db_config->{links}) eq 'ARRAY' && $use_indexer) {
214                    foreach my $link (@{ $db_config->{links} }) {
215                            if ($use_indexer eq 'hyperestraier') {
216                                    $log->info("saving link $database -> $link->{to} [$link->{credit}]");
217                                    push @links, sub {
218                                            $log->info("adding link $database -> $link->{to} [$link->{credit}]");
219                                            $indexer->add_link(
220                                                    from => $database,
221                                                    to => $link->{to},
222                                                    credit => $link->{credit},
223                                            );
224                                    };
225                            } else {
226                                    $log->warn("NOT IMPLEMENTED WITH $use_indexer: adding link $database -> $link->{to} [$link->{credit}]");
227                            }
228                    }
229            }
230            next if ($only_links);
231    
232    
233            #
234          # now WebPAC::Store          # now WebPAC::Store
235          #          #
236          my $abs_path = abs_path($0);          my $abs_path = abs_path($0);
# Line 152  while (my ($database, $db_config) = each Line 239  while (my ($database, $db_config) = each
239          my $db_path = $config->{webpac}->{db_path} . '/' . $database;          my $db_path = $config->{webpac}->{db_path} . '/' . $database;
240    
241          if ($clean) {          if ($clean) {
242                  $log->info("creating new database $database in $db_path");                  $log->info("creating new database '$database' in $db_path");
243                  rmtree( $db_path ) || $log->warn("can't remove $db_path: $!");                  rmtree( $db_path ) || $log->warn("can't remove $db_path: $!");
244          } else {          } else {
245                  $log->debug("working on $database in $db_path");                  $log->info("working on database '$database' in $db_path");
246          }          }
247    
248          my $db = new WebPAC::Store(          my $db = new WebPAC::Store(
# Line 182  while (my ($database, $db_config) = each Line 269  while (my ($database, $db_config) = each
269    
270          foreach my $input (@inputs) {          foreach my $input (@inputs) {
271    
272                  next if ($only_input && $input->{name} =~ m#$only_input#i || $input->{type} =~ m#$only_input#i);                  next if ($only_input && ($input->{name} !~ m#$only_input#i && $input->{type} !~ m#$only_input#i));
273    
274                  my $type = lc($input->{type});                  my $type = lc($input->{type});
275    
276                  die "I know only how to handle input types ", join(",", @supported_inputs), " not '$type'!\n" unless (grep(/$type/, @supported_inputs));                  die "I know only how to handle input types ", join(",", @supported_inputs), " not '$type'!\n" unless (grep(/$type/, @supported_inputs));
277    
278                  my $lookup = new WebPAC::Lookup(                  my $lookup;
279                          lookup_file => $input->{lookup},                  if ($input->{lookup}) {
280                  );                          $lookup = new WebPAC::Lookup(
281                                    lookup_file => $input->{lookup},
282                            );
283                            delete( $input->{lookup} );
284                    }
285    
286                  my $input_module = $config->{webpac}->{inputs}->{$type};                  my $input_module = $config->{webpac}->{inputs}->{$type};
287    
288                  $log->info("working on input '$input->{path}' [$input->{type}] using $input_module lookup '$input->{lookup}'");                  $log->info("working on input '$input->{name}' in $input->{path} [type: $input->{type}] using $input_module",
289                            $input->{lookup} ? "lookup '$input->{lookup}'" : ""
290                    );
291    
292                  my $input_db = new WebPAC::Input(                  my $input_db = new WebPAC::Input(
293                          module => $input_module,                          module => $input_module,
294                          code_page => $config->{webpac}->{webpac_encoding},                          encoding => $config->{webpac}->{webpac_encoding},
295                          limit => $limit || $input->{limit},                          limit => $limit || $input->{limit},
296                          offset => $offset,                          offset => $offset,
297                          lookup => $lookup,                          lookup_coderef => sub {
298                                    my $rec = shift || return;
299                                    $lookup->add( $rec );
300                            },
301                          recode => $input->{recode},                          recode => $input->{recode},
302                          stats => $stats,                          stats => $stats,
303                            modify_records => $input->{modify_records},
304                  );                  );
305                  $log->logdie("can't create input using $input_module") unless ($input);                  $log->logdie("can't create input using $input_module") unless ($input);
306    
307                  my $maxmfn = $input_db->open(                  my $maxmfn = $input_db->open(
308                          path => $input->{path},                          path => $input->{path},
309                          code_page => $input->{encoding},        # database encoding                          code_page => $input->{encoding},        # database encoding
310                            %{ $input },
311                  );                  );
312    
313                  my $n = new WebPAC::Normalize::XML(                  my @norm_array = ref($input->{normalize}) eq 'ARRAY' ?
314                  #       filter => { 'foo' => sub { shift } },                          @{ $input->{normalize} } : ( $input->{normalize} );
                         db => $db,  
                         lookup_regex => $lookup->regex,  
                         lookup => $lookup,  
                         prefix => $input->{name},  
                 );  
   
                 my $rules;  
                 my $normalize_path = $input->{normalize}->{path};  
315    
316                  if ($force_set) {                  if ($marc_normalize) {
317                          my $new_norm_path = $normalize_path;                          @norm_array = ( {
318                          $new_norm_path =~ s/\.xml$/.pl/;                                  path => $marc_normalize,
319                          if (-e $new_norm_path) {                                  output => $marc_output || 'out/marc/' . $database . '-' . $input->{name} . '.marc',
320                                  $log->debug("--force-set replaced $normalize_path with $new_norm_path");                          } );
                                 $normalize_path = $new_norm_path;  
                         } else {  
                                 $log->debug("--force-set failed on $new_norm_path, fallback to $normalize_path");  
                         }  
321                  }                  }
322    
323                  if ($normalize_path =~ m/\.xml$/i) {                  foreach my $normalize (@norm_array) {
                         $n->open(  
                                 tag => $input->{normalize}->{tag},  
                                 xml_file => $normalize_path,  
                         );  
                 } elsif ($normalize_path =~ m/\.(?:yml|yaml)$/i) {  
                         $n->open_yaml(  
                                 path => $normalize_path,  
                                 tag => $input->{normalize}->{tag},  
                         );  
                 } elsif ($normalize_path =~ m/\.(?:pl)$/i) {  
                         $n = undef;  
                         $log->info("using WebPAC::Normalize::Set to process $normalize_path");  
                         $rules = read_file( $normalize_path ) or die "can't open $normalize_path: $!";  
                 }  
324    
325                  foreach my $pos ( 0 ... $input_db->size ) {                          my $normalize_path = $normalize->{path} || $log->logdie("can't find normalize path in config");
326    
327                          my $row = $input_db->fetch || next;                          $log->logdie("Found '$normalize_path' as normalization file which isn't supported any more!") unless ( $normalize_path =~ m!\.pl$!i );
328    
329                          my $mfn = $row->{'000'}->[0];                          my $rules = read_file( $normalize_path ) or die "can't open $normalize_path: $!";
330    
331                          if (! $mfn || $mfn !~ m#^\d+$#) {                          $log->info("Using $normalize_path for normalization...");
                                 $log->warn("record $pos doesn't have valid MFN but '$mfn', using $pos");  
                                 $mfn = $pos;  
                                 push @{ $row->{'000'} }, $pos;  
                         }  
332    
333                                                            my $marc = new WebPAC::Output::MARC(
334                          my $ds;                                  path => $normalize->{output},
335                          if ($n) {                                  lint => $marc_lint,
336                                  $ds = $n->data_structure($row);                                  dump => $marc_dump,
337                          } else {                          ) if ($normalize->{output});
338                                  $ds = WebPAC::Normalize::Set::data_structure(  
339                            # reset position in database
340                            $input_db->seek(1);
341    
342                            foreach my $pos ( 0 ... $input_db->size ) {
343    
344                                    my $row = $input_db->fetch || next;
345    
346                                    my $mfn = $row->{'000'}->[0];
347    
348                                    if (! $mfn || $mfn !~ m#^\d+$#) {
349                                            $log->warn("record $pos doesn't have valid MFN but '$mfn', using $pos");
350                                            $mfn = $pos;
351                                            push @{ $row->{'000'} }, $pos;
352                                    }
353    
354    
355                                    if ($validate) {
356                                            my @errors = $validate->validate_errors( $row );
357                                            $log->error( "MFN $mfn validation errors:\n", join("\n", @errors) ) if (@errors);
358                                    }
359    
360                                    my $ds_config = dclone($db_config);
361    
362                                    # default values -> database key
363                                    $ds_config->{_} = $database;
364    
365                                    # current mfn
366                                    $ds_config->{_mfn} = $mfn;
367    
368                                    # attach current input
369                                    $ds_config->{input} = $input;
370    
371                                    my $ds = WebPAC::Normalize::data_structure(
372                                          row => $row,                                          row => $row,
373                                          rules => $rules,                                          rules => $rules,
374                                          lookup => $lookup->lookup_hash,                                          lookup => $lookup ? $lookup->lookup_hash : undef,
375                                            config => $ds_config,
376                                            marc_encoding => 'utf-8',
377                                  );                                  );
378    
379                                  $db->save_ds(                                  $db->save_ds(
# Line 278  while (my ($database, $db_config) = each Line 381  while (my ($database, $db_config) = each
381                                          ds => $ds,                                          ds => $ds,
382                                          prefix => $input->{name},                                          prefix => $input->{name},
383                                  ) if ($ds && !$stats);                                  ) if ($ds && !$stats);
384    
385                                    $indexer->add(
386                                            id => $input->{name} . "/" . $mfn,
387                                            ds => $ds,
388                                            type => $config->{$use_indexer}->{type},
389                                    ) if ($indexer && $ds);
390    
391                                    if ($marc) {
392                                            my $i = 0;
393    
394                                            while (my $fields = WebPAC::Normalize::_get_marc_fields( fetch_next => 1 ) ) {
395                                                    $marc->add(
396                                                            id => $mfn . ( $i ? "/$i" : '' ),
397                                                            fields => $fields,
398                                                            leader => WebPAC::Normalize::marc_leader(),
399                                                            row => $row,
400                                                    );
401                                                    $i++;
402                                            }
403    
404                                            $log->info("Created $i instances of MFN $mfn\n") if ($i > 1);
405                                    }
406    
407                                    $total_rows++;
408                          }                          }
409    
410                          $indexer->add(                          $log->info("statistics of fields usage:\n", $input_db->stats) if ($stats);
                                 id => $input->{name} . "/" . $mfn,  
                                 ds => $ds,  
                                 type => $config->{$use_indexer}->{type},  
                         ) if ($indexer);  
411    
412                          $total_rows++;                          # close MARC file
413                  }                          $marc->finish if ($marc);
414    
415                  $log->info("statistics of fields usage:\n", $input_db->stats) if ($stats);                  }
416    
417          };          }
418    
419          eval { $indexer->finish } if ($indexer && $indexer->can('finish'));          eval { $indexer->finish } if ($indexer && $indexer->can('finish'));
420    
421          my $dt = time() - $start_t;          my $dt = time() - $start_t;
422          $log->info("$total_rows records indexed in " .          $log->info("$total_rows records ", $indexer ? "indexed " : "",
423                  sprintf("%.2f sec [%.2f rec/sec]",                  sprintf("in %.2f sec [%.2f rec/sec]",
424                          $dt, ($total_rows / $dt)                          $dt, ($total_rows / $dt)
425                  )                  )
426          );          );
427    
428          #  
429          # add Hyper Estraier links to other databases          # end forked process
430          #          if ($parallel) {
431          if (ref($db_config->{links}) eq 'ARRAY') {                  $log->info("parallel process $$ finished");
432                  foreach my $link (@{ $db_config->{links} }) {                  exit(0);
                         if ($use_indexer eq 'hyperestraier') {  
                                 $log->info("adding link $database -> $link->{to} [$link->{credit}]");  
                                 $indexer->add_link(  
                                         from => $database,  
                                         to => $link->{to},  
                                         credit => $link->{credit},  
                                 );  
                         } else {  
                                 $log->warn("NOT IMPLEMENTED WITH $use_indexer: adding link $database -> $link->{to} [$link->{credit}]");  
                         }  
                 }  
433          }          }
434    
435  }  }
436    
437    if ($parallel) {
438            # wait all children to finish
439            sleep(1) while wait != -1;
440            $log->info("all parallel processes finished");
441    }
442    
443    
444    foreach my $link (@links) {
445            $log->logdie("coderef in link ", Dumper($link), " is ", ref($link), " and not CODE") unless (ref($link) eq 'CODE');
446            $link->();
447    }
448    
Legend:
Removed from v.510  
changed lines
  Added in v.607
  ViewVC Help
Powered by ViewVC 1.1.26