--- nfo/perl/libs/Data/Transfer/Sync/Metadata.pm	2003/01/20 16:58:46	1.1
+++ nfo/perl/libs/Data/Transfer/Sync/Metadata.pm	2003/02/09 05:02:05	1.2
@@ -1,4 +1,4 @@
-##    $Id: Metadata.pm,v 1.1 2003/01/20 16:58:46 joko Exp $
+##    $Id: Metadata.pm,v 1.2 2003/02/09 05:02:05 joko Exp $
 ##
 ##    Copyright (c) 2002  Andreas Motl <andreas.motl@ilo.de>
 ##
@@ -6,6 +6,10 @@
 ##
 ##    ----------------------------------------------------------------------------------------
 ##    $Log: Metadata.pm,v $
+##    Revision 1.2  2003/02/09 05:02:05  joko
+##    + major structure changes
+##    - refactored code to sister modules
+##
 ##    Revision 1.1  2003/01/20 16:58:46  joko
 ##    + initial check-in: here they are....
 ##
@@ -31,111 +35,17 @@
 use Data::Dumper;
 
 
-sub _preCheckOptions {
-
-  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";
-  }
-
-}
-
 
 # TODO: refactor (still)!!! take this list from already established/given metadata ....
 # .... also internally: passing around and mungling these metadata doesn't make sense anymore.
-sub _buildMetadataV2 {
+sub options2metadata {
   my $self = shift;
 
+  $logger->debug( __PACKAGE__ . "->transformMetadata" );
+
 #print Dumper($self->{options});
 
-  # decompose identifiers for each partner
+  # decompose identifiers and write to metadata (for each descent)
   foreach ('source', 'target') {
     
     # get/set metadata for further processing
@@ -144,7 +54,7 @@
     $self->{options}->{$_}->{nodeType} ||= '';
     $self->{options}->{$_}->{nodeName} ||= '';
 
-    # Partner and Node (e.g.: "L:Country" or "R:countries.csv")
+    # Partner and Node (compare the V1-notations: "L:Country" or "R:countries.csv")
     $self->{meta}->{$_}->{dbKey} = $self->{options}->{$_}->{dbKey};
     $self->{meta}->{$_}->{nodeType} = $self->{options}->{$_}->{nodeType};
     $self->{meta}->{$_}->{nodeName} = $self->{options}->{$_}->{nodeName};
@@ -161,6 +71,7 @@
     }
 
     # TODO: ChecksumProvider
+    # already inside {options} - get it out from there and put into {meta} here!
 
     # exclude properties/subnodes
     if (my $item_exclude = $self->{options}->{$_}->{exclude}) {
@@ -195,37 +106,181 @@
 }
 
 
-sub _buildFieldmappingV1 {
+sub options2metadata_accessor {
   my $self = shift;
 
-  # build mapping
-  # 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;
-      }
-    }
+  $logger->debug( __PACKAGE__ . "->_transformMetadata_accessor" );
 
-  }
+  # build accessor metadata (for each descent)
+  foreach my $descent ('source', 'target') {
 
-  return 1;
+      # the database type plays a role here to handle special nodesets:
+      # there may be a) childless/non-strict nodesets (e.g. a CSV-file)
+      # or b) normal ones - here the node-name corresponds more or less directly to 
+      # the physical location in the storage hierarchy below us (e.g. MAPI or LDAP)
+      # or c) sets of nodes which are physically mapped by node-type (e.g. a RDBMS or a ODBMS)
+      my $dbType = $self->{meta}->{$descent}->{storage}->{locator}->{type};
+      
+        # a, b and c are "accessor-type"s (of 'none', 'node-name', 'node-type')
+        # the following code resolves these types to '$accessorType' 
+        # and properly sets '$accessorName'
+
+        # don't continue for certain storage handlers
+          # HACK for DBD::CSV - re-enable for other DBDs
+          #next if $dbType eq 'DBI';
+  
+        # get nodename
+
+          # get node-name
+            my $nodename = $self->{meta}->{$descent}->{node};   # V1
+            $nodename ||= $self->{meta}->{$descent}->{nodeName};    # V2
+
+          # check if nodename is actually a CODEref, execute it to get a mapped/filtered target-nodename
+            #print "----", ref $nodename, "\n";
+            #if ($nodename =~ m/CODE/) {
+            #  print Dumper($self);
+            #  #exit;
+            #  $nodename = $nodename->($nodename);
+            #}
+
+        # determine nodeset accessor -type and -name
+          # defaults
+          my $accessorType = 'none';
+          my $accessorName = '';
+          
+          # if explicit address was given in options, just use it!
+          if (my $address = $self->{options}->{$descent}->{address}) {
+            $accessorType = 'direct-address';
+            $accessorName = $address;
+          }
+          
+          # c)
+          elsif (($dbType eq 'DBI' || $dbType eq 'Tangram') && $self->{meta}->{$descent}->{nodeType}) {
+            $accessorType = 'node-type';
+            $accessorName = $self->{meta}->{$descent}->{nodeType};
+          }
+
+          # b)
+          elsif ($nodename) {
+            $accessorType = 'node-name';
+            $accessorName = $nodename;
+          }
+
+      # write accessor information to metadata
+      $self->{meta}->{$descent}->{accessorType} = $accessorType;
+      $self->{meta}->{$descent}->{accessorName} = $accessorName;
+    
+    }
+
+  # trace
+    #print Dumper($self->{meta});
+    #print Dumper($self->{options});
+    #exit;
 
 }
 
 
