/[cvs]/nfo/perl/libs/Data/Mungle/Transform/Map.pm
ViewVC logotype

Diff of /nfo/perl/libs/Data/Mungle/Transform/Map.pm

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

revision 1.1 by joko, Sun Jan 19 03:27:33 2003 UTC revision 1.4 by joko, Thu Mar 27 15:17:07 2003 UTC
# Line 2  Line 2 
2  ##  $Id$  ##  $Id$
3  ## --------------------------------------------------------------------------------  ## --------------------------------------------------------------------------------
4  ##  $Log$  ##  $Log$
5    ##  Revision 1.4  2003/03/27 15:17:07  joko
6    ##  namespace fixes for Data::Mungle::*
7    ##
8    ##  Revision 1.3  2003/02/21 01:49:24  joko
9    ##  renamed core function
10    ##
11    ##  Revision 1.2  2003/02/14 12:54:30  joko
12    ##  + established first code here
13    ##
14  ##  Revision 1.1  2003/01/19 03:27:33  joko  ##  Revision 1.1  2003/01/19 03:27:33  joko
15  ##  + initial check-in  ##  + initial check-in
16  ##  ##
17  ## --------------------------------------------------------------------------------  ## --------------------------------------------------------------------------------
18    
19    
20  package Data::Transform::Map;  package Data::Mungle::Transform::Map;
21    
22  use strict;  use strict;
23  use warnings;  use warnings;
# Line 16  use warnings; Line 25  use warnings;
25  use base 'DesignPattern::Object';  use base 'DesignPattern::Object';
26    
27    
28    use Data::Dumper;
29    use XML::Simple;
30    use Data::Mungle::Transform::Encode qw( utf8_to_latin );
31    use Data::Mungle::Compare::Struct qw( getRelations getDifference );
32    use Data::Mungle::Transform::Deep qw( deep_copy );
33    
34    
35    sub _init {
36      my $self = shift;
37    }
38    
39    sub _touch {
40      my $self = shift;
41      if (!$self->{__meta}->{touched}++) {
42        $self->_readSelectDb();
43      }
44    }
45    
46    sub _readSelectDb {
47      my $self = shift;
48      my $data = XMLin($self->{filename});
49      utf8_to_latin($data);
50      $self->{db} = $data;
51    }
52    
53    sub getKeys {
54      my $self = shift;
55      my $source_key = shift;
56      my $source_type = shift;
57      
58      $self->_touch();
59      
60      my $selection = $self->{db}->{source}->{$source_key}->{select} if $source_key;
61      if ($selection) {
62        my @selections = keys %$selection;
63        
64        # TODO: filter @selections by $source_type
65        
66        return @selections;
67      }
68    }
69    
70    sub applyKeyFilter {
71    
72      my $self = shift;
73      my $filterlist = shift;
74    
75      my $data = deep_copy($self->{payload});
76    
77      # calculate intersection
78        my @list = keys %{$data};
79        my $diff = getDifference(\@list, $filterlist);
80    
81      # populate new (filtered) result just using intersected elements
82        my $result;
83        foreach my $elem (@{$diff}) {
84          #$result->{$elem} = $memory->{sports}->{$elem};
85          delete $data->{$elem};
86        }
87    
88      return $data;
89    
90    }
91    
92  1;  1;
93    __END__
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.4
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed