+=head2 new
+
+Create new normalisation object
+
+ my $n = new WebPAC::Normalize::Something(
+ cache_data_structure => './cache/ds/',
+ lookup_regex => $lookup->regex,
+ );
+
+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> is used to enable parsing of lookups
+in structures.
+
+=cut
+
+sub new {
+ my $class = shift;
+ my $self = {@_};
+ bless($self, $class);
+
+ $self->setup_cache_dir( $self->{'cache_data_structure'} );
+
+ $self ? return $self : return undef;
+}
+
+=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) });
+
+ 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 ($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.