+
+sub buildAttributeMap {
+
+ my $self = shift;
+
+  # field-structure for building sql
+  # mapping of sql-fieldnames to object-attributes
+    $self->{node}->{map} = {};
+
+    # manually set ...
+      # ... object-id
+      $self->{node}->{map}->{$self->{meta}->{target}->{IdentProvider}->{arg}} = $self->{node}->{source}->{ident};
+      # ... checksum
+      $self->{node}->{map}->{cs} = $self->{node}->{source}->{checksum};
+
+#print "sqlmap: ", Dumper($self->{node}->{map}), "\n";
+
+#print Dumper($self);
+#exit;
+
+    # for transferring flat structures via simple (1:1) mapping
+    # TODO: diff per property / property value
+
+    #if ($self->{args}->{mapping}) {
+      # apply mapping from $self->{args}->{mapping} to $self->{node}->{map}
+      #foreach my $key (@{$self->{meta}->{source}->{childnodes}}) {
+      my @childnodes = @{$self->{meta}->{source}->{childnodes}};
+      for (my $mapidx = 0; $mapidx <= $#childnodes; $mapidx++) {
+        #my $map_right = $self->{args}->{mapping}->{$key};
+        
+        $self->{node}->{source}->{propcache} = {};
+        $self->{node}->{target}->{propcache} = {};
+        
+        # get property name
+        $self->{node}->{source}->{propcache}->{property} = $self->{meta}->{source}->{childnodes}->[$mapidx];
+        $self->{node}->{target}->{propcache}->{property} = $self->{meta}->{target}->{childnodes}->[$mapidx];
+        #print "map: $map_right", "\n";
+
+        # get property value
+        my $value;
+        
+        # detect for callback - old style - (maybe the better???)
+        if (ref($self->{node}->{target}->{map}) eq 'CODE') {
+          #$value = &$map_right($objClone);
+        } else {
+          # plain (scalar?) value
+          #$value = $objClone->{$map_right};
+          $self->{node}->{source}->{propcache}->{value} = $self->{node}->{source}->{payload}->{$self->{node}->{source}->{propcache}->{property}};
+        }
+        #$self->{node}->{map}->{$key} = $value;
+        
+        # detect expression
+        # for transferring deeply nested structures described by expressions
+        #print "val: $self->{node}->{source}->{propcache}->{value}", "\n";
+        if ($self->{node}->{source}->{propcache}->{property} =~ s/^expr://) {
+          
+          # create an anonymous sub to act as callback target dispatcher
+            my $cb_dispatcher = sub {
+              #print "===============  CALLBACK DISPATCHER", "\n";
+              #print "ident: ", $self->{node}->{source}->{ident}, "\n";
+              #return $self->{node}->{source}->{ident};
+              
+            };
+          
+
+#print Dumper($self->{node});
+          
+          # build callback map for helper function
+          #my $cbmap = { $self->{meta}->{source}->{IdentProvider}->{arg} => $cb_dispatcher };
+          my $cbmap = {};
+          my $value = refexpr2perlref($self->{node}->{source}->{payload}, $self->{node}->{source}->{propcache}->{property}, $cbmap);
+          $self->{node}->{source}->{propcache}->{value} = $value;
+        }
+
+        # encode values dependent on type of underlying storage here - expand cases...
+        my $storage_type = $self->{meta}->{target}->{storage}->{locator}->{type};
+        if ($storage_type eq 'DBI') {
+          # ...for sql
+          # quotemeta?
+          $self->{node}->{source}->{propcache}->{value} = quotesql($self->{node}->{source}->{propcache}->{value});
+
+        } elsif ($storage_type eq 'Tangram') {
+          # iso? utf8 already possible?
+        
+        } elsif ($storage_type eq 'LDAP') {
+          # TODO: encode utf8 here?
+
+        }
+
+        # store value to transfer map
+        $self->{node}->{map}->{$self->{node}->{target}->{propcache}->{property}} = $self->{node}->{source}->{propcache}->{value};
+
+      }
+    #}
+
+    
+  # TODO: $logger->dump( ... );
+  #$logger->debug( "sqlmap:" . "\n" . Dumper($self->{node}->{map}) );
+#print "sqlmap: ", Dumper($self->{node}->{map}), "\n";
+#print "entrystatus: ", Dumper($self->{node}), "\n";
+
+}
+
 1;