/[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 376 by dpavlin, Sun Jun 20 18:39:30 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 371  Following example will read second value Line 375  Following example will read second value
375  This function B<does not> perform parsing of format to inteligenty skip  This function B<does not> perform parsing of format to inteligenty skip
376  delimiters before fields which aren't used.  delimiters before fields which aren't used.
377    
378    This method will automatically decode UTF-8 string to local code page
379    if needed.
380    
381  =cut  =cut
382    
383  sub fill_in {  sub fill_in {
# Line 386  sub fill_in { Line 393  sub fill_in {
393          # FIXME remove for speedup?          # FIXME remove for speedup?
394          $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);          $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);
395    
396            if (utf8::is_utf8($format)) {
397                    $format = $self->_x($format);
398            }
399    
400          my $found = 0;          my $found = 0;
401    
402          my $eval_code;          my $eval_code;
# Line 483  sub parse { Line 494  sub parse {
494    
495          $i = 0 if (! $i);          $i = 0 if (! $i);
496    
497          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'});
498    
499          my @out;          my @out;
500    
# Line 650  sub data_structure { Line 661  sub data_structure {
661                          }                          }
662                          next if (! @v);                          next if (! @v);
663    
664                            # use format?
665                            if ($tag->{'format_name'}) {
666                                    @v = map { $self->apply_format($tag->{'format_name'},$tag->{'format_delimiter'},$_) } @v;
667                            }
668    
669                          # does tag have type?                          # does tag have type?
670                          if ($tag->{'type'}) {                          if ($tag->{'type'}) {
671                                  push @{$row->{$tag->{'type'}}}, @v;                                  push @{$row->{$tag->{'type'}}}, @v;
# Line 667  sub data_structure { Line 683  sub data_structure {
683    
684                  if ($row) {                  if ($row) {
685                          $row->{'tag'} = $field;                          $row->{'tag'} = $field;
686    
687                            # TODO: name_sigular, name_plural
688                            my $name = $self->{'import_xml'}->{'indexer'}->{$field}->{'name'};
689                            $row->{'name'} = $name ? $self->_x($name) : $field;
690    
691                          push @ds, $row;                          push @ds, $row;
692    
693                          $log->debug("row $field: ",sub { Dumper($row) });                          $log->debug("row $field: ",sub { Dumper($row) });
# Line 707  sub output { Line 728  sub output {
728          return $out;          return $out;
729  }  }
730    
731    =head2 apply_format
732    
733    Apply format specified in tag with C<format_name="name"> and
734    C<format_delimiter=";;">.
735    
736     my $text = $webpac->apply_format($format_name,$format_delimiter,$data);
737    
738    Formats can contain C<lookup{...}> if you need them.
739    
740    =cut
741    
742    sub apply_format {
743            my $self = shift;
744    
745            my ($name,$delimiter,$data) = @_;
746    
747            my $log = $self->_get_logger();
748    
749            if (! $self->{'import_xml'}->{'format'}->{$name}) {
750                    $log->warn("<format name=\"$name\"> is not defined in ",$self->{'import_xml_file'});
751                    return $data;
752            }
753    
754            $log->warn("no delimiter for format $name") if (! $delimiter);
755    
756            my $format = $self->_x($self->{'import_xml'}->{'format'}->{$name}->{'content'}) || $log->logdie("can't find format '$name'");
757    
758            my @data = split(/\Q$delimiter\E/, $data);
759    
760            my $out = sprintf($format, @data);
761            $log->debug("using format $name [$format] on $data to produce: $out");
762    
763            if ($out =~ m/$LOOKUP_REGEX/o) {
764                    return $self->lookup($out);
765            } else {
766                    return $out;
767            }
768    
769    }
770    
771    
772  #  #
773  #  #
774  #  #
# Line 759  sub _sort_by_order { Line 821  sub _sort_by_order {
821          return $va <=> $vb;          return $va <=> $vb;
822  }  }
823    
824    =head2 _get_logger
825    
826    Get C<Log::Log4perl> object with a twist: domains are defined for each
827    method
828    
829     my $log = $webpac->_get_logger();
830    
831    =cut
832    
833  sub _get_logger {  sub _get_logger {
834          my $self = shift;          my $self = shift;
835    
# Line 766  sub _get_logger { Line 837  sub _get_logger {
837          return get_logger($name);          return get_logger($name);
838  }  }
839    
840    =head2 _x
841    
842    Convert string from UTF-8 to code page defined in C<import_xml>.
843    
844     my $text = $webpac->_x('utf8 text');
845    
846    =cut
847    
848    sub _x {
849            my $self = shift;
850            my $utf8 = shift || return;
851    
852            return $self->{'utf2cp'}->convert($utf8) ||
853                    $self->_get_logger()->logwarn("can't convert '$utf8'");
854    }
855    
856  #  #
857  #  #
858  #  #

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

  ViewVC Help
Powered by ViewVC 1.1.26