--- trunk2/lib/WebPAC.pm 2004/06/20 17:52:41 375 +++ trunk2/lib/WebPAC.pm 2004/09/10 22:24:42 421 @@ -29,20 +29,38 @@ =head2 new -This will create new instance of WebPAC using configuration specified by C. +Create new instance of WebPAC using configuration specified by C. my $webpac = new WebPAC( config_file => 'name.conf', [code_page => 'ISO-8859-2',] + [low_mem => 1,] ); Default C is C. -It will also read configuration files +This method will also read configuration files C (used by indexer and Web font-end) and configuration file specified by C which describes databases to be indexed. +C 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 ISIS database). + +If your machine has 512Mb or more 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 to handle +parsed structure of ISIS database. + +However, when WebPAC is running on desktop machines (or laptops :-), it's +highly undesireable for system to start swapping. Using C option can +reduce WecPAC memory usage to 16Mb 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. + =cut # mapping between data type and tag which specify @@ -106,6 +124,32 @@ EVAL_PERL => 1, ); + # running with low_mem flag? well, use DBM::Deep then. + if ($self->{'low_mem'}) { + $log->info("running with low_mem which impacts performance (<64 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"); + } + + use 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; + } + return $self; } @@ -149,6 +193,10 @@ $log->logcroak("need filename") if (! $arg->{'filename'}); my $code_page = $arg->{'code_page'} || '852'; + # store data in object + $self->{'isis_filename'} = $arg->{'filename'}; + $self->{'isis_code_page'} = $code_page; + use OpenIsis; #$self->{'isis_code_page'} = $code_page; @@ -157,6 +205,7 @@ my $cp = Text::Iconv->new($code_page,$self->{'code_page'}); $log->info("reading ISIS database '",$arg->{'filename'},"'"); + $log->debug("isis code page: $code_page"); my $isis_db = OpenIsis::open($arg->{'filename'}); @@ -169,6 +218,11 @@ # read database for (my $mfn = 1; $mfn <= $maxmfn; $mfn++) { + + $log->debug("mfn: $mfn\n"); + + my $rec; + # read record my $row = OpenIsis::read( $isis_db, $mfn ); foreach my $k (keys %{$row}) { @@ -186,21 +240,34 @@ $val = $l; } - push @{$self->{'data'}->{$mfn}->{$k}}, $val; + push @{$rec->{$k}}, $val; } } else { - push @{$self->{'data'}->{$mfn}->{'000'}}, $mfn; + push @{$rec->{'000'}}, $mfn; } } + $log->confess("record $mfn empty?") unless ($rec); + + # store + if ($self->{'low_mem'}) { + $self->{'db'}->put($mfn, $rec); + } else { + $self->{'data'}->{$mfn} = $rec; + } + # create lookup - my $rec = $self->{'data'}->{$mfn}; $self->create_lookup($rec, @{$arg->{'lookup'}}); + $self->progress_bar($mfn,$maxmfn); + } $self->{'current_mfn'} = 1; + $self->{'last_pcnt'} = 0; + + $log->debug("max mfn: $maxmfn"); # store max mfn and return it. return $self->{'max_mfn'} = $maxmfn; @@ -228,7 +295,48 @@ return; } - return $self->{'data'}->{$mfn}; + $self->progress_bar($mfn,$self->{'max_mfn'}); + + if ($self->{'low_mem'}) { + return $self->{'db'}->get($mfn); + } else { + return $self->{'data'}->{$mfn}; + } +} + +=head2 progress_bar + +Draw progress bar on STDERR. + + $webpac->progress_bar($current, $max); + +=cut + +sub progress_bar { + my $self = shift; + + my ($curr,$max) = @_; + + my $log = $self->_get_logger(); + + $log->logconfess("no current value!") if (! $curr); + $log->logconfess("no maximum value!") if (! $max); + + if ($curr > $max) { + $max = $curr; + $log->debug("overflow to $curr"); + } + + $self->{'last_pcnt'} ||= 1; + + $self->{'last_pcnt'} = $curr if ($curr < $self->{'last_pcnt'}); + + my $p = int($curr * 100 / $max); + if ($p != $self->{'last_pcnt'}) { + printf STDERR ("%5d / %5d [%-51s] %-2d %% \r",$curr,$max,"=" x ($p/2).">", $p ); + $self->{'last_pcnt'} = $p; + } + print STDERR "\n" if ($p == 100); } =head2 open_import_xml @@ -290,21 +398,23 @@ $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o); foreach my $i (@_) { - if ($i->{'eval'}) { - my $eval = $self->fill_in($rec,$i->{'eval'}); - my $key = $self->fill_in($rec,$i->{'key'}); - my @val = $self->fill_in($rec,$i->{'val'}); - if ($key && @val && eval $eval) { + $log->logconfess("need key") unless defined($i->{'key'}); + $log->logconfess("need val") unless defined($i->{'val'}); + + if (defined($i->{'eval'})) { + # eval first, so we can skip fill_in for key and val + my $eval = $self->fill_in($rec,$i->{'eval'}) || next; + if ($self->_eval($eval)) { + my $key = $self->fill_in($rec,$i->{'key'}) || next; + my @val = $self->fill_in($rec,$i->{'val'}) || next; $log->debug("stored $key = ",sub { join(" | ",@val) }); push @{$self->{'lookup'}->{$key}}, @val; } } else { - my $key = $self->fill_in($rec,$i->{'key'}); - my @val = $self->fill_in($rec,$i->{'val'}); - if ($key && @val) { - $log->debug("stored $key = ",sub { join(" | ",@val) }); - push @{$self->{'lookup'}->{$key}}, @val; - } + my $key = $self->fill_in($rec,$i->{'key'}) || next; + my @val = $self->fill_in($rec,$i->{'val'}) || next; + $log->debug("stored $key = ",sub { join(" | ",@val) }); + push @{$self->{'lookup'}->{$key}}, @val; } } } @@ -335,6 +445,7 @@ if ($$rec->{$f}) { return '' if (! $$rec->{$f}->[$i]); + no strict 'refs'; if ($sf && $$rec->{$f}->[$i]->{$sf}) { $$found++ if (defined($$found)); return $$rec->{$f}->[$i]->{$sf}; @@ -375,6 +486,9 @@ This function B perform parsing of format to inteligenty skip delimiters before fields which aren't used. +This method will automatically decode UTF-8 string to local code page +if needed. + =cut sub fill_in { @@ -390,6 +504,10 @@ # FIXME remove for speedup? $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o); + if (utf8::is_utf8($format)) { + $format = $self->_x($format); + } + my $found = 0; my $eval_code; @@ -609,7 +727,8 @@ my @ds = $webpac->data_structure($rec); This method will also set C<$webpac->{'currnet_filename'}> if there is - tag in C. + tag in C and C<$webpac->{'headline'}> if there is + tag. =cut @@ -622,6 +741,7 @@ $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o); undef $self->{'currnet_filename'}; + undef $self->{'headline'}; my @sorted_tags; if ($self->{tags_by_order}) { @@ -659,6 +779,15 @@ @v = map { $self->apply_format($tag->{'format_name'},$tag->{'format_delimiter'},$_) } @v; } + if ($field eq 'filename') { + $self->{'current_filename'} = join('',@v); + $log->debug("filename: ",$self->{'current_filename'}); + } elsif ($field eq 'headline') { + $self->{'headline'} .= join('',@v); + $log->debug("headline: ",$self->{'headline'}); + next; # don't return headline in data_structure! + } + # does tag have type? if ($tag->{'type'}) { push @{$row->{$tag->{'type'}}}, @v; @@ -667,10 +796,6 @@ push @{$row->{'swish'}}, @v; } - if ($field eq 'filename') { - $self->{'current_filename'} = join('',@v); - $log->debug("filename: ",$self->{'current_filename'}); - } } @@ -721,6 +846,38 @@ return $out; } +=head2 output_file + +Create output from in-memory data structure using Template Toolkit template +to a file. + + $webpac->output_file( + file => 'out.txt', + template => 'text.tt', + data => @ds + ); + +=cut + +sub output_file { + my $self = shift; + + my $args = {@_}; + + my $log = $self->_get_logger(); + + my $file = $args->{'file'} || $log->logconfess("need file name"); + + $log->debug("creating file ",$file); + + open(my $fh, ">", $file) || $log->logdie("can't open output file '$file': $!"); + print $fh $self->output( + template => $args->{'template'}, + data => $args->{'data'}, + ) || $log->logdie("print: $!"); + close($fh) || $log->logdie("close: $!"); +} + =head2 apply_format Apply format specified in tag with C and