/[webpac2]/trunk/lib/WebPAC/Input.pm
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/lib/WebPAC/Input.pm

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

revision 726 by dpavlin, Fri Sep 29 19:52:17 2006 UTC revision 1122 by dpavlin, Mon Nov 17 21:30:05 2008 UTC
# Line 7  use blib; Line 7  use blib;
7    
8  use WebPAC::Common;  use WebPAC::Common;
9  use base qw/WebPAC::Common/;  use base qw/WebPAC::Common/;
10  use Data::Dumper;  use Data::Dump qw/dump/;
11  use Encode qw/from_to/;  use Encode qw/decode from_to/;
12    
13  =head1 NAME  =head1 NAME
14    
15  WebPAC::Input - read different file formats into WebPAC  WebPAC::Input - read different file formats into WebPAC
16    
 =head1 VERSION  
   
 Version 0.13  
   
17  =cut  =cut
18    
19  our $VERSION = '0.13';  our $VERSION = '0.19';
20    
21  =head1 SYNOPSIS  =head1 SYNOPSIS
22    
# Line 43  Perhaps a little code snippet. Line 39  Perhaps a little code snippet.
39    
40          my $db = WebPAC::Input->new(          my $db = WebPAC::Input->new(
41                  module => 'WebPAC::Input::ISIS',                  module => 'WebPAC::Input::ISIS',
                 low_mem => 1,  
42          );          );
43    
44          $db->open( path => '/path/to/database' );          $db->open( path => '/path/to/database' );
# Line 62  Create new input database object. Line 57  Create new input database object.
57    
58    my $db = new WebPAC::Input(    my $db = new WebPAC::Input(
59          module => 'WebPAC::Input::MARC',          module => 'WebPAC::Input::MARC',
         encoding => 'ISO-8859-2',  
         low_mem => 1,  
60          recode => 'char pairs',          recode => 'char pairs',
61          no_progress_bar => 1,          no_progress_bar => 1,
62            input_config => {
63                    mapping => [ 'foo', 'bar', 'baz' ],
64            },
65    );    );
66    
67  C<module> is low-level file format module. See L<WebPAC::Input::ISIS> and  C<module> is low-level file format module. See L<WebPAC::Input::ISIS> and
68  L<WebPAC::Input::MARC>.  L<WebPAC::Input::MARC>.
69    
 Optional parametar C<encoding> specify application code page (which will be  
 used internally). This should probably be your terminal encoding, and by  
 default, it C<ISO-8859-2>.  
   
 Default is not to use C<low_mem> options (see L<MEMORY USAGE> below).  
   
70  C<recode> is optional string constisting of character or words pairs that  C<recode> is optional string constisting of character or words pairs that
71  should be replaced in input stream.  should be replaced in input stream.
72    
# Line 94  sub new { Line 84  sub new {
84    
85          my $log = $self->_get_logger;          my $log = $self->_get_logger;
86    
87          $log->logconfess("code_page argument is not suppored any more. change it to encoding") if ($self->{lookup});          $log->logconfess("code_page argument is not suppored any more.") if $self->{code_page};
88          $log->logconfess("lookup argument is not suppored any more. rewrite call to lookup_ref") if ($self->{lookup});          $log->logconfess("encoding argument is not suppored any more.") if $self->{encoding};
89            $log->logconfess("lookup argument is not suppored any more. rewrite call to lookup_ref") if $self->{lookup};
90            $log->logconfess("low_mem argument is not suppored any more. rewrite it to load_row and save_row") if $self->{low_mem};
91    
92          $log->logconfess("specify low-level file format module") unless ($self->{module});          $log->logconfess("specify low-level file format module") unless ($self->{module});
93          my $module_path = $self->{module};          my $module_path = $self->{module};
# Line 105  sub new { Line 97  sub new {
97    
98          require $module_path;          require $module_path;
99    
         # check if required subclasses are implemented  
         foreach my $subclass (qw/open_db fetch_rec init dump_rec/) {  
                 # FIXME  
         }  
   
         $self->{'encoding'} ||= 'ISO-8859-2';  
   
         # running with low_mem flag? well, use DBM::Deep then.  
         if ($self->{'low_mem'}) {  
                 $log->info("running with low_mem which impacts performance (<32 Mb memory usage)");  
   
                 my $db_file = "data.db";  
   
                 if (-e $db_file) {  
                         unlink $db_file or $log->logdie("can't remove '$db_file' from last run");  
                         $log->debug("removed '$db_file' from last run");  
                 }  
   
                 require DBM::Deep;  
   
                 my $db = new DBM::Deep $db_file;  
   
                 $log->logdie("DBM::Deep error: $!") unless ($db);  
   
                 if ($db->error()) {  
                         $log->logdie("can't open '$db_file' under low_mem: ",$db->error());  
                 } else {  
                         $log->debug("using file '$db_file' for DBM::Deep");  
                 }  
   
                 $self->{'db'} = $db;  
         }  
   
