/[cvs]/nfo/perl/libs/Data/Transfer/Sync/Metadata.pm
ViewVC logotype

Diff of /nfo/perl/libs/Data/Transfer/Sync/Metadata.pm

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

revision 1.1 by joko, Mon Jan 20 16:58:46 2003 UTC revision 1.6 by joko, Fri Mar 28 03:08:17 2003 UTC
# Line 6  Line 6 
6  ##  ##
7  ##    ----------------------------------------------------------------------------------------  ##    ----------------------------------------------------------------------------------------
8  ##    $Log$  ##    $Log$
9    ##    Revision 1.6  2003/03/28 03:08:17  joko
10    ##    fix regarding namespace update
11    ##
12    ##    Revision 1.5  2003/02/21 08:34:58  joko
13    ##    modified object hierarchy
14    ##    renamed method
15    ##
16    ##    Revision 1.4  2003/02/14 14:06:20  joko
17    ##    + minor fix to old metadata structure
18    ##
19    ##    Revision 1.3  2003/02/11 06:28:24  joko
20    ##    + changes to metadata structure
21    ##
22    ##    Revision 1.2  2003/02/09 05:02:05  joko
23    ##    + major structure changes
24    ##    - refactored code to sister modules
25    ##
26  ##    Revision 1.1  2003/01/20 16:58:46  joko  ##    Revision 1.1  2003/01/20 16:58:46  joko
27  ##    + initial check-in: here they are....  ##    + initial check-in: here they are....
28  ##  ##
# Line 25  use mixin::with qw( Data::Transfer::Sync Line 42  use mixin::with qw( Data::Transfer::Sync
42    
43  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -   main  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -   main
44    
 # get logger instance  
 my $logger = Log::Dispatch::Config->instance;  
   
45  use Data::Dumper;  use Data::Dumper;
46    use libdb qw( quotesql );
47    use Data::Mungle::Code::Ref qw( ref_slot );
48    
49    # get logger instance
50  sub _preCheckOptions {  my $logger = Log::Dispatch::Config->instance;
   
   my $self = shift;  
   my $opts = shift;  
   
 #print Dumper($opts);  
 #exit;  
   
   # the type of the to-be-synced item  
   if (!$opts->{source}->{nodeType}) {  
     $logger->error( __PACKAGE__ . "->_preCheckOptions failed: Please specify \"source-type\".");  
     return;  
   }  
   # the name of the (container-) node the items are listed in  
   if (!$opts->{source}->{nodeName}) {  
     $logger->error( __PACKAGE__ . "->_preCheckOptions failed: Please specify \"source-node\".");  
     return;  
   }  
   
   # a "map"-declaration which module to use for mapping- and/or lookup-purposes  
   if (!$opts->{map}) {  
     $logger->warning( __PACKAGE__ . "->_preCheckOptions: No mapping supplied - please check key 'map|mappings' in global configuration or specify additional argument '--mapping-module'.");  
     return;  
   }  
   if (!$opts->{map}->{moduleName}) {  
     $logger->warning( __PACKAGE__ . "->_preCheckOptions: Currently only perl-modules can provide mappings: Please specify one with '--mapping-module'.");  
     return;  
   }  
   
   return 1;  
   
 }  
   
 # TODO: refactor!!! take this list from already established/given metadata  
 sub _buildMetadataV1 {  
   my $self = shift;  
   
   # decompose identifiers for each partner  
   foreach ('source', 'target') {  
       
     # get/set metadata for further processing  
   
     # Partner and Node (e.g.: "L:Country" or "R:countries.csv")  
     if (my $item = $self->{args}->{$_}) {  
       my @item = split(':', $item);  
       $self->{meta}->{$_}->{dbkey} = $item[0];  
       $self->{meta}->{$_}->{node} = $item[1];  
     }  
       
     # Filter  
     if (my $item_filter = $self->{args}->{$_ . '_filter'}) {  
       $self->{meta}->{$_}->{filter} = $item_filter;  
     }  
   
     # IdentProvider  
     if (my $item_ident = $self->{args}->{$_ . '_ident'}) {  
       my @item_ident = split(':', $item_ident);  
       $self->{meta}->{$_}->{IdentProvider} = { method => $item_ident[0], arg => $item_ident[1] };  
     }  
   
 #print Dumper($self->{meta});  
   
     # TODO: ChecksumProvider  
   
     # exclude properties/subnodes  
     if (my $item_exclude = $self->{args}->{$_ . '_exclude'}) {  
       $self->{meta}->{$_}->{subnodes_exclude} = $item_exclude;  
     }  
       
     # TypeProvider  
     if (my $item_type = $self->{args}->{$_ . '_type'}) {  
       my @item_type = split(':', $item_type);  
       $self->{meta}->{$_}->{TypeProvider} = { method => $item_type[0], arg => $item_type[1] };  
     }  
       
     # Callbacks - writers (will be triggered _before_ writing to target)  
     if (my $item_writers = $self->{args}->{$_ . '_callbacks_write'}) {  
       my $descent = $_;     # this is important since the following code inside the map wants to use its own context variables  
       map { $self->{meta}->{$descent}->{Callback}->{write}->{$_}++; } @$item_writers;  
     }  
       
     # Callbacks - readers (will be triggered _after_ reading from source)  
     if (my $item_readers = $self->{args}->{$_ . '_callbacks_read'}) {  
       my $descent = $_;  
       map { $self->{meta}->{$descent}->{Callback}->{read}->{$_}++; } @$item_readers;  
     }  
       
     # resolve storage objects  
     #$self->{$_} = $self->{container}->{storage}->{$self->{meta}->{$_}->{dbkey}};  
     # relink references to metainfo  
     $self->{meta}->{$_}->{storage} = $self->{container}->{storage}->{$self->{meta}->{$_}->{dbkey}};  
     #print "iiiiisprov: ", Dumper($self->{meta}->{$_}->{storage}), "\n";  
   }  
   
 }  
   
