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	cvsjoko	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