--- nfo/perl/libs/DesignPattern/Object.pm	2003/02/09 16:24:46	1.5
+++ nfo/perl/libs/DesignPattern/Object.pm	2003/05/13 08:46:08	1.10
@@ -1,7 +1,23 @@
 ## ---------------------------------------------------------------------------
-##  $Id: Object.pm,v 1.5 2003/02/09 16:24:46 joko Exp $
+##  $Id: Object.pm,v 1.10 2003/05/13 08:46:08 joko Exp $
 ## ---------------------------------------------------------------------------
 ##  $Log: Object.pm,v $
+##  Revision 1.10  2003/05/13 08:46:08  joko
+##  pod and comments
+##
+##  Revision 1.9  2003/03/27 15:44:32  joko
+##  fixes/enhancements to 'sub log_basic'
+##
+##  Revision 1.8  2003/02/19 00:36:59  joko
+##  + bugfix: this {logger} is the instance itself, so has to be fed with ( level => xyz and namespace => xyz )
+##  + minor modifications in behaviour
+##
+##  Revision 1.7  2003/02/18 18:34:35  joko
+##  + fix: just logs if possible (sub log_basic)
+##
+##  Revision 1.6  2003/02/11 11:04:27  joko
+##  + metadata (args, caller, etc.) are now stored inside {__bridge}
+##
 ##  Revision 1.5  2003/02/09 16:24:46  joko
 ##  + pseudo constructor mechanism by calling method 'constructor' on object instantiation
 ##
@@ -19,6 +35,19 @@
 ##
 ## ---------------------------------------------------------------------------
 
+=pod
+
+=head1 NAME
+
+  DesignPattern::Object
+
+
+=head1 TODO
+
+  o use Class::Loader
+
+
+=cut
 
 package DesignPattern::Object;
 
@@ -31,8 +60,12 @@
 #use Devel::StackTrace;
 
 
-# get logger instance
-my $logger = eval { Log::Dispatch::Config->instance; };
+my $_dp_globals;
+
+$_dp_globals = {
+  TRACE => 0,
+};
+
 
 sub new {
   
@@ -42,7 +75,7 @@
   # use already blessed reference, if passed in - else use the very classname
   my $class = ref ($classname) || $classname;
   
-  $logger->debug( "$classname->new( ... )" . "\t[via " . __PACKAGE__ . "]" ) if $logger;
+  #$self->log_basic( "$classname->new( ... )" . "\t[via " . __PACKAGE__ . "]" , 'debug');
   
   # the base for our object - a plain perl hash, which ....
   my $self = {};
@@ -57,7 +90,7 @@
   # TODO: what about logging in here? inherit from 
   # DesignPattern::Object::Logger for this purpose....
   # ... or would this give us (harmful) circular module dependencies???
-  #$logger->debug( __PACKAGE__ . "->new( @args )" );      # this is not "common"!
+  #$self->log_basic( __PACKAGE__ . "->new( @args )", 'debug' );      # this is not "common"!
 
     
   # remember the stacktrace: abstract this out (DesignPattern::Object::Trace) or parametrize!
@@ -86,22 +119,39 @@
   # mixin arguments
   $self = { @args };
   
-  # mixin seperate
-  $self->{'__arg'} = $seperate if $seperate;
+  # scan for arguments prefixed by a double underscore '__'
+  foreach (keys %$self) {
+    if (/^__(.+?)$/) {
+      $self->{__bridge}->{$1} = $self->{$_};
+      delete $self->{$_};
+    }
+  }
+  
+  # mixin seperate - FIXME: should this not be done after blessing?
+  $self->{__bridge}->{'arg'} = $seperate if $seperate;
 
   # ... bless hash into object using classname
   bless $self, $class;
 
   # remember the caller
-    $self->{'__caller'} = caller;
+    $self->{__bridge}->{caller_module}  = caller;
     #print Dumper(caller(2));
     #exit;
 
-  $self->{__classname} = $classname;
+  $self->{__bridge}->{class_name} = $classname;
+
+  # patches for backward compatibility
+    $self->{'__arg'} = $self->{__bridge}->{'arg'} if $self->{__bridge}->{'arg'};
+    $self->{'__caller'} = $self->{__bridge}->{caller_module} if $self->{__bridge}->{caller_module};
+    $self->{'__classname'} = $self->{__bridge}->{class_name} if $self->{__bridge}->{class_name};
 
   $self->_init() if $self->can('_init');
   $self->constructor() if $self->can('constructor');
 
+  # trace
+    #print Dumper($self);
+    #exit;
+
   return $self;
 }  
 
