/[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 8 by dpavlin, Sat Jul 16 16:48:35 2005 UTC revision 38 by dpavlin, Sat Nov 12 21:21:50 2005 UTC
# Line 1  Line 1 
1  package WebPAC::Normalise::XML;  package WebPAC::Normalize::XML;
2    
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 XML::Simple;
8    use Data::Dumper;
9    use Text::Iconv;
10    
11  =head1 NAME  =head1 NAME
12    
13  WebPAC::Normalise::XML - apply XML normalisaton rules  WebPAC::Normalize::XML - apply XML normalisaton rules
14    
15  =head1 VERSION  =head1 VERSION
16    
# Line 22  our $VERSION = '0.01'; Line 25  our $VERSION = '0.01';
25  This module uses C<conf/normalize/*.xml> files to perform normalisation  This module uses C<conf/normalize/*.xml> files to perform normalisation
26  from input records  from input records
27    
     use WebPAC::Normalise::XML;  
   
     my $foo = WebPAC::Normalise::XML->new();  
     ...  
   
28  =cut  =cut
29    
 # mapping between data type and tag which specify  
 # format in XML file  
 my %type2tag = (  
         'isis' => 'isis',  
 #       'excel' => 'column',  
 #       'marc' => 'marc',  
 #       'feed' => 'feed'  
 );  
   
   
 =head1 EXPORT  
   
 A list of functions that can be exported.  You can delete this section  
 if you don't export anything, such as for a purely object-oriented module.  
   
30  =head1 FUNCTIONS  =head1 FUNCTIONS
31    
32  =head2 new  =head2 open
   
 Create new instance of WebPAC using configuration specified by C<config_file>.  
   
  my $n = new WebPAC::Normalize::XML(  
         cache_data_structure => './cache/ds/',  
  }  
   
 Optional parameter C<cache_data_structure> defines path to directory  
 in which cache file for C<data_structure> call will be created.  
33    
34  =cut  Read normalisation rules defined using XML from C<conf/normalize/*.xml> and
35    parse it.
 sub new {  
         my $class = shift;  
         my $self = {@_};  
         bless($self, $class);  
   
         $self->setup_cache_dir( $self->{'cache_data_structure'} );  
36    
37          return $self;   my $n = new WebPAC::Normalize::XML;
38  }   $n->open(
39            tag => 'isis',
40            xml_file => '/path/to/conf/normalize/isis.xml',
41     );
42    
43  =head2 open_import_xml  C<tag> defines tag to use within C<xml_file>
44    
45  Read file from C<import_xml/> directory and parse it.  C<xml_file> defines path to normalize XML.
   
  $webpac->open_import_xml(type => 'isis');  
46    
47  =cut  =cut
48    
49  sub open_import_xml {  sub open {
50          my $self = shift;          my $self = shift;
51    
         my $log = $self->_get_logger();  
   
52          my $arg = {@_};          my $arg = {@_};
         $log->logconfess("need type to load file from import_xml/") if (! $arg->{'type'});  
   
         $self->{'type'} = $arg->{'type'};  
53    
54          my $type_base = $arg->{'type'};          my $log = $self->_get_logger();
         $type_base =~ s/_.*$//g;  
55    
56          $self->{'tag'} = $type2tag{$type_base};          foreach my $req (qw/tag xml_file/) {
57                    $log->logconfess("need argument $req") unless $arg->{$req};
58            }
59    
60          $log->info("using type '",$self->{'type'},"' tag <",$self->{'tag'},">");          $self->{'tag'} = $arg->{'tag'};
61            my $xml_file = $arg->{'xml_file'};
62    
63          my $f = "./import_xml/".$self->{'type'}.".xml";          $log->info("using $xml_file tag <",$self->{'tag'},">");
         $log->logconfess("import_xml file '$f' doesn't exist!") if (! -e "$f");  
64    
65          $log->info("reading '$f'");          $log->logdie("normalisation xml file '$xml_file' doesn't exist!") if (! -e $xml_file);
66    
67          $self->{'import_xml_file'} = $f;          $self->{'import_xml_file'} = $xml_file;
68    
69          $self->{'import_xml'} = XMLin($f,          $self->{'import_xml'} = XMLin($xml_file,
70                  ForceArray => [ $self->{'tag'}, 'config', 'format' ],                  ForceArray => [ $self->{'tag'}, $self->{'tags'}, 'config', 'format' ],
71                    ForceContent => 1,
72          );          );
73    
74          $log->debug("import xml is ",sub { Dumper($self->{'import_xml'}) });          $log->debug("import xml is ",sub { Dumper($self->{'import_xml'}) });
75    
76  }          return $self;
   
 =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'};  
         }  
77  }  }
78    
79    
80  =head2 data_structure  =head2 _x
81    
82  Create in-memory data structure which represents layout from C<import_xml>.  Convert string from XML UTF-8 encoding to code page defined in C<xml_file>.
 It is used later to produce output.  
83    
84   my @ds = $webpac->data_structure($rec);   my $text = $n->_x('utf8 text');
85    
86  This method will also set C<$webpac->{'currnet_filename'}> if there is  Default application code page is C<ISO-8859-2>. You will probably want to
87  <filename> tag in C<import_xml> and C<$webpac->{'headline'}> if there is  change that when creating new instance of object based on this one.
 <headline> tag.  
88    
89  =cut  =cut
90    
91  sub data_structure {  sub _x {
92          my $self = shift;          my $self = shift;
93            my $utf8 = shift || return;
94    
95          my $log = $self->_get_logger();          # create UTF-8 convertor for import_xml files
96            $self->{'utf2cp'} ||= Text::Iconv->new('UTF-8' ,$self->{'code_page'} || 'ISO-8859-2');
         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) });  
   
         foreach my $field (@sorted_tags) {  
   
                 my $row;  
   
 #print "field $field [",$self->{'tag'},"] = ",Dumper($self->{'import_xml'}->{'indexer'}->{$field}->{$self->{'tag'}});  
   
                 foreach my $tag (@{$self->{'import_xml'}->{'indexer'}->{$field}->{$self->{'tag'}}}) {  
                         my $format = $tag->{'value'} || $tag->{'content'};  
   
                         $log->debug("format: $format");  
   
                         my @v;  
                         if ($format =~ /$LOOKUP_REGEX/o) {  
                                 @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;  
97    
98            return $self->{'utf2cp'}->convert($utf8) ||
99                    $self->_get_logger()->logwarn("can't convert '$utf8'");
100  }  }
101    
102    
# Line 336  under the same terms as Perl itself. Line 113  under the same terms as Perl itself.
113    
114  =cut  =cut
115    
116  1; # End of WebPAC::Normalise::XML  1; # End of WebPAC::Normalize::XML
Legend:
Removed from v.8  
changed lines
  Added in v.38
  ViewVC Help
Powered by ViewVC 1.1.26