51    
52  # TODO: refactor (still)!!! take this list from already established/given metadata ....  # TODO: refactor (still)!!! take this list from already established/given metadata ....
53  # .... also internally: passing around and mungling these metadata doesn't make sense anymore.  # .... also internally: passing around and mungling these metadata doesn't make sense anymore.
54  sub _buildMetadataV2 {  sub options2metadata {
55    my $self = shift;    my $self = shift;
56    
57  #print Dumper($self->{options});    $logger->debug( __PACKAGE__ . "->transformMetadata" );
58    
59    # decompose identifiers for each partner    # trace
60        #print Dumper($self->{options});
61        #print Dumper($self->{args_raw});
62        #exit;
63    
64      # decompose identifiers and write to metadata (for each descent)
65    foreach ('source', 'target') {    foreach ('source', 'target') {
66            
67      # get/set metadata for further processing      # get/set metadata for further processing
# Line 144  sub _buildMetadataV2 { Line 70  sub _buildMetadataV2 {
70      $self->{options}->{$_}->{nodeType} ||= '';      $self->{options}->{$_}->{nodeType} ||= '';
71      $self->{options}->{$_}->{nodeName} ||= '';      $self->{options}->{$_}->{nodeName} ||= '';
72    
73      # Partner and Node (e.g.: "L:Country" or "R:countries.csv")      # Partner and Node (compare the V1-notations: "L:Country" or "R:countries.csv")
74      $self->{meta}->{$_}->{dbKey} = $self->{options}->{$_}->{dbKey};      $self->{meta}->{$_}->{dbKey} = $self->{options}->{$_}->{dbKey};
75      $self->{meta}->{$_}->{nodeType} = $self->{options}->{$_}->{nodeType};      $self->{meta}->{$_}->{nodeType} = $self->{options}->{$_}->{nodeType};
76      $self->{meta}->{$_}->{nodeName} = $self->{options}->{$_}->{nodeName};      $self->{meta}->{$_}->{nodeName} = $self->{options}->{$_}->{nodeName};
77            
78      # Filter      # Filter
79      if (my $item_filter = $self->{args}->{$_ . '_filter'}) {      if (my $item_filter = $self->{options}->{$_}->{filter}) {
80        $self->{meta}->{$_}->{filter} = $item_filter;        $self->{meta}->{$_}->{filter} = $item_filter;
81      }      }
82    
# Line 161  sub _buildMetadataV2 { Line 87  sub _buildMetadataV2 {
87      }      }
88    
89      # TODO: ChecksumProvider      # TODO: ChecksumProvider
90        # already inside {options} - get it out from there and put into {meta} here!
91    
92      # exclude properties/subnodes      # exclude properties/subnodes
93      if (my $item_exclude = $self->{options}->{$_}->{exclude}) {      if (my $item_exclude = $self->{options}->{$_}->{exclude}) {
# Line 168  sub _buildMetadataV2 { Line 95  sub _buildMetadataV2 {
95      }      }
96            
97      # TypeProvider      # TypeProvider
98      if (my $item_type = $self->{args}->{$_ . '_type'}) {      # FIXME! this is still Vdeprecated!!!
99        if (my $item_type = $self->{options}->{$_ . '_type'}) {
100        my @item_type = split(':', $item_type);        my @item_type = split(':', $item_type);
101        $self->{meta}->{$_}->{TypeProvider} = { method => $item_type[0], arg => $item_type[1] };        $self->{meta}->{$_}->{TypeProvider} = { method => $item_type[0], arg => $item_type[1] };
102      }      }
103    
104        # trace
105          #print Dumper($self);
106          #exit;
107            
108      # Callbacks - writers (will be triggered _before_ writing to target)      # Callbacks - writers (will be triggered _before_ writing to target)
109      if (my $item_writers = $self->{args}->{$_ . '_callbacks_write'}) {      if (my $item_writers = $self->{options}->{$_}->{callbacks}->{write}) {
110        my $descent = $_;     # this is important since the following code inside the map wants to use its own context variables        my $descent = $_;     # this is important since the following code inside the map wants to use its own context variables
111        map { $self->{meta}->{$descent}->{Callback}->{write}->{$_}++; } @$item_writers;        map { $self->{meta}->{$descent}->{Callback}->{write}->{$_}++; } @$item_writers;
112      }      }
113            
114      # Callbacks - readers (will be triggered _after_ reading from source)      # Callbacks - readers (will be triggered _after_ reading from source)
115      if (my $item_readers = $self->{args}->{$_ . '_callbacks_read'}) {      if (my $item_readers = $self->{options}->{$_}->{callbacks}->{read}) {
116        my $descent = $_;        my $descent = $_;
117        map { $self->{meta}->{$descent}->{Callback}->{read}->{$_}++; } @$item_readers;        map { $self->{meta}->{$descent}->{Callback}->{read}->{$_}++; } @$item_readers;
118      }      }
119            
120      # resolve storage objects      # resolve storage handles
121      $self->{meta}->{$_}->{storage} = $self->{options}->{$_}->{storage}->{handle};        $self->{meta}->{$_}->{storage} = $self->{options}->{$_}->{storage}->{handle};
122    
123        # transfer storage handle options to metadata
124          #map { $self->{meta}->{$_}->{isIdentAuthority} = 1 } @{$self->{id_authorities}};
125          #map { $self->{meta}->{$_}->{isChecksumAuthority} = 1; } @{$self->{checksum_authorities}};
126          #map { $self->{meta}->{$_}->{isWriteProtected} = 1; } @{$self->{write_protected}};
127          #print Dumper($self->{options}->{$_});
128          #exit;
129          $self->{meta}->{$_}->{isIdentAuthority} = $self->{options}->{$_}->{storage}->{handle}->{locator}->{sync}->{isIdentAuthority};
130          $self->{meta}->{$_}->{isWriteProtected} = $self->{options}->{$_}->{storage}->{handle}->{locator}->{sync}->{isWriteProtected};
131          $self->{meta}->{$_}->{isChecksumAuthority} = $self->{options}->{$_}->{storage}->{handle}->{locator}->{sync}->{isChecksumAuthority};
132    
133    }    }
134    
135    #print Dumper($self->{meta});    #print Dumper($self->{meta});
# Line 195  sub _buildMetadataV2 { Line 138  sub _buildMetadataV2 {
138  }  }
139    
140    
141  sub _buildFieldmappingV1 {  sub options2metadata_accessor {
142    my $self = shift;    my $self = shift;
143    
144    # build mapping    $logger->debug( __PACKAGE__ . "->_transformMetadata_accessor" );
   # incoming: and Array of node map entries (Array or Hash) - e.g.  
   #   [ 'source:item_name' => 'target:class_val' ]  
   #   { source => 'event->startDateTime', target => 'begindate' }  
   foreach (@{$self->{args}->{mapping}}) {  
     if (ref $_ eq 'ARRAY') {  
       my @entry1 = split(':', $_->[0]);  
       my @entry2 = split(':', $_->[1]);  
       my $descent = [];  
       my $node = [];  
       $descent->[0] = $entry1[0];  
       $descent->[1] = $entry2[0];  
       $node->[0] = $entry1[1];  
       $node->[1] = $entry2[1];  
       push @{$self->{meta}->{$descent->[0]}->{childnodes}}, $node->[0];  
       push @{$self->{meta}->{$descent->[1]}->{childnodes}}, $node->[1];  
     } elsif (ref $_ eq 'HASH') {  
       foreach my $entry_key (keys %$_) {  
         my $entry_val = $_->{$entry_key};  
         push @{$self->{meta}->{$entry_key}->{childnodes}}, $entry_val;  
       }  
     }  
145    
146    }    # build accessor metadata (for each descent)
147      foreach my $descent ('source', 'target') {
148    
149    return 1;        # the database type plays a role here to handle special nodesets:
150          # there may be a) childless/non-strict nodesets (e.g. a CSV-file)
151          # or b) normal ones - here the node-name corresponds more or less directly to
152          # the physical location in the storage hierarchy below us (e.g. MAPI or LDAP)
153          # or c) sets of nodes which are physically mapped by node-type (e.g. a RDBMS or a ODBMS)
154          my $dbType = $self->{meta}->{$descent}->{storage}->{locator}->{type};
155          
156            # a, b and c are "accessor-type"s (of 'none', 'node-name', 'node-type')
157            # the following code resolves these types to '$accessorType'
158            # and properly sets '$accessorName'
159    
160            # don't continue for certain storage handlers
161              # HACK for DBD::CSV - re-enable for other DBDs
162              #next if $dbType eq 'DBI';
163      
164            # get nodename
165    
166              # get node-name
167                my $nodename = $self->{meta}->{$descent}->{node};   # V1
168                $nodename ||= $self->{meta}->{$descent}->{nodeName};    # V2
169    
170              # check if nodename is actually a CODEref, execute it to get a mapped/filtered target-nodename
171                #print "----", ref $nodename, "\n";
172                #if ($nodename =~ m/CODE/) {
173                #  print Dumper($self);
174                #  #exit;
175                #  $nodename = $nodename->($nodename);
176                #}
177    
178            # determine nodeset accessor -type and -name
179              # defaults
180              my $accessorType = 'none';
181              my $accessorName = '';
182              
183              # if explicit address was given in options, just use it!
184              if (my $address = $self->{options}->{$descent}->{address}) {
185                $accessorType = 'direct-address';
186                $accessorName = $address;
187              }
188              
189              # c)
190              elsif (($dbType eq 'DBI' || $dbType eq 'Tangram') && $self->{meta}->{$descent}->{nodeType}) {
191                $accessorType = 'node-type';
192                $accessorName = $self->{meta}->{$descent}->{nodeType};
193              }
194    
195              # b)
196              elsif ($nodename) {
197                $accessorType = 'node-name';
198                $accessorName = $nodename;
199              }
200    
201          # write accessor information to metadata
202          $self->{meta}->{$descent}->{accessorType} = $accessorType;
203          $self->{meta}->{$descent}->{accessorName} = $accessorName;
204        
205        }
206    
207      # trace
208        #print Dumper($self->{meta});
209        #print Dumper($self->{options});
210        #exit;
211    
212  }  }
213    
214    
215    
216    sub buildAttributeMap {
217    
218     my $self = shift;
219    
220      # field-structure for building sql
221      # mapping of sql-fieldnames to object-attributes
222        $self->{node}->{map} = {};
223    
224        # manually set ...
225          # ... object-id
226          $self->{node}->{map}->{$self->{meta}->{target}->{IdentProvider}->{arg}} = $self->{node}->{source}->{ident};
227          # ... checksum
228          $self->{node}->{map}->{cs} = $self->{node}->{source}->{checksum};
229    
230    #print "sqlmap: ", Dumper($self->{node}->{map}), "\n";
231    
232    #print Dumper($self);
233    #exit;
234    
235        # for transferring flat structures via simple (1:1) mapping
236        # TODO: diff per property / property value
237    
238        #if ($self->{args}->{mapping}) {
239          # apply mapping from $self->{args}->{mapping} to $self->{node}->{map}
240          #foreach my $key (@{$self->{meta}->{source}->{childnodes}}) {
241          my @childnodes = @{$self->{meta}->{source}->{childnodes}};
242          for (my $mapidx = 0; $mapidx <= $#childnodes; $mapidx++) {
243            #my $map_right = $self->{args}->{mapping}->{$key};
244            
245            $self->{node}->{source}->{propcache} = {};
246            $self->{node}->{target}->{propcache} = {};
247            
248            # get property name
249            $self->{node}->{source}->{propcache}->{property} = $self->{meta}->{source}->{childnodes}->[$mapidx];
250            $self->{node}->{target}->{propcache}->{property} = $self->{meta}->{target}->{childnodes}->[$mapidx];
251            #print "map: $map_right", "\n";
252    
253            # get property value
254            my $value;
255            
256            # detect for callback - old style - (maybe the better???)
257            if (ref($self->{node}->{target}->{map}) eq 'CODE') {
258              #$value = &$map_right($objClone);
259            } else {
260              # plain (scalar?) value
261              #$value = $objClone->{$map_right};
262              $self->{node}->{source}->{propcache}->{value} = $self->{node}->{source}->{payload}->{$self->{node}->{source}->{propcache}->{property}};
263            }
264            #$self->{node}->{map}->{$key} = $value;
265            
266            # detect expression
267            # for transferring deeply nested structures described by expressions
268            #print "val: $self->{node}->{source}->{propcache}->{value}", "\n";
269            if ($self->{node}->{source}->{propcache}->{property} =~ s/^expr://) {
270              
271              # create an anonymous sub to act as callback target dispatcher
272                my $cb_dispatcher = sub {
273                  #print "===============  CALLBACK DISPATCHER", "\n";
274                  #print "ident: ", $self->{node}->{source}->{ident}, "\n";
275                  #return $self->{node}->{source}->{ident};
276                  
277                };
278              
279    
280    #print Dumper($self->{node});
281              
282              # build callback map for helper function
283              #my $cbmap = { $self->{meta}->{source}->{IdentProvider}->{arg} => $cb_dispatcher };
284              my $cbmap = {};
285              my $value = ref_slot($self->{node}->{source}->{payload}, $self->{node}->{source}->{propcache}->{property}, $cbmap);
286              $self->{node}->{source}->{propcache}->{value} = $value;
287            }
288    
289            # encode values dependent on type of underlying storage here - expand cases...
290            my $storage_type = $self->{meta}->{target}->{storage}->{locator}->{type};
291            if ($storage_type eq 'DBI') {
292              # ...for sql
293              # quotemeta?
294              $self->{node}->{source}->{propcache}->{value} = quotesql($self->{node}->{source}->{propcache}->{value});
295    
296            } elsif ($storage_type eq 'Tangram') {
297              # iso? utf8 already possible?
298            
299            } elsif ($storage_type eq 'LDAP') {
300              # TODO: encode utf8 here?
301    
302            }
303    
304            # store value to transfer map
305            $self->{node}->{map}->{$self->{node}->{target}->{propcache}->{property}} = $self->{node}->{source}->{propcache}->{value};
306    
307          }
308        #}
309    
310        
311      # TODO: $logger->dump( ... );
312      #$logger->debug( "sqlmap:" . "\n" . Dumper($self->{node}->{map}) );
313    #print "sqlmap: ", Dumper($self->{node}->{map}), "\n";
314    #print "entrystatus: ", Dumper($self->{node}), "\n";
315    
316    }
317    
318  1;  1;
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.6
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed