--- nfo/perl/libs/DesignPattern/Object.pm	2002/12/27 16:05:42	1.2
+++ nfo/perl/libs/DesignPattern/Object.pm	2003/01/20 16:54:22	1.3
@@ -1,14 +1,17 @@
-## --------------------------------------------------------------------------------
-##  $Id: Object.pm,v 1.2 2002/12/27 16:05:42 joko Exp $
-## --------------------------------------------------------------------------------
+## ---------------------------------------------------------------------------
+##  $Id: Object.pm,v 1.3 2003/01/20 16:54:22 joko Exp $
+## ---------------------------------------------------------------------------
 ##  $Log: Object.pm,v $
+##  Revision 1.3  2003/01/20 16:54:22  joko
+##  + sub fromPackage: refactored from libp's 'getNewPerlObjFromPkgName' or s.th.l.th.
+##
 ##  Revision 1.2  2002/12/27 16:05:42  joko
 ##  + played with Devel::CallerItem and Devel::StackTrace
 ##
 ##  Revision 1.1  2002/12/13 21:46:29  joko
 ##  + initial check-in
 ##
-## --------------------------------------------------------------------------------
+## ---------------------------------------------------------------------------
 
 
 package DesignPattern::Object;
@@ -21,6 +24,10 @@
 #use Devel::CallerItem;
 #use Devel::StackTrace;
 
+
+# get logger instance
+my $logger = Log::Dispatch::Config->instance;
+
 sub new {
   
   # the classname in most cases
@@ -29,6 +36,8 @@
   # use already blessed reference, if passed in - else use the very classname
   my $class = ref ($classname) || $classname;
   
+  $logger->debug( "$classname->new( ... )" . "\t[via " . __PACKAGE__ . "]" );
+  
   # the base for our object - a plain perl hash, which ....
   my $self = {};
   # note:
@@ -44,10 +53,6 @@
   # ... or would this give us (harmful) circular module dependencies???
   #$logger->debug( __PACKAGE__ . "->new( @args )" );      # this is not "common"!
 
-  # remember the caller
-    $self->{'__caller'} = caller;
-    #print Dumper(caller(2));
-    #exit;
     
   # remember the stacktrace: abstract this out (DesignPattern::Object::Trace) or parametrize!
   #my $trace = Devel::StackTrace->new();
@@ -59,6 +64,7 @@
   #print Dumper($self);
   #exit;
 
+
   # argument-handling ...
 
     # ... get them ...
@@ -79,7 +85,16 @@
 
   # ... bless hash into object using classname
   bless $self, $class;
+
+  # remember the caller
+    $self->{'__caller'} = caller;
+    #print Dumper(caller(2));
+    #exit;
+
+  $self->{__classname} = $classname;
+
   $self->_init() if $self->can('_init');
+
   return $self;
 }  
 
@@ -88,10 +103,53 @@
   my $self_classname = ref $self;
   my $function_name = shift;
   # was:
-  # $logger->error( __PACKAGE__ . ": function \"$fName\" is an abstract method, please implement it in \"$class\"");
+  $logger->warning( __PACKAGE__ . ": function '$function_name' is an abstract method, please implement it in '$self_classname'.");
   # is:
-  die( __PACKAGE__ . ": Function '$function_name' is an abstract method, please implement it in '$self_classname'.");
+  #die( __PACKAGE__ . ": Function '$function_name' is an abstract method, please implement it in '$self_classname'.");
   #exit;
 }
 
+sub fromPackage {
+  my $self = shift;
+  #my $self_classname = ref $self;
+  my $pkgname = shift;
+  my @args = @_;
+#  my $args = shift;
+
+#      my $caller = $self->{'__caller'};
+
+#print Dumper($args);
+
+  $logger->debug( __PACKAGE__ . "->fromPackage( pkgname $pkgname args @args )" );
+  
+  # perl-load
+    my $evstring = "use $pkgname;";
+    eval($evstring);
+  
+  # report errors
+    if ($@) {
+      # build error-messages
+      my $errmsg_native = __PACKAGE__ . ':' . __LINE__ . " Error in eval \"$evstring\": " .  $@;
+      #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.";
+      } else {
+        $errmsg_critical = $errmsg_native;
+      }
+      # write error to logging-output (console|file|database)
+      $logger->debug( $errmsg_native );
+      $logger->critical( $errmsg_critical );
+      return;
+    }
+  
+  # object-creation
+    my $object = $pkgname->new(@args);
+
+  # run boot-methods on object
+    $object->_init() if $object->can('_init');
+
+  return $object;
+}
+
 1;