/[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 374 by dpavlin, Sun Jun 20 16:57:52 2004 UTC revision 375 by dpavlin, Sun Jun 20 17:52:41 2004 UTC
# Line 254  sub open_import_xml { Line 254  sub open_import_xml {
254    
255          $self->{'tag'} = $type2tag{$type_base};          $self->{'tag'} = $type2tag{$type_base};
256    
257          $log->debug("using type '",$self->{'type'},"' tag <",$self->{'tag'},">") if ($self->{'debug'});          $log->info("using type '",$self->{'type'},"' tag <",$self->{'tag'},">");
258    
259          my $f = "./import_xml/".$self->{'type'}.".xml";          my $f = "./import_xml/".$self->{'type'}.".xml";
260          $log->logconfess("import_xml file '$f' doesn't exist!") if (! -e "$f");          $log->logconfess("import_xml file '$f' doesn't exist!") if (! -e "$f");
261    
262          $log->debug("reading '$f'") if ($self->{'debug'});          $log->info("reading '$f'");
263    
264            $self->{'import_xml_file'} = $f;
265    
266          $self->{'import_xml'} = XMLin($f,          $self->{'import_xml'} = XMLin($f,
267                  ForceArray => [ $self->{'tag'}, 'config', 'format' ],                  ForceArray => [ $self->{'tag'}, 'config', 'format' ],
268          );          );
269    
270            $log->debug("import xml is ",sub { Dumper($self->{'import_xml'}) });
271    
272  }  }
273    
274  =head2 create_lookup  =head2 create_lookup
# Line 483  sub parse { Line 487  sub parse {
487    
488          $i = 0 if (! $i);          $i = 0 if (! $i);
489    
490          my $format = $self->{'utf2cp'}->convert($format_utf8) || $log->logconfess("can't convert '$format_utf8' from UTF-8 to ",$self->{'code_page'});          my $format = $self->_x($format_utf8) || $log->logconfess("can't convert '$format_utf8' from UTF-8 to ",$self->{'code_page'});
491    
492          my @out;          my @out;
493    
# Line 650  sub data_structure { Line 654  sub data_structure {
654                          }                          }
655                          next if (! @v);                          next if (! @v);
656    
657                            # use format?
658                            if ($tag->{'format_name'}) {
659                                    @v = map { $self->apply_format($tag->{'format_name'},$tag->{'format_delimiter'},$_) } @v;
660                            }
661    
662                          # does tag have type?                          # does tag have type?
663                          if ($tag->{'type'}) {                          if ($tag->{'type'}) {
664                                  push @{$row->{$tag->{'type'}}}, @v;                                  push @{$row->{$tag->{'type'}}}, @v;
# Line 667  sub data_structure { Line 676  sub data_structure {
676    
677                  if ($row) {                  if ($row) {
678                          $row->{'tag'} = $field;                          $row->{'tag'} = $field;
679    
680                            # TODO: name_sigular, name_plural
681                            my $name = $self->{'import_xml'}->{'indexer'}->{$field}->{'name'};
682                            $row->{'name'} = $name ? $self->_x($name) : $field;
683    
684                          push @ds, $row;                          push @ds, $row;
685    
686                          $log->debug("row $field: ",sub { Dumper($row) });                          $log->debug("row $field: ",sub { Dumper($row) });
# Line 707  sub output { Line 721  sub output {
721          return $out;          return $out;
722  }  }
723    
724    =head2 apply_format
725    
726    Apply format specified in tag with C<format_name="name"> and
727    C<format_delimiter=";;">.
728    
729     my $text = $webpac->apply_format($format_name,$format_delimiter,$data);
730    
731    Formats can contain C<lookup{...}> if you need them.
732    
733    =cut
734    
735    sub apply_format {
736            my $self = shift;
737    
738            my ($name,$delimiter,$data) = @_;
739    
740            my $log = $self->_get_logger();
741    
742            if (! $self->{'import_xml'}->{'format'}->{$name}) {
743                    $log->warn("<format name=\"$name\"> is not defined in ",$self->{'import_xml_file'});
744                    return $data;
745            }
746    
747            $log->warn("no delimiter for format $name") if (! $delimiter);
748    
749            my $format = $self->_x($self->{'import_xml'}->{'format'}->{$name}->{'content'}) || $log->logdie("can't find format '$name'");
750    
751            my @data = split(/\Q$delimiter\E/, $data);
752    
753            my $out = sprintf($format, @data);
754            $log->debug("using format $name [$format] on $data to produce: $out");
755    
756            if ($out =~ m/$LOOKUP_REGEX/o) {
757                    return $self->lookup($out);
758            } else {
759                    return $out;
760            }
761    
762    }
763    
764    
765  #  #
766  #  #
767  #  #
# Line 759  sub _sort_by_order { Line 814  sub _sort_by_order {
814          return $va <=> $vb;          return $va <=> $vb;
815  }  }
816    
817    =head2 _get_logger
818    
819    Get C<Log::Log4perl> object with a twist: domains are defined for each
820    method
821    
822     my $log = $webpac->_get_logger();
823    
824    =cut
825    
826  sub _get_logger {  sub _get_logger {
827          my $self = shift;          my $self = shift;
828    
# Line 766  sub _get_logger { Line 830  sub _get_logger {
830          return get_logger($name);          return get_logger($name);
831  }  }
832    
833    =head2 _x
834    
835    Convert string from UTF-8 to code page defined in C<import_xml>.
836    
837     my $text = $webpac->_x('utf8 text');
838    
839    =cut
840    
841    sub _x {
842            my $self = shift;
843            my $utf8 = shift || return;
844    
845            return $self->{'utf2cp'}->convert($utf8) ||
846                    $self->_get_logger()->logwarn("can't convert '$utf8'");
847    }
848    
849  #  #
850  #  #
851  #  #

Legend:
Removed from v.374  
changed lines
  Added in v.375

  ViewVC Help
Powered by ViewVC 1.1.26