@@ -110,7 +160,7 @@
   my $self_classname = ref $self;
   my $function_name = shift;
   # was:
-  $logger->warning( __PACKAGE__ . ": function '$function_name' is an abstract method, please implement it in '$self_classname'.");
+  $self->log_basic( __PACKAGE__ . ": function '$function_name' is an abstract method, please implement it in '$self_classname'.", 'warning');
   # is:
   #die( __PACKAGE__ . ": Function '$function_name' is an abstract method, please implement it in '$self_classname'.");
   #exit;
@@ -127,32 +177,37 @@
 
 #print Dumper($args);
 
-  $logger->debug( __PACKAGE__ . "->fromPackage( pkgname $pkgname args @args )" );
+  $self->log_basic( __PACKAGE__ . "->fromPackage( pkgname $pkgname args @args )", 'debug');
   
   # perl-load
     my $evstring = "use $pkgname;";
     eval($evstring);
   
   # report errors
+  # Could this be united with DesignPattern::Loader::checkExceptions?
     if ($@) {
       # build error-messages
-      my $errmsg_native = __PACKAGE__ . ':' . __LINE__ . " Error in eval \"$evstring\": " .  $@;
+      my $issuer = __PACKAGE__ . ':' . __LINE__;
+      my $errmsg_native = "Error in eval: " .  $@;
       #my $classname = $self->{__classname};
       my $errmsg_critical = '';
       if ($errmsg_native =~ m/Can't locate (.+?) in \@INC/) {
-        $errmsg_critical = "Could not instantiate object from package '$pkgname' - location of '$1' failed.";
+        $errmsg_critical = "Could not instantiate object from package '$pkgname' ('$1' not found).";
       } else {
         $errmsg_critical = $errmsg_native;
       }
       # write error to logging-output (console|file|database)
-      $logger->debug( $errmsg_native );
-      $logger->critical( $errmsg_critical );
+      $self->log_basic( $errmsg_native . " (issuer='$issuer', code='$evstring')", 'debug' );
+      $self->log_basic( $errmsg_critical, 'warning' );
       return;
     }
   
   # object-creation
     my $object = $pkgname->new(@args);
 
+  # trace
+    #print Dumper($object);
+
   # run boot-methods on object
     $object->_init() if $object->can('_init');
     $object->constructor() if $object->can('constructor');
@@ -160,4 +215,38 @@
   return $object;
 }
 
+sub log_basic {
+  my $self = shift;
+  my $message = shift;
+  my $level = shift;
+  
+  #return;
+  $level ||= 'info';
+
+  my $notSoGood = ($level =~ /warning|error|critical/);
+  
+  # STDERR?
+  if ($level && $notSoGood) {
+    print STDERR $level, ": ", $message, "\n";
+  }
+
+  # STDOUT?
+  if ($_dp_globals->{TRACE} || $notSoGood) {
+    print $level, ": ", $message, "\n";
+  }
+
+  # get logger instance
+  if (!$_dp_globals->{logger}) {
+    $_dp_globals->{logger} = eval { Log::Dispatch::Config->instance; };
+  }
+  
+  if ($_dp_globals->{logger}) {
+    $_dp_globals->{logger}->log( level => $level, message => $message);
+  #} else {
+    #print $level, ": ", $message, "\n";
+  }
+  
+}
+
 1;
+__END__