Data/Transfer/SyncStep.pm

#################################
#
#  $Id$
#
#  $Log$
#
#################################

package Data::Transfer::SyncStep;

#require Exporter;
#@ISA = qw( Exporter );
#@EXPORT = qw( syncSet2Table );
                       
use strict;
use warnings;

use Data::Dumper;
use misc::HashExt;

# get logger instance
my $logger = Log::Dispatch::Config->instance;

sub new {
  my $invocant = shift;
  my $class = ref($invocant) || $invocant;
  my $self = { @_ };
  $logger->debug( __PACKAGE__ . "->new(@_)" );
  return bless $self, $class;
}

sub _dumpCompact {
  $Data::Dumper::Indent = 0;
  my $result = Dumper(@_);
  $Data::Dumper::Indent = 2;
  return $result;
}

sub syncSet2Table {

  my $self = shift;
  my $args = shift;

  my $tc = OneLineDumpHash->new( {} );


  my @results;
  if ($args->{objectSet}) {
    # set of objects is already in $args
    $logger->debug( __PACKAGE__ . "->syncSet2Table( objectSet => '" . $args->{objectSet} . "' )" );
    @results = @{$args->{objectSet}};
  } else {
    # get set of objects from odbms by object name
    $logger->debug( __PACKAGE__ . "->syncSet2Table( objectName => '" . $args->{objectName} . "' )" );
    my $objects_set = $self->{L}->remote($args->{objectName});
    @results = $self->{L}->select($objects_set);
  }

  # iterate through set
  foreach my $obj (@results) {

    # clone object (in case we have to modify it here)
    my $objClone = $obj;
    
    # exclude defined fields  (simply delete from object)
    foreach my $exField ( @{$args->{exclude}} ) {
      delete $objClone->{$exField};
    }
    
    # calculate checksum for current object
    my $oid = $self->{L}->id($objClone);

    #my $objdump = $oid . "\n" . $objClone->quickdump();
    my $objdump = $oid . "\n" . Dumper($objClone);

    # TODO: $logger->dump( ... );
    #$logger->debug( __PACKAGE__ . ": " . $objdump );
    #$logger->dump( __PACKAGE__ . ": " . $objdump );
    
    # build checksum for current object-dump
      # md5-based fingerprint, base64 encoded (from Digest::MD5)
        #my $checksum_cur = md5_base64($objdump) . '==';
      # 32-bit integer "hash" value (maybe faster?) (from DBI)
        my $checksum_cur = DBI::hash($objdump, 1);

    # get checksum for current entry from rdbms
    my $sql = "SELECT cs FROM $args->{sqlTable} WHERE $args->{sqlIdField}='$oid';";
    #my $result = sendSql($sql);
    my $result = $self->{R}->sendCommand($sql);
    my $row = $result->getNextEntry();
    my $checksum_remote = $row->{cs};
    
    # determine if entry is "new" or "dirty"
    my $bool_new = !$checksum_remote;
    my $bool_dirty = $bool_new || $checksum_cur ne $checksum_remote || $args->{force};
    print "c" if $main::args->{verbose};
    if (!$bool_dirty) {
      $tc->{in_sync}++;
      next;
    }

    # field-structure for building sql
    # mapping of sql-fieldnames to object-attributes
      my $sqlmap;

      # manually set ...
        # ... object-id
        $sqlmap->{$args->{sqlIdField}} = $self->{L}->id($objClone);
        # ... checksum
        $sqlmap->{cs} = $checksum_cur;


      if ($args->{mapping}) {
        # apply mapping from $args->{mapping} to $sqlmap
        foreach my $key (keys %{$args->{mapping}}) {
          my $map_right = $args->{mapping}->{$key};
          #print "map: $map_right", "\n";
          my $value;
          # detect for callback
          if (ref($map_right) eq 'CODE') {
            $value = &$map_right($objClone);
          } else {
            $value = $objClone->{$map_right};
          }
          #$sqlmap->{$key} = $value;
          $sqlmap->{$key} = $self->{R}->quoteSql($value);
        }
      }

      if ($args->{mappingV2}) {
        
        # apply mapping from $args->{mappingV2} to $sqlmap
        foreach my $mapStep (@{$args->{mappingV2}}) {
          
          # prepare left/right keys/values
          my $left_key = $mapStep->{left};
          my $left_val = _resolveMapStepExpr( $objClone, $mapStep->{left} );
          my $right_key = $mapStep->{right};
          my $right_val = ( $mapStep->{right} );
          #print "map: $map_right", "\n";
          
          if ($mapStep->{method}) {
            if ($mapStep->{method} eq 'v:1') {
              $left_val = $left_key;
            }
          }

          #$sqlmap->{$key} = $value;
          #if ( grep(!/$right_key/, @{$args->{exclude}}) ) {
            $sqlmap->{$right_key} = $self->{R}->quoteSql($left_val);
          #}
        }
      }
      
    # TODO: $logger->dump( ... );
    #$logger->debug( "sqlmap:" . "\n" . Dumper($sqlmap) );

    my $sql_main;
    if ($bool_new) {
      $tc->{attempt_new}++;
      $sql_main = $self->{R}->hash2Sql($args->{sqlTable}, $sqlmap, 'SQL_INSERT');
    } else {
      $tc->{attempt_modify}++;
      $sql_main = $self->{R}->hash2Sql($args->{sqlTable}, $sqlmap, 'SQL_UPDATE', "$args->{sqlIdField}='$sqlmap->{$args->{sqlIdField}}'");
    }
    
    my $sqlHandle = $self->{R}->sendCommand($sql_main);
    if (!$sqlHandle->err) {
      $tc->{ok}++;
      print "t" if $main::args->{verbose};
    } else {
      $tc->{error}++;
      push( @{$tc->{error_per_row}}, { 
        statement => $sql_main,
        state => $sqlHandle->state, 
        err => $sqlHandle->err, 
        errstr => $sqlHandle->errstr, 
      } );
      #if ($args->{debug}) { print "sql-error with statement: $sql_main", "\n"; }
      print "e" if $main::args->{verbose};
    }
  
  }
  print "\n" if $main::args->{verbose};
  
  
  # build user-message from some stats and log it via "sysevent"
  # change logging level in case of an error
  
    my $level = 'LEVEL_INFO';
    
    my $msg;
    
#    $msg .= "stats: ";
#      $tc->{in_sync} && ($msg .= "in-sync: $tc->{in_sync}");
#      $tc->{attempt_new} && ($msg .= "  /  " . "attempt-new: $tc->{attempt_new}");
#      $tc->{attempt_modify} && ($msg .= "  /  " . "attempt-modify: $tc->{attempt_modify}");
#      $tc->{ok} && ($msg .= "  /  " . "result-ok: $tc->{ok}");
#      $tc->{error} && ($msg .= "  /  " . "result-error: $tc->{error}");
    
    $msg .= "stats: $tc";
    
    if ($tc->{error_per_row}) {
      $msg .= "\n";
      $level = 'LEVEL_NOTIFY';
      $msg .= "errors:" . "\n";
      $msg .= Dumper($tc->{error_per_row});
    }
    
    # todo!!!
    #sysevent( { usermsg => $msg, level => $level }, $taskEvent );
    $logger->info($msg);

  return $tc;

}

