/[webpac]/trunk2/lib/WebPAC.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 /trunk2/lib/WebPAC.pm

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

revision 368 by dpavlin, Thu Jun 17 12:27:02 2004 UTC revision 371 by dpavlin, Thu Jun 17 20:44:45 2004 UTC
# Line 7  use Carp; Line 7  use Carp;
7  use Text::Iconv;  use Text::Iconv;
8  use Config::IniFiles;  use Config::IniFiles;
9  use XML::Simple;  use XML::Simple;
10    use Template;
11    
12  use Data::Dumper;  use Data::Dumper;
13    
# Line 60  sub new { Line 61  sub new {
61          # read global.conf          # read global.conf
62          #          #
63    
64          $self->{global_config_file} = new Config::IniFiles( -file => 'global.conf' ) || croak "can't open 'global.conf'";          my $config = new Config::IniFiles( -file => 'global.conf' ) || croak "can't open 'global.conf'";
65    
66          # read global config parametars          # read global config parametars
67          foreach my $var (qw(          foreach my $var (qw(
# Line 70  sub new { Line 71  sub new {
71                          dbi_passwd                          dbi_passwd
72                          show_progress                          show_progress
73                          my_unac_filter                          my_unac_filter
74                            output_template
75                  )) {                  )) {
76                  $self->{global_config}->{$var} = $self->{global_config_file}->val('global', $var);                  $self->{'global_config'}->{$var} = $config->val('global', $var);
77          }          }
78    
79          #          #
# Line 80  sub new { Line 82  sub new {
82    
83          $self->{indexer_config_file} = new Config::IniFiles( -file => $self->{config_file} ) || croak "can't open '$self->{config_file}'";          $self->{indexer_config_file} = new Config::IniFiles( -file => $self->{config_file} ) || croak "can't open '$self->{config_file}'";
84    
85            # create UTF-8 convertor for import_xml files
86          $self->{'utf2cp'} = Text::Iconv->new('UTF-8' ,$self->{'code_page'});          $self->{'utf2cp'} = Text::Iconv->new('UTF-8' ,$self->{'code_page'});
87    
88            # create Template toolkit instance
89            $self->{'tt'} = Template->new(
90                    INCLUDE_PATH => ($self->{'global_config_file'}->{'output_template'} || './output_template'),
91    #               FILTERS => {
92    #                       'foo' => \&foo_filter,
93    #               },
94                    EVAL_PERL => 1,
95            );
96    
97          return $self;          return $self;
98  }  }
99    
# Line 220  sub open_import_xml { Line 233  sub open_import_xml {
233    
234          $self->{'tag'} = $type2tag{$type_base};          $self->{'tag'} = $type2tag{$type_base};
235    
236          print STDERR "using type ",$self->{'type'}," tag ",$self->{'tag'},"\n" if ($self->{'debug'});          print STDERR "using type '",$self->{'type'},"' tag <",$self->{'tag'},">\n" if ($self->{'debug'});
237    
238          my $f = "./import_xml/".$self->{'type'}.".xml";          my $f = "./import_xml/".$self->{'type'}.".xml";
239          confess "import_xml file '$f' doesn't exist!" if (! -e "$f");          confess "import_xml file '$f' doesn't exist!" if (! -e "$f");
# Line 232  sub open_import_xml { Line 245  sub open_import_xml {
245                  ForceContent => 1                  ForceContent => 1
246          );          );
247    
         print Dumper($self->{'import_xml'});  
   
248  }  }
249    
250  =head2 create_lookup  =head2 create_lookup
# Line 338  delimiters before fields which aren't us Line 349  delimiters before fields which aren't us
349    
350  =cut  =cut
351    
352    # internal function to eval code
353    sub _eval {
354            my $self = shift;
355    
356            my $code = shift || return;
357            no strict 'subs';
358            my $ret = eval $code;
359            if ($@) {
360                    print STDERR "problem with eval code [$code]: $@\n";
361            }
362            return $ret;
363    }
364    
365  sub fill_in {  sub fill_in {
366          my $self = shift;          my $self = shift;
367    
# Line 361  sub fill_in { Line 385  sub fill_in {
385          if ($found) {          if ($found) {
386                  if ($eval_code) {                  if ($eval_code) {
387                          my $eval = $self->fill_in($rec,$eval_code,$i);                          my $eval = $self->fill_in($rec,$eval_code,$i);
388                          return if (! eval $eval);                          return if (! $self->_eval($eval));
389                  }                  }
390                  # do we have lookups?                  # do we have lookups?
391                  if ($format =~ /\[[^\[\]]+\]/o) {                  if ($format =~ /\[[^\[\]]+\]/o) {
392    print "## probable lookup: $format\n";
393                          return $self->lookup($format);                          return $self->lookup($format);
394                  } else {                  } else {
395                          return $format;                          return $format;
# Line 391  sub lookup { Line 416  sub lookup {
416    
417          if ($tmp =~ /\[[^\[\]]+\]/o) {          if ($tmp =~ /\[[^\[\]]+\]/o) {
418                  my @in = ( $tmp );                  my @in = ( $tmp );
419    print "## lookup $tmp\n";
420                  my @out;                  my @out;
421                  while (my $f = shift @in) {                  while (my $f = shift @in) {
422                          if ($f =~ /\[([^\[\]]+)\]/) {                          if ($f =~ /\[([^\[\]]+)\]/) {
# Line 471  sub parse { Line 497  sub parse {
497    
498          if ($eval_code) {          if ($eval_code) {
499                  my $eval = $self->fill_in($rec,$eval_code,$i);                  my $eval = $self->fill_in($rec,$eval_code,$i);
500                  return if (! eval $eval);                  return if (! $self->_eval($eval));
501          }          }
502    
503          return $out;          return $out;
# Line 568  sub data_structure { Line 594  sub data_structure {
594    
595          }          }
596    
597          print "data_structure => ",Dumper(\@ds);          return @ds;
598    
599    }
600    
601    =head2 output
602    
603    Create output from in-memory data structure using Template Toolkit template.
604    
605    my $text = $webpac->output( template => 'text.tt', data => @ds );
606    
607    =cut
608    
609    sub output {
610            my $self = shift;
611    
612            my $args = {@_};
613    
614            confess("need template name") if (! $args->{'template'});
615            confess("need data array") if (! $args->{'data'});
616    
617            my $out;
618    
619            $self->{'tt'}->process(
620                    $args->{'template'},
621                    $args,
622                    \$out
623            ) || confess $self->{'tt'}->error();
624    
625            return $out;
626  }  }
627    
628  1;  1;

Legend:
Removed from v.368  
changed lines
  Added in v.371

  ViewVC Help
Powered by ViewVC 1.1.26