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

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

revision 12 by dpavlin, Sat Jul 16 22:57:26 2005 UTC revision 13 by dpavlin, Sat Jul 16 23:56:14 2005 UTC
# Line 3  package WebPAC::Normalize::XML; Line 3  package WebPAC::Normalize::XML;
3  use warnings;  use warnings;
4  use strict;  use strict;
5    
6  use base qw/WebPAC::Common/;  use base qw/WebPAC::Common WebPAC::Normalize/;
7  use Storable;  use Storable;
8  use XML::Simple;  use XML::Simple;
9  use Data::Dumper;  use Data::Dumper;
10    use Text::Iconv;
11    
12  =head1 NAME  =head1 NAME
13    
# Line 29  from input records Line 30  from input records
30    
31  =head1 FUNCTIONS  =head1 FUNCTIONS
32    
33  =head2 new  =head2 open
34    
35  Read normalisation rules defined using XML from C<conf/normalize/*.xml> and  Read normalisation rules defined using XML from C<conf/normalize/*.xml> and
36  parse it.  parse it.
37    
38   my $n = new WebPAC::Normalize::XML(   my $n = new WebPAC::Normalize::XML;
39     $n->open(
40          tag => 'isis',          tag => 'isis',
41          xml_file => '/path/to/conf/normalize/isis.xml',          xml_file => '/path/to/conf/normalize/isis.xml',
42          cache_data_structure => './cache/ds/',   );
         lookup_regex => $lookup->regex,  
  }  
43    
44  C<tag> defines tag to use within C<xml_file>  C<tag> defines tag to use within C<xml_file>
45    
46  C<xml_file> defines path to normalize XML.  C<xml_file> defines path to normalize XML.
47    
 Optional parameter C<cache_data_structure> defines path to directory  
 in which cache file for C<data_structure> call will be created.  
   
 Recommended parametar C<lookup_regex> specify ...  
   
48  =cut  =cut
49    
50  sub new {  sub open {
51          my $class = shift;          my $self = shift;
         my $self = {@_};  
         bless($self, $class);  
52    
53          $self->setup_cache_dir( $self->{'cache_data_structure'} );          my $arg = {@_};
54    
55          my $log = $self->_get_logger();          my $log = $self->_get_logger();
56    
57          foreach my $req (qw/tag xml_file/) {          foreach my $req (qw/tag xml_file/) {
58                  $log->logconfess("need argument $req") unless $self->{$req};                  $log->logconfess("need argument $req") unless $arg->{$req};
59          }          }
60    
61          my $f =          $self->{'tag'} = $arg->{'tag'};
62            my $xml_file = $arg->{'xml_file'};
         my $xml_file = $self->{'xml_file'};  
63    
64          $log->info("using $xml_file tag <",$self->{'tag'},">");          $log->info("using $xml_file tag <",$self->{'tag'},">");
65    
# Line 75  sub new { Line 67  sub new {
67    
68          $self->{'import_xml_file'} = $xml_file;          $self->{'import_xml_file'} = $xml_file;
69    
70          $self->{'import_xml'} = XMLin($f,          $self->{'import_xml'} = XMLin($xml_file,
71                  ForceArray => [ $self->{'tag'}, $self->{'tags'}, 'config', 'format' ],                  ForceArray => [ $self->{'tag'}, $self->{'tags'}, 'config', 'format' ],
72          );          );
73    
# Line 84  sub new { Line 76  sub new {
76          return $self;          return $self;
77  }  }
78    
 =head2 setup_cache_dir  
   
 Check if specified cache directory exist, and if not, disable caching.  
   
  $setup_cache_dir('./cache/ds/');  
   
 If you pass false or zero value to this function, it will disable  
 cacheing.  
   
 =cut  
   
 sub setup_cache_dir {  
         my $self = shift;  
   
         my $dir = shift;  
   
         my $log = $self->_get_logger();  
   
         if ($dir) {  
                 my $msg;  
                 if (! -e $dir) {  
                         $msg = "doesn't exist";  
                 } elsif (! -d $dir) {  
                         $msg = "is not directory";  
                 } elsif (! -w $dir) {  
                         $msg = "not writable";  
                 }  
   
                 if ($msg) {  
                         undef $self->{'cache_data_structure'};  
                         $log->warn("cache_data_structure $dir $msg, disabling...");  
                 } else {  
                         $log->debug("using cache dir $dir");  
                 }  
         } else {  
                 $log->debug("disabling cache");  
                 undef $self->{'cache_data_structure'};  
         }  
 }  
   
   
 =head2 data_structure  
   
 Create in-memory data structure which represents normalized layout from  
 C<conf/normalize/*.xml>.  
   
 This structures are used to produce output.  
   
  my @ds = $webpac->data_structure($rec);  
   
 B<Note: historical oddity follows>  
   
 This method will also set C<< $webpac->{'currnet_filename'} >> if there is  
 C<< <filename> >> tag and C<< $webpac->{'headline'} >> if there is  
 C<< <headline> >> tag.  
   
 =cut  
   
 sub data_structure {  
         my $self = shift;  
   
         my $log = $self->_get_logger();  
   
         my $rec = shift;  
         $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);  
   
         my $cache_file;  
   
         if (my $cache_path = $self->{'cache_data_structure'}) {  
                 my $id = $rec->{'000'};  
                 $id = $rec->{'000'}->[0] if ($id =~ m/^ARRAY/o);  
                 unless (defined($id)) {  
                         $log->warn("Can't use cache_data_structure on records without unique identifier in field 000");  
                         undef $self->{'cache_data_structure'};  
                 } else {  
                         $cache_file = "$cache_path/$id";  
                         if (-r $cache_file) {  
                                 my $ds_ref = retrieve($cache_file);  
                                 if ($ds_ref) {  
                                         $log->debug("cache hit: $cache_file");  
                                         my $ok = 1;  
                                         foreach my $f (qw(current_filename headline)) {  
                                                 if ($ds_ref->{$f}) {  
                                                         $self->{$f} = $ds_ref->{$f};  
                                                 } else {  
                                                         $ok = 0;  
                                                 }  
                                         };  
                                         if ($ok && $ds_ref->{'ds'}) {  
                                                 return @{ $ds_ref->{'ds'} };  
                                         } else {  
                                                 $log->warn("cache_data_structure $cache_path corrupt. Use rm $cache_path/* to re-create it on next run!");  
                                                 undef $self->{'cache_data_structure'};  
                                         }  
                                 }  
                         }  
                 }  
         }  
   
         undef $self->{'currnet_filename'};  
         undef $self->{'headline'};  
   
         my @sorted_tags;  
         if ($self->{tags_by_order}) {  
                 @sorted_tags = @{$self->{tags_by_order}};  
         } else {  
                 @sorted_tags = sort { $self->_sort_by_order } keys %{$self->{'import_xml'}->{'indexer'}};  
                 $self->{tags_by_order} = \@sorted_tags;  
         }  
   
         my @ds;  
   
         $log->debug("tags: ",sub { join(", ",@sorted_tags) });  
79    
80          foreach my $field (@sorted_tags) {  =head2 _x
81    
82                  my $row;  Convert string from UTF-8 to code page defined in C<import_xml>.
83    
84  #print "field $field [",$self->{'tag'},"] = ",Dumper($self->{'import_xml'}->{'indexer'}->{$field}->{$self->{'tag'}});   my $text = $n->_x('utf8 text');
85    
86                  foreach my $tag (@{$self->{'import_xml'}->{'indexer'}->{$field}->{$self->{'tag'}}}) {  Default application code page is C<ISO-8859-2>. You will probably want to
87                          my $format = $tag->{'value'} || $tag->{'content'};  change that when creating new instance of object based on this one.
   
                         $log->debug("format: $format");  
   
                         my @v;  
                         if ($self->{'lookup_regex'} && $format =~ $self->{'lookup_regex'}) {  
                                 @v = $self->fill_in_to_arr($rec,$format);  
                         } else {  
                                 @v = $self->parse_to_arr($rec,$format);  
                         }  
                         next if (! @v);  
   
                         if ($tag->{'sort'}) {  
                                 @v = $self->sort_arr(@v);  
                         }  
   
                         # use format?  
                         if ($tag->{'format_name'}) {  
                                 @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!  
                         }  
   
                         # delimiter will join repeatable fields  
                         if ($tag->{'delimiter'}) {  
                                 @v = ( join($tag->{'delimiter'}, @v) );  
                         }  
   
                         # default types  
                         my @types = qw(display swish);  
                         # override by type attribute  
                         @types = ( $tag->{'type'} ) if ($tag->{'type'});  
   
                         foreach my $type (@types) {  
                                 # append to previous line?  
                                 $log->debug("type: $type ",sub { join(" ",@v) }, $row->{'append'} || 'no append');  
                                 if ($tag->{'append'}) {  
   
                                         # I will delimit appended part with  
                                         # delimiter (or ,)  
                                         my $d = $tag->{'delimiter'};  
                                         # default delimiter  
                                         $d ||= " ";  
   
                                         my $last = pop @{$row->{$type}};  
                                         $d = "" if (! $last);  
                                         $last .= $d . join($d, @v);  
                                         push @{$row->{$type}}, $last;  
   
                                 } else {  
                                         push @{$row->{$type}}, @v;  
                                 }  
                         }  
   
   
                 }  
   
                 if ($row) {  
                         $row->{'tag'} = $field;  
   
                         # TODO: name_sigular, name_plural  
                         my $name = $self->{'import_xml'}->{'indexer'}->{$field}->{'name'};  
                         $row->{'name'} = $name ? $self->_x($name) : $field;  
   
                         # post-sort all values in field  
                         if ($self->{'import_xml'}->{'indexer'}->{$field}->{'sort'}) {  
                                 $log->warn("sort at field tag not implemented");  
                         }  
   
                         push @ds, $row;  
   
                         $log->debug("row $field: ",sub { Dumper($row) });  
                 }  
   
         }  
   
         if ($cache_file) {  
                 store {  
                         ds => \@ds,  
                         current_filename => $self->{'current_filename'},  
                         headline => $self->{'headline'},  
                 }, $cache_file;  
                 $log->debug("created storable cache file $cache_file");  
         }  
   
         return @ds;  
   
 }  
   
 =head2 apply_format  
   
 Apply format specified in tag with C<format_name="name"> and  
 C<format_delimiter=";;">.  
   
  my $text = $webpac->apply_format($format_name,$format_delimiter,$data);  
   
 Formats can contain C<lookup{...}> if you need them.  
88    
89  =cut  =cut
90    
91  sub apply_format {  sub _x {
92          my $self = shift;          my $self = shift;
93            my $utf8 = shift || return;
94    
95          my ($name,$delimiter,$data) = @_;          # create UTF-8 convertor for import_xml files
96            $self->{'utf2cp'} ||= Text::Iconv->new('UTF-8' ,$self->{'code_page'} || 'ISO-8859-2');
         my $log = $self->_get_logger();  
   
         if (! $self->{'import_xml'}->{'format'}->{$name}) {  
                 $log->warn("<format name=\"$name\"> is not defined in ",$self->{'import_xml_file'});  
                 return $data;  
         }  
   
         $log->warn("no delimiter for format $name") if (! $delimiter);  
   
         my $format = $self->_x($self->{'import_xml'}->{'format'}->{$name}->{'content'}) || $log->logdie("can't find format '$name'");  
   
         my @data = split(/\Q$delimiter\E/, $data);  
   
         my $out = sprintf($format, @data);  
         $log->debug("using format $name [$format] on $data to produce: $out");  
   
         if ($self->{'lookup_regex'} && $out =~ $self->{'lookup_regex'}) {  
                 return $self->lookup($out);  
         } else {  
                 return $out;  
         }  
97    
98            return $self->{'utf2cp'}->convert($utf8) ||
99                    $self->_get_logger()->logwarn("can't convert '$utf8'");
100  }  }
101    
102    

Legend:
Removed from v.12  
changed lines
  Added in v.13

  ViewVC Help
Powered by ViewVC 1.1.26