sub _resolveMapStepExpr {

  my $obj = shift;
  my $expr = shift;

          my $value;
          # detect for callback (code-reference)
          if (ref($expr) eq 'CODE') {
            $value = &$expr($obj);
          } elsif ($expr =~ m/->/) {
            # use expr as complex object reference declaration (obj->subObj->subSubObj->0->attribute)
            my $objPerlRefString = _mapStepExprToPerlRefString($expr);
            #print "\n", "expr: $expr";
            #print "\n", "objPerlRefString: $objPerlRefString";
            $value = eval('$obj' . '->' . $objPerlRefString);
          } else {
            # use expr as simple scalar key (attributename)
            $value = $obj->{$expr};
          }
          
  return $value;
  
}

sub _mapStepExprToPerlRefString {
  my $expr = shift;

  # split expression by dereference operators first
  my @parts = split(/->/, $expr);

  # wrap []'s around each part, if it consists of numeric characters only (=> numeric array-index),
  # use {}'s, if there are word-characters in it (=> alphanumeric hash-key)
  map {
    m/^\d+$/ && ($_ = "[$_]") || ($_ = "{$_}");
  } @parts;

  # join parts with dereference operators together again and return built string
  return join('->', @parts);
}


1;
1	#################################
2	#
3	# $Id$
4	#
5	# $Log$
6	#
7	#################################
8
9	package Data::Transfer::SyncStep;
10
11	#require Exporter;
12	#@ISA = qw( Exporter );
13	#@EXPORT = qw( syncSet2Table );
14
15	use strict;
16	use warnings;
17
18	use Data::Dumper;
19	use misc::HashExt;
20
21	# get logger instance
22	my $logger = Log::Dispatch::Config->instance;
23
24	sub new {
25	my $invocant = shift;
26	my $class = ref($invocant) \|\| $invocant;
27	my $self = { @_ };
28	$logger->debug( __PACKAGE__ . "->new(@_)" );
29	return bless $self, $class;
30	}
31
32	sub _dumpCompact {
33	$Data::Dumper::Indent = 0;
34	my $result = Dumper(@_);
35	$Data::Dumper::Indent = 2;
36	return $result;
37	}
38
39	sub syncSet2Table {
40
41	my $self = shift;
42	my $args = shift;
43
44	my $tc = OneLineDumpHash->new( {} );
45
46
47	my @results;
48	if ($args->{objectSet}) {
49	# set of objects is already in $args
50	$logger->debug( __PACKAGE__ . "->syncSet2Table( objectSet => '" . $args->{objectSet} . "' )" );
51	@results = @{$args->{objectSet}};
52	} else {
53	# get set of objects from odbms by object name
54	$logger->debug( __PACKAGE__ . "->syncSet2Table( objectName => '" . $args->{objectName} . "' )" );
55	my $objects_set = $self->{L}->remote($args->{objectName});
56	@results = $self->{L}->select($objects_set);
57	}
58
59	# iterate through set
60	foreach my $obj (@results) {
61
62	# clone object (in case we have to modify it here)
63	my $objClone = $obj;
64
65	# exclude defined fields (simply delete from object)
66	foreach my $exField ( @{$args->{exclude}} ) {
67	delete $objClone->{$exField};
68	}
69
70	# calculate checksum for current object
71	my $oid = $self->{L}->id($objClone);
72
73	#my $objdump = $oid . "\n" . $objClone->quickdump();
74	my $objdump = $oid . "\n" . Dumper($objClone);
75
76	# TODO: $logger->dump( ... );
77	#$logger->debug( __PACKAGE__ . ": " . $objdump );
78	#$logger->dump( __PACKAGE__ . ": " . $objdump );
79
80	# build checksum for current object-dump
81	# md5-based fingerprint, base64 encoded (from Digest::MD5)
82	#my $checksum_cur = md5_base64($objdump) . '==';
83	# 32-bit integer "hash" value (maybe faster?) (from DBI)
84	my $checksum_cur = DBI::hash($objdump, 1);
85
86	# get checksum for current entry from rdbms
87	my $sql = "SELECT cs FROM $args->{sqlTable} WHERE $args->{sqlIdField}='$oid';";
88	#my $result = sendSql($sql);
89	my $result = $self->{R}->sendCommand($sql);
90	my $row = $result->getNextEntry();
91	my $checksum_remote = $row->{cs};
92
93	# determine if entry is "new" or "dirty"
94	my $bool_new = !$checksum_remote;
95	my $bool_dirty = $bool_new \|\| $checksum_cur ne $checksum_remote \|\| $args->{force};
96	print "c" if $main::args->{verbose};
97	if (!$bool_dirty) {
98	$tc->{in_sync}++;
99	next;
100	}
101
102	# field-structure for building sql
103	# mapping of sql-fieldnames to object-attributes
104	my $sqlmap;
105
106	# manually set ...
107	# ... object-id
108	$sqlmap->{$args->{sqlIdField}} = $self->{L}->id($objClone);
109	# ... checksum
110	$sqlmap->{cs} = $checksum_cur;
111
112
113	if ($args->{mapping}) {
114	# apply mapping from $args->{mapping} to $sqlmap
115	foreach my $key (keys %{$args->{mapping}}) {
116	my $map_right = $args->{mapping}->{$key};
117	#print "map: $map_right", "\n";
118	my $value;
119	# detect for callback
120	if (ref($map_right) eq 'CODE') {
121	$value = &$map_right($objClone);
122	} else {
123	$value = $objClone->{$map_right};
124	}
125	#$sqlmap->{$key} = $value;
126	$sqlmap->{$key} = $self->{R}->quoteSql($value);
127	}
128	}
129
130	if ($args->{mappingV2}) {
131
132	# apply mapping from $args->{mappingV2} to $sqlmap
133	foreach my $mapStep (@{$args->{mappingV2}}) {
134
135	# prepare left/right keys/values
136	my $left_key = $mapStep->{left};
137	my $left_val = _resolveMapStepExpr( $objClone, $mapStep->{left} );
138	my $right_key = $mapStep->{right};
139	my $right_val = ( $mapStep->{right} );
140	#print "map: $map_right", "\n";
141
142	if ($mapStep->{method}) {
143	if ($mapStep->{method} eq 'v:1') {
144	$left_val = $left_key;
145	}
146	}
147
148	#$sqlmap->{$key} = $value;
149	#if ( grep(!/$right_key/, @{$args->{exclude}}) ) {
150	$sqlmap->{$right_key} = $self->{R}->quoteSql($left_val);
151	#}
152	}
153	}
154
155	# TODO: $logger->dump( ... );
156	#$logger->debug( "sqlmap:" . "\n" . Dumper($sqlmap) );
157
158	my $sql_main;
159	if ($bool_new) {
160	$tc->{attempt_new}++;
161	$sql_main = $self->{R}->hash2Sql($args->{sqlTable}, $sqlmap, 'SQL_INSERT');
162	} else {
163	$tc->{attempt_modify}++;
164	$sql_main = $self->{R}->hash2Sql($args->{sqlTable}, $sqlmap, 'SQL_UPDATE', "$args->{sqlIdField}='$sqlmap->{$args->{sqlIdField}}'");
165	}
166
167	my $sqlHandle = $self->{R}->sendCommand($sql_main);
168	if (!$sqlHandle->err) {
169	$tc->{ok}++;
170	print "t" if $main::args->{verbose};
171	} else {
172	$tc->{error}++;
173	push( @{$tc->{error_per_row}}, {
174	statement => $sql_main,
175	state => $sqlHandle->state,
176	err => $sqlHandle->err,
177	errstr => $sqlHandle->errstr,
178	} );
179	#if ($args->{debug}) { print "sql-error with statement: $sql_main", "\n"; }
180	print "e" if $main::args->{verbose};
181	}
182
183	}
184	print "\n" if $main::args->{verbose};
185
186
187	# build user-message from some stats and log it via "sysevent"
188	# change logging level in case of an error
189
190	my $level = 'LEVEL_INFO';
191
192	my $msg;
193
194	# $msg .= "stats: ";
195	# $tc->{in_sync} && ($msg .= "in-sync: $tc->{in_sync}");
196	# $tc->{attempt_new} && ($msg .= " / " . "attempt-new: $tc->{attempt_new}");
197	# $tc->{attempt_modify} && ($msg .= " / " . "attempt-modify: $tc->{attempt_modify}");
198	# $tc->{ok} && ($msg .= " / " . "result-ok: $tc->{ok}");
199	# $tc->{error} && ($msg .= " / " . "result-error: $tc->{error}");
200
201	$msg .= "stats: $tc";
202
203	if ($tc->{error_per_row}) {
204	$msg .= "\n";
205	$level = 'LEVEL_NOTIFY';
206	$msg .= "errors:" . "\n";
207	$msg .= Dumper($tc->{error_per_row});
208	}
209
210	# todo!!!
211	#sysevent( { usermsg => $msg, level => $level }, $taskEvent );
212	$logger->info($msg);
213
214	return $tc;
215
216	}
217
218	sub _resolveMapStepExpr {
219
220	my $obj = shift;
221	my $expr = shift;
222
223	my $value;
224	# detect for callback (code-reference)
225	if (ref($expr) eq 'CODE') {
226	$value = &$expr($obj);
227	} elsif ($expr =~ m/->/) {
228	# use expr as complex object reference declaration (obj->subObj->subSubObj->0->attribute)
229	my $objPerlRefString = _mapStepExprToPerlRefString($expr);
230	#print "\n", "expr: $expr";
231	#print "\n", "objPerlRefString: $objPerlRefString";
232	$value = eval('$obj' . '->' . $objPerlRefString);
233	} else {
234	# use expr as simple scalar key (attributename)
235	$value = $obj->{$expr};
236	}
237
238	return $value;
239
240	}
241
242	sub _mapStepExprToPerlRefString {
243	my $expr = shift;
244
245	# split expression by dereference operators first
246	my @parts = split(/->/, $expr);
247
248	# wrap []'s around each part, if it consists of numeric characters only (=> numeric array-index),
249	# use {}'s, if there are word-characters in it (=> alphanumeric hash-key)
250	map {
251	m/^\d+$/ && ($_ = "[$_]") \|\| ($_ = "{$_}");
252	} @parts;
253
254	# join parts with dereference operators together again and return built string
255	return join('->', @parts);
256	}
257
258
259	1;
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26