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

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

revision 486 by dpavlin, Sun May 14 11:06:52 2006 UTC revision 490 by dpavlin, Sun May 14 12:35:20 2006 UTC
# Line 21  WebPAC::Normalize::Set - describe normal Line 21  WebPAC::Normalize::Set - describe normal
21    
22  =head1 VERSION  =head1 VERSION
23    
24  Version 0.03  Version 0.04
25    
26  =cut  =cut
27    
28  our $VERSION = '0.03';  our $VERSION = '0.04';
29    
30  =head1 SYNOPSIS  =head1 SYNOPSIS
31    
# Line 42  types (on the left side of definition) a Line 42  types (on the left side of definition) a
42    
43  =head1 FUNCTIONS  =head1 FUNCTIONS
44    
45    =head2 data_structure
46    
47    Return data structure
48    
49      my $ds = WebPAC::Normalize::Set(
50            lookup => $lookup->lookup_hash,
51            row => $row,
52            rules => $normalize_pl_config,
53      );
54    
55    This function will B<die> if normalizastion can't be evaled.
56    
57    =cut
58    
59    sub data_structure {
60            my $arg = {@_};
61    
62            die "need row argument" unless ($arg->{row});
63            die "need normalisation argument" unless ($arg->{rules});
64    
65            no strict 'subs';
66            set_lookup( $arg->{lookup} );
67            set_rec( $arg->{row} );
68            clean_ds();
69            eval "$arg->{rules}";
70            die "error evaling $arg->{rules}: $@\n" if ($@);
71            return get_ds();
72    }
73    
74  =head2 set_rec  =head2 set_rec
75    
76  Set current record hash  Set current record hash
# Line 158  TODO: order of values is probably same a Line 187  TODO: order of values is probably same a
187    
188  sub rec1 {  sub rec1 {
189          my $f = shift;          my $f = shift;
190          return unless (defined($rec && $rec->{$f}));          return unless (defined($rec) && defined($rec->{$f}));
191          if (ref($rec->{$f}) eq 'ARRAY') {          if (ref($rec->{$f}) eq 'ARRAY') {
192                  if (ref($rec->{$f}->[0]) eq 'HASH') {                  return map {
193                          return map { values %{$_} } @{ $rec->{$f} };                          if (ref($_) eq 'HASH') {
194                  } else {                                  values %{$_};
195                          return @{ $rec->{$f} };                          } else {
196                  }                                  $_;
197                            }
198                    } @{ $rec->{$f} };
199          } elsif( defined($rec->{$f}) ) {          } elsif( defined($rec->{$f}) ) {
200                  return $rec->{$f};                  return $rec->{$f};
201          }          }
# Line 182  sub rec2 { Line 213  sub rec2 {
213          my $f = shift;          my $f = shift;
214          return unless (defined($rec && $rec->{$f}));          return unless (defined($rec && $rec->{$f}));
215          my $sf = shift;          my $sf = shift;
216          return map { $_->{$sf} } grep { $_->{$sf} } @{ $rec->{$f} };          return map { $_->{$sf} } grep { ref($_) eq 'HASH' && $_->{$sf} } @{ $rec->{$f} };
217  }  }
218    
219  =head2 rec  =head2 rec
Legend:
Removed from v.486  
changed lines
  Added in v.490
  ViewVC Help
Powered by ViewVC 1.1.26