--- nfo/perl/libs/Data/Transfer/Sync/Core.pm 2003/02/09 05:01:10 1.4 +++ nfo/perl/libs/Data/Transfer/Sync/Core.pm 2003/05/13 08:17:52 1.9 @@ -1,11 +1,30 @@ -## $Id: Core.pm,v 1.4 2003/02/09 05:01:10 joko Exp $ +## ------------------------------------------------------------------------- +## +## $Id: Core.pm,v 1.9 2003/05/13 08:17:52 joko Exp $ ## ## Copyright (c) 2002 Andreas Motl ## ## See COPYRIGHT section in pod text below for usage and distribution rights. ## -## ---------------------------------------------------------------------------------------- +## ------------------------------------------------------------------------- ## $Log: Core.pm,v $ +## Revision 1.9 2003/05/13 08:17:52 joko +## buildAttributeMap now propagates error +## +## Revision 1.8 2003/03/27 15:31:15 joko +## fixes to modules regarding new namespace(s) below Data::Mungle::* +## +## Revision 1.7 2003/02/21 08:01:11 joko +## debugging, logging +## renamed module +## +## Revision 1.6 2003/02/14 14:03:49 joko +## + logging, debugging +## - refactored code to sister module +## +## Revision 1.5 2003/02/11 05:30:47 joko +## + minor fixes and some debugging mud +## ## Revision 1.4 2003/02/09 05:01:10 joko ## + major structure changes ## - refactored code to sister modules @@ -52,7 +71,7 @@ ## + minor cosmetics for logging ## ## Revision 1.2 2002/12/01 04:43:25 joko -## + mapping deatil entries may now be either an ARRAY or a HASH +## + mapping detail entries may now be either an ARRAY or a HASH ## + erase flag is used now (for export-operations) ## + expressions to refer to values inside deep nested structures ## - removed old mappingV2-code @@ -64,7 +83,7 @@ ## ## Revision 1.1 2002/10/10 03:44:21 cvsjoko ## + new -## ---------------------------------------------------------------------------------------- +## ------------------------------------------------------------------------- package Data::Transfer::Sync::Core; @@ -79,10 +98,12 @@ use Data::Dumper; -use misc::HashExt; -use Data::Compare::Struct qw( getDifference isEmpty ); +#use misc::HashExt; +use Hash::Serializer; +use Data::Mungle::Compare::Struct qw( getDifference isEmpty ); use Data::Storage::Container; use DesignPattern::Object; +use shortcuts::database qw( quotesql ); # get logger instance my $logger = Log::Dispatch::Config->instance; @@ -113,6 +134,10 @@ $self->{container}->addStorage($_, $self->{storages}->{$_}); } + # trace + #print Dumper($self); + #exit; + return 1; } @@ -140,7 +165,7 @@ $logger->debug( __PACKAGE__ . "->_run" ); # for statistics - my $tc = OneLineDumpHash->new( {} ); + my $tc = Hash::Serializer->new( {} ); my $results; # set of objects is already in $self->{args} @@ -178,6 +203,8 @@ # iterate through set foreach my $source_node_real (@results) { + print ":" if $self->{verbose}; + $tc->{total}++; #print "======================== iter", "\n"; @@ -187,11 +214,14 @@ # - is a "deep_copy" needed here if occouring modifications take place? # - puuhhhh, i guess a deep_copy would destroy tangram mechanisms? # - after all, just take care for now that this object doesn't get updated! + # - so, just use its reference for now - if some cloning is needed in future, do this here! my $source_node = $source_node_real; # modify entry - handle new style callbacks (the readers) -#print Dumper($source_node); -#exit; + + # trace + #print Dumper($source_node); + #exit; my $descent = 'source'; @@ -199,6 +229,10 @@ my $map_callbacks = {}; if (my $callbacks = $self->{meta}->{$descent}->{Callback}) { + # trace + #print Dumper($callbacks); + #exit; + my $error = 0; foreach my $node (keys %{$callbacks->{read}}) { @@ -206,6 +240,9 @@ my $object = $source_node; my $value; # = $source_node->{$node}; + # trace + #print Dumper($self->{options}); + # ------------ half-redundant: make $self->callCallback($object, $value, $opts) #my $perl_callback = $self->{meta}->{$descent}->{node} . '::' . $node . '_read'; my $perl_callback = $self->{meta}->{$descent}->{nodeType} . '::' . $node . '_read'; @@ -213,9 +250,9 @@ #print $evalstring, "\n"; exit; my $cb_result = eval($evalstring); if ($@) { - die $@; $error = 1; - print $@, "\n"; + $logger->error( __PACKAGE__ . "->_run: $@" ); + next; } # ------------ half-redundant: make $self->callCallback($object, $value, $opts) @@ -225,7 +262,8 @@ } -#print Dumper($source_node); + # trace + #print Dumper($source_node); # exclude defined fields (simply delete from object) map { delete $source_node->{$_} } @{$self->{meta}->{source}->{subnodes_exclude}}; @@ -234,7 +272,9 @@ $self->{node} = {}; $self->{node}->{source}->{payload} = $source_node; -#print "res - ident", "\n"; + # trace + #print Dumper($self->{node}); + #exit; # determine ident of entry my $identOK = $self->_resolveNodeIdent('source'); @@ -256,8 +296,6 @@ #print "checksum", "\n"; - print ":" if $self->{verbose}; - #print Dumper($self); # determine status of entry by synchronization method @@ -290,8 +328,11 @@ # determine if entry is "new" or "dirty" # after all, this seems to be the point where the hammer falls..... print "c" if $self->{verbose}; -#print Dumper($self->{node}); -#exit; + + # trace + #print Dumper($self->{node}); + #exit; + $self->{node}->{status}->{new} = !$self->{node}->{target}->{checksum}; if (!$self->{node}->{status}->{new}) { $self->{node}->{status}->{dirty} = @@ -306,7 +347,6 @@ $tc->{skip}++; print "s" if $self->{verbose}; next; - } # first reaction on entry-status: continue with next entry if the current is already "in sync" @@ -316,12 +356,16 @@ } # build map to actually transfer the data from source to target - $self->buildAttributeMap(); - - -#print Dumper($self->{node}); exit; + if (!$self->buildAttributeMap()) { + #$logger->warning( __PACKAGE__ . "->_run: Attribute Map could not be created. Will not insert or modify node."); + $tc->{skip}++; + print "e" if $self->{verbose}; + next; + } -#print "attempt", "\n"; + # trace + #print Dumper($self->{node}); exit; + #print "attempt", "\n"; # additional (new) checks for feature "write-protection" if ($self->{meta}->{target}->{storage}->{isWriteProtected}) { @@ -334,8 +378,9 @@ next; } -#print Dumper($self); -#exit; + # trace + #print Dumper($self); + #exit; # transfer contents of map to target if ($self->{node}->{status}->{new}) { @@ -371,7 +416,8 @@ # change ident in source (take from target), if transfer was ok and target is an IdentAuthority # this is (for now) called a "retransmit" indicated by a "r"-character when verbosing - if ($self->{node}->{status}->{ok} && $self->{options}->{target}->{storage}->{idAuthority}) { + #if ($self->{node}->{status}->{ok} && $self->{options}->{target}->{storage}->{idAuthority}) { + if ($self->{node}->{status}->{ok} && $self->{meta}->{target}->{isIdentAuthority}) { print "r" if $self->{verbose}; #print Dumper($self->{meta}); #print Dumper($self->{node}); @@ -394,7 +440,8 @@ # todo!!! #sysevent( { usermsg => $msg, level => $level }, $taskEvent ); - $logger->info( __PACKAGE__ . "->_run: $msg" ); + #$logger->info( __PACKAGE__ . "->_run: $msg" ); + $logger->info($msg . "\n"); return $tc; @@ -449,8 +496,12 @@ sub _doTransferToTarget { my $self = shift; my $action = shift; - #print Dumper($self->{node}); - #exit; + + # trace + #print Dumper($self->{meta}); + #print Dumper($self->{node}); + #exit; + $self->_modifyNode('target', $action, $self->{node}->{map}); } @@ -551,7 +602,7 @@ $i++; } - print "\n" if $self->{verbose}; + #print "\n" if $self->{verbose}; if (!$i) { $logger->warning( __PACKAGE__ . "->_prepareNode_DummyIdent: no nodes touched" ); @@ -568,12 +619,6 @@ return ''; } -sub _erase_all { - my $self = shift; - my $descent = shift; - #my $node = shift; - my $node = $self->{meta}->{$descent}->{node}; - $self->{meta}->{$descent}->{storage}->eraseAll($node); -} 1; +__END__