100          $self ? return $self : return undef;          $self ? return $self : return undef;
101  }  }
102    
# Line 145  sub new { Line 104  sub new {
104    
105  This function will read whole database in memory and produce lookups.  This function will read whole database in memory and produce lookups.
106    
107     my $store;     # simple in-memory hash
108    
109   $input->open(   $input->open(
110          path => '/path/to/database/file',          path => '/path/to/database/file',
111          code_page => 'cp852',          input_encoding => 'cp852',
112            strict_encoding => 0,
113          limit => 500,          limit => 500,
114          offset => 6000,          offset => 6000,
115          stats => 1,          stats => 1,
# Line 160  This function will read whole database i Line 122  This function will read whole database i
122                  901 => { '*' => { '^b' => ' ; ' } },                  901 => { '*' => { '^b' => ' ; ' } },
123          },          },
124          modify_file => 'conf/modify/mapping.map',          modify_file => 'conf/modify/mapping.map',
125            save_row => sub {
126                    my $a = shift;
127                    $store->{ $a->{id} } = $a->{row};
128            },
129            load_row => sub {
130                    my $a = shift;
131                    return defined($store->{ $a->{id} }) &&
132                            $store->{ $a->{id} };
133            },
134    
135   );   );
136    
137  By default, C<code_page> is assumed to be C<cp852>.  By default, C<input_encoding> is assumed to be C<cp852>.
138    
139  C<offset> is optional parametar to position at some offset before reading from database.  C<offset> is optional parametar to position at some offset before reading from database.
140    
# Line 180  C<modify_file> is alternative for C<modi Line 152  C<modify_file> is alternative for C<modi
152  (hopefully) simplier sintax than YAML or perl (see L</modify_file_regex>). This option  (hopefully) simplier sintax than YAML or perl (see L</modify_file_regex>). This option
153  overrides C<modify_records> if both exists for same input.  overrides C<modify_records> if both exists for same input.
154    
155    C<save_row> and C<load_row> are low-level implementation of store engine. Calling convention
156    is documented in example above.
157    
158    C<strict_encoding> should really default to 1, but it doesn't for now.
159    
160  Returns size of database, regardless of C<offset> and C<limit>  Returns size of database, regardless of C<offset> and C<limit>
161  parametars, see also C<size>.  parametars, see also C<size>.
162    
# Line 190  sub open { Line 167  sub open {
167          my $arg = {@_};          my $arg = {@_};
168    
169          my $log = $self->_get_logger();          my $log = $self->_get_logger();
170            $log->debug( "arguments: ",dump( $arg ));
171    
172            $log->logconfess("encoding argument is not suppored any more.") if $self->{encoding};
173            $log->logconfess("code_page argument is not suppored any more.") if $self->{code_page};
174          $log->logconfess("lookup argument is not suppored any more. rewrite call to lookup_coderef") if ($arg->{lookup});          $log->logconfess("lookup argument is not suppored any more. rewrite call to lookup_coderef") if ($arg->{lookup});
175          $log->logconfess("lookup_coderef must be CODE, not ",ref($arg->{lookup_coderef}))          $log->logconfess("lookup_coderef must be CODE, not ",ref($arg->{lookup_coderef}))
176                  if ($arg->{lookup_coderef} && ref($arg->{lookup_coderef}) ne 'CODE');                  if ($arg->{lookup_coderef} && ref($arg->{lookup_coderef}) ne 'CODE');
# Line 198  sub open { Line 178  sub open {
178          $log->debug( $arg->{lookup_coderef} ? '' : 'not ', "using lookup_coderef");          $log->debug( $arg->{lookup_coderef} ? '' : 'not ', "using lookup_coderef");
179    
180          $log->logcroak("need path") if (! $arg->{'path'});          $log->logcroak("need path") if (! $arg->{'path'});
181          my $code_page = $arg->{'code_page'} || 'cp852';          my $input_encoding = $arg->{'input_encoding'} || $self->{'input_encoding'} || 'cp852';
182    
183          # store data in object          # store data in object
         $self->{'input_code_page'} = $code_page;  
184          foreach my $v (qw/path offset limit/) {          foreach my $v (qw/path offset limit/) {
185                  $self->{$v} = $arg->{$v} if ($arg->{$v});                  $self->{$v} = $arg->{$v} if ($arg->{$v});
186          }          }
187    
188            if ($arg->{load_row} || $arg->{save_row}) {
189                    $log->logconfess("save_row and load_row must be defined in pair and be CODE") unless (
190                            ref($arg->{load_row}) eq 'CODE' &&
191                            ref($arg->{save_row}) eq 'CODE'
192                    );
193                    $self->{load_row} = $arg->{load_row};
194                    $self->{save_row} = $arg->{save_row};
195                    $log->debug("using load_row and save_row instead of in-memory hash");
196            }
197    
198          my $filter_ref;          my $filter_ref;
199          my $recode_regex;          my $recode_regex;
200          my $recode_map;          my $recode_map;
# Line 233  sub open { Line 222  sub open {
222                  $log->debug("using modify_file $p");                  $log->debug("using modify_file $p");
223                  $rec_regex = $self->modify_file_regexps( $p );                  $rec_regex = $self->modify_file_regexps( $p );
224          } elsif (my $h = $arg->{modify_records}) {          } elsif (my $h = $arg->{modify_records}) {
225                  $log->debug("using modify_records ", Dumper( $h ));                  $log->debug("using modify_records ", sub { dump( $h ) });
226                  $rec_regex = $self->modify_record_regexps(%{ $h });                  $rec_regex = $self->modify_record_regexps(%{ $h });
227          }          }
228          $log->debug("rec_regex: ", Dumper($rec_regex)) if ($rec_regex);          $log->debug("rec_regex: ", sub { dump($rec_regex) }) if ($rec_regex);
229    
230          my $class = $self->{module} || $log->logconfess("can't get low-level module name!");          my $class = $self->{module} || $log->logconfess("can't get low-level module name!");
231    
232          my $ll_db = $class->new(          my $ll_db = $class->new(
233                  path => $arg->{path},                  path => $arg->{path},
234                    input_config => $arg->{input_config} || $self->{input_config},
235  #               filter => sub {  #               filter => sub {
236  #                       my ($l,$f_nr) = @_;  #                       my ($l,$f_nr) = @_;
237  #                       return unless defined($l);  #                       return unless defined($l);
238  #                       from_to($l, $code_page, $self->{'encoding'});  #                       $l = decode($input_encoding, $l);
239  #                       $l =~ s/($recode_regex)/$recode_map->{$1}/g if ($recode_regex && $recode_map);  #                       $l =~ s/($recode_regex)/$recode_map->{$1}/g if ($recode_regex && $recode_map);
240  #                       return $l;  #                       return $l;
241  #               },  #               },
# Line 283  sub open { Line 273  sub open {
273          # store size for later          # store size for later
274          $self->{size} = ($to_rec - $from_rec) ? ($to_rec - $from_rec + 1) : 0;          $self->{size} = ($to_rec - $from_rec) ? ($to_rec - $from_rec + 1) : 0;
275    
276          $log->info("processing $self->{size}/$size records [$from_rec-$to_rec] convert $code_page -> $self->{encoding}", $self->{stats} ? ' [stats]' : '');          my $strict_encoding = $arg->{strict_encoding} || $self->{strict_encoding}; ## FIXME should be 1 really
277    
278            $log->info("processing $self->{size}/$size records [$from_rec-$to_rec]",
279                    " encoding $input_encoding ", $strict_encoding ? ' [strict]' : '',
280                    $self->{stats} ? ' [stats]' : '',
281            );
282    
283          # read database          # read database
284          for (my $pos = $from_rec; $pos <= $to_rec; $pos++) {          for (my $pos = $from_rec; $pos <= $to_rec; $pos++) {
# Line 291  sub open { Line 286  sub open {
286                  $log->debug("position: $pos\n");                  $log->debug("position: $pos\n");
287    
288                  my $rec = $ll_db->fetch_rec($pos, sub {                  my $rec = $ll_db->fetch_rec($pos, sub {
289                                  my ($l,$f_nr) = @_;                                  my ($l,$f_nr,$debug) = @_;
290  #                               return unless defined($l);  #                               return unless defined($l);
291  #                               return $l unless ($rec_regex && $f_nr);  #                               return $l unless ($rec_regex && $f_nr);
292    
293                                    return unless ( defined($l) && defined($f_nr) );
294    
295                                    warn "-=> $f_nr ## |$l|\n" if ($debug);
296                                  $log->debug("-=> $f_nr ## $l");                                  $log->debug("-=> $f_nr ## $l");
297    
298                                  # codepage conversion and recode_regex                                  # codepage conversion and recode_regex
299                                  from_to($l, $code_page, $self->{'encoding'});                                  $l = decode($input_encoding, $l, 1);
300                                  $l =~ s/($recode_regex)/$recode_map->{$1}/g if ($recode_regex && $recode_map);                                  $l =~ s/($recode_regex)/$recode_map->{$1}/g if ($recode_regex && $recode_map);
301    
302                                  # apply regexps                                  # apply regexps
# Line 307  sub open { Line 305  sub open {
305                                          my $c = 0;                                          my $c = 0;
306                                          foreach my $r (@{ $rec_regex->{$f_nr} }) {                                          foreach my $r (@{ $rec_regex->{$f_nr} }) {
307                                                  my $old_l = $l;                                                  my $old_l = $l;
308                                                  eval '$l =~ ' . $r;                                                  $log->logconfess("expected regex in ", dump( $r )) unless defined($r->{regex});
309                                                    eval '$l =~ ' . $r->{regex};
310                                                  if ($old_l ne $l) {                                                  if ($old_l ne $l) {
311                                                          $log->debug("REGEX on $f_nr eval \$l =~ $r\n## old l: [$old_l]\n## new l: [$l]");                                                          my $d = "|$old_l| -> |$l| "; # . $r->{regex};
312                                                            $d .= ' +' . $r->{line} . ' ' . $r->{file} if defined($r->{line});
313                                                            $d .= ' ' . $r->{debug} if defined($r->{debug});
314                                                            $log->debug("MODIFY $d");
315                                                            warn "*** $d\n" if ($debug);
316    
317                                                  }                                                  }
318                                                  $log->error("error applying regex: $r") if ($@);                                                  $log->error("error applying regex: ",dump($r), $@) if $@;
319                                          }                                          }
320                                  }                                  }
321    
322                                  $log->debug("<=- $f_nr ## $l");                                  $log->debug("<=- $f_nr ## |$l|");
323                                    warn "<=- $f_nr ## $l\n" if ($debug);
324                                  return $l;                                  return $l;
325                  });                  });
326    
327                  $log->debug(sub { Dumper($rec) });                  $log->debug(sub { dump($rec) });
328    
329                  if (! $rec) {                  if (! $rec) {
330                          $log->warn("record $pos empty? skipping...");                          $log->warn("record $pos empty? skipping...");
# Line 327  sub open { Line 332  sub open {
332                  }                  }
333    
334                  # store                  # store
335                  if ($self->{low_mem}) {                  if ($self->{save_row}) {
336                          $self->{db}->put($pos, $rec);                          $self->{save_row}->({
337                                    id => $pos,
338                                    row => $rec,
339                            });
340                  } else {                  } else {
341                          $self->{data}->{$pos} = $rec;                          $self->{data}->{$pos} = $rec;
342                  }                  }
# Line 345  sub open { Line 353  sub open {
353                          foreach my $fld (keys %{ $rec }) {                          foreach my $fld (keys %{ $rec }) {
354                                  $self->{_stats}->{fld}->{ $fld }++;                                  $self->{_stats}->{fld}->{ $fld }++;
355    
356                                  $log->logdie("invalid record fild $fld, not ARRAY")                                  #$log->logdie("invalid record fild $fld, not ARRAY")
357                                          unless (ref($rec->{ $fld }) eq 'ARRAY');                                  next unless (ref($rec->{ $fld }) eq 'ARRAY');
358                    
359                                  foreach my $row (@{ $rec->{$fld} }) {                                  foreach my $row (@{ $rec->{$fld} }) {
360    
# Line 377  sub open { Line 385  sub open {
385          $self->{max_pos} = $to_rec;          $self->{max_pos} = $to_rec;
386          $log->debug("max_pos: $to_rec");          $log->debug("max_pos: $to_rec");
387    
388            # save for dump
389            $self->{ll_db} = $ll_db;
390    
391          return $size;          return $size;
392  }  }
393    
# Line 416  sub fetch { Line 427  sub fetch {
427    
428          my $rec;          my $rec;
429    
430          if ($self->{low_mem}) {          if ($self->{load_row}) {
431                  $rec = $self->{db}->get($mfn);                  $rec = $self->{load_row}->({ id => $mfn });
432          } else {          } else {
433                  $rec = $self->{data}->{$mfn};                  $rec = $self->{data}->{$mfn};
434          }          }
# Line 472  First record in database has position 1. Line 483  First record in database has position 1.
483    
484  sub seek {  sub seek {
485          my $self = shift;          my $self = shift;
486          my $pos = shift || return;          my $pos = shift;
487    
488          my $log = $self->_get_logger();          my $log = $self->_get_logger();
489    
490            $log->logconfess("called without pos") unless defined($pos);
491    
492          if ($pos < 1) {          if ($pos < 1) {
493                  $log->warn("seek before first record");                  $log->warn("seek before first record");
494                  $pos = 1;                  $pos = 1;
# Line 510  sub stats { Line 523  sub stats {
523    
524          my $out = join("\n",          my $out = join("\n",
525                  map {                  map {
526                          my $f = $_ || die "no field";                          my $f = $_;
527                            die "no field in ", dump( $s->{fld} ) unless defined( $f );
528                          my $v = $s->{fld}->{$f} || die "no s->{fld}->{$f}";                          my $v = $s->{fld}->{$f} || die "no s->{fld}->{$f}";
529                          $max_fld = $v if ($v > $max_fld);                          $max_fld = $v if ($v > $max_fld);
530    
531                          my $o = sprintf("%4s %d ~", $f, $v);                          my $o = sprintf("%4s %d ~", $f, $v);
532    
533                          if (defined($s->{sf}->{$f})) {                          if (defined($s->{sf}->{$f})) {
534                                    my @subfields = keys %{ $s->{sf}->{$f} };
535                                  map {                                  map {
536                                          $o .= sprintf(" %s:%d%s", $_,                                          $o .= sprintf(" %s:%d%s", $_,
537                                                  $s->{sf}->{$f}->{$_}->{count},                                                  $s->{sf}->{$f}->{$_}->{count},
538                                                  $s->{sf}->{$f}->{$_}->{repeatable} ? '*' : '',                                                  $s->{sf}->{$f}->{$_}->{repeatable} ? '*' : '',
539                                          );                                          );
540                                  } sort keys %{ $s->{sf}->{$f} };                                  } (
541                                            # first indicators and other special subfields
542                                            sort( grep { length($_)  > 1 } @subfields ),
543                                            # then subfileds (single char)
544                                            sort( grep { length($_) == 1 } @subfields ),
545                                    );
546                          }                          }
547    
548                          if (my $v_r = $s->{repeatable}->{$f}) {                          if (my $v_r = $s->{repeatable}->{$f}) {
# Line 530  sub stats { Line 550  sub stats {
550                          }                          }
551    
552                          $o;                          $o;
553                  } sort { $a cmp $b } keys %{ $s->{fld} }                  } sort {
554                            if ( $a =~ m/^\d+$/ && $b =~ m/^\d+$/ ) {
555                                    $a <=> $b
556                            } else {
557                                    $a cmp $b
558                            }
559                    } keys %{ $s->{fld} }
560          );          );
561    
562          $log->debug( sub { Dumper($s) } );          $log->debug( sub { dump($s) } );
563    
564          return $out;          return $out;
565  }  }
566    
567  =head2 dump  =head2 dump_ascii
568    
569  Display humanly readable dump of record  Display humanly readable dump of record
570    
571  =cut  =cut
572    
573  sub dump {  sub dump_ascii {
574          my $self = shift;          my $self = shift;
575    
576          return $self->{dump_rec}->($self, $self->{pos});          return unless $self->{ll_db};
577    
578            if ($self->{ll_db}->can('dump_ascii')) {
579                    return $self->{ll_db}->dump_ascii( $self->{pos} );
580            } else {
581                    return dump( $self->{ll_db}->fetch_rec( $self->{pos} ) );
582            }
583  }  }
584    
585  =head2 modify_record_regexps  =head2 _get_regex
586    
587  Generate hash with regexpes to be applied using l<filter>.  Helper function called which create regexps to be execute on code.
588    
589    my $regexpes = $input->modify_record_regexps(    _get_regex( 900, 'regex:[0-9]+' ,'numbers' );
590                  900 => { '^a' => { ' : ' => '^b' } },    _get_regex( 900, '^b', ' : ^b' );
591                  901 => { '*' => { '^b' => ' ; ' } },  
592    );  It supports perl regexps with C<regex:> prefix to from value and has
593    additional logic to skip empty subfields.
594    
595  =cut  =cut
596    
597  sub _get_regex {  sub _get_regex {
598          my ($sf,$from,$to) = @_;          my ($sf,$from,$to) = @_;
599    
600            # protect /
601            $from =~ s!/!\\/!gs;
602            $to =~ s!/!\\/!gs;
603    
604            if ($from =~ m/^regex:(.+)$/) {
605                    $from = $1;
606            } else {
607                    $from = '\Q' . $from . '\E';
608            }
609          if ($sf =~ /^\^/) {          if ($sf =~ /^\^/) {
610                    my $need_subfield_data = '*';   # no
611                    # if from is also subfield, require some data in between
612                    # to correctly skip empty subfields
613                    $need_subfield_data = '+' if ($from =~ m/^\\Q\^/);
614                  return                  return
615                          's/\Q'. $sf .'\E([^\^]*?)\Q'. $from .'\E([^\^]*?)/'. $sf .'$1'. $to .'$2/';                          's/\Q'. $sf .'\E([^\^]' . $need_subfield_data . '?)'. $from .'([^\^]*?)/'. $sf .'$1'. $to .'$2/';
616          } else {          } else {
617                  return                  return
618                          's/\Q'. $from .'\E/'. $to .'/g';                          's/'. $from .'/'. $to .'/g';
619          }          }
620  }  }
621    
622    
623    =head2 modify_record_regexps
624    
625    Generate hash with regexpes to be applied using L<filter>.
626    
627      my $regexpes = $input->modify_record_regexps(
628                    900 => { '^a' => { ' : ' => '^b' } },
629                    901 => { '*' => { '^b' => ' ; ' } },
630      );
631    
632    =cut
633    
634  sub modify_record_regexps {  sub modify_record_regexps {
635          my $self = shift;          my $self = shift;
636          my $modify_record = {@_};          my $modify_record = {@_};
# Line 590  sub modify_record_regexps { Line 648  sub modify_record_regexps {
648                          foreach my $from (keys %{ $modify_record->{$f}->{$sf} }) {                          foreach my $from (keys %{ $modify_record->{$f}->{$sf} }) {
649                                  my $to = $modify_record->{$f}->{$sf}->{$from};                                  my $to = $modify_record->{$f}->{$sf}->{$from};
650                                  #die "no field?" unless defined($to);                                  #die "no field?" unless defined($to);
651                                  $log->debug("transform: |$from| -> |$to|");                                  my $d = "|$from| -> |$to|";
652                                    $log->debug("transform: $d");
653    
654                                  my $regex = _get_regex($sf,$from,$to);                                  my $regex = _get_regex($sf,$from,$to);
655                                  push @{ $regexpes->{$f} }, $regex;                                  push @{ $regexpes->{$f} }, { regex => $regex, debug => $d };
656                                  $log->debug("regex: $regex");                                  $log->debug("regex: $regex");
657                          }                          }
658                  }                  }
# Line 604  sub modify_record_regexps { Line 663  sub modify_record_regexps {
663    
664  =head2 modify_file_regexps  =head2 modify_file_regexps
665    
666  Generate hash with regexpes to be applied using l<filter> from  Generate hash with regexpes to be applied using L<filter> from
667  pseudo hash/yaml format for regex mappings.  pseudo hash/yaml format for regex mappings.
668    
669  It should be obvious:  It should be obvious:
# Line 654  sub modify_file_regexps { Line 713  sub modify_file_regexps {
713                          $log->debug("transform: |$from| -> |$to|");                          $log->debug("transform: |$from| -> |$to|");
714    
715                          my $regex = _get_regex($sf,$from,$to);                          my $regex = _get_regex($sf,$from,$to);
716                          push @{ $regexpes->{$f} }, $regex;                          push @{ $regexpes->{$f} }, {
717                                    regex => $regex,
718                                    file => $modify_path,
719                                    line => $.,
720                            };
721                          $log->debug("regex: $regex");                          $log->debug("regex: $regex");
722                    } else {
723                            die "can't parse: $_";
724                  }                  }
725          }          }
726    
727          return $regexpes;          return $regexpes;
728  }  }
729    
 =head1 MEMORY USAGE  
   
 C<low_mem> options is double-edged sword. If enabled, WebPAC  
 will run on memory constraint machines (which doesn't have enough  
 physical RAM to create memory structure for whole source database).  
   
 If your machine has 512Mb or more of RAM and database is around 10000 records,  
 memory shouldn't be an issue. If you don't have enough physical RAM, you  
 might consider using virtual memory (if your operating system is handling it  
 well, like on FreeBSD or Linux) instead of dropping to L<DBM::Deep> to handle  
 parsed structure of ISIS database (this is what C<low_mem> option does).  
   
 Hitting swap at end of reading source database is probably o.k. However,  
 hitting swap before 90% will dramatically decrease performance and you will  
 be better off with C<low_mem> and using rest of availble memory for  
 operating system disk cache (Linux is particuallary good about this).  
 However, every access to database record will require disk access, so  
 generation phase will be slower 10-100 times.  
   
 Parsed structures are essential - you just have option to trade RAM memory  
 (which is fast) for disk space (which is slow). Be sure to have planty of  
 disk space if you are using C<low_mem> and thus L<DBM::Deep>.  
   
 However, when WebPAC is running on desktop machines (or laptops :-), it's  
 highly undesireable for system to start swapping. Using C<low_mem> option can  
 reduce WecPAC memory usage to around 64Mb for same database with lookup  
 fields and sorted indexes which stay in RAM. Performance will suffer, but  
 memory usage will really be minimal. It might be also more confortable to  
 run WebPAC reniced on those machines.  
   
   
730  =head1 AUTHOR  =head1 AUTHOR
731    
732  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
Legend:
Removed from v.726  
changed lines
  Added in v.1122
  ViewVC Help
Powered by ViewVC 1.1.26