/[cvs]/nfo/perl/libs/DesignPattern/Object.pm
ViewVC logotype

Diff of /nfo/perl/libs/DesignPattern/Object.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.6 by joko, Tue Feb 11 11:04:27 2003 UTC revision 1.8 by joko, Wed Feb 19 00:36:59 2003 UTC
# Line 2  Line 2 
2  ##  $Id$  ##  $Id$
3  ## ---------------------------------------------------------------------------  ## ---------------------------------------------------------------------------
4  ##  $Log$  ##  $Log$
5    ##  Revision 1.8  2003/02/19 00:36:59  joko
6    ##  + bugfix: this {logger} is the instance itself, so has to be fed with ( level => xyz and namespace => xyz )
7    ##  + minor modifications in behaviour
8    ##
9    ##  Revision 1.7  2003/02/18 18:34:35  joko
10    ##  + fix: just logs if possible (sub log_basic)
11    ##
12  ##  Revision 1.6  2003/02/11 11:04:27  joko  ##  Revision 1.6  2003/02/11 11:04:27  joko
13  ##  + metadata (args, caller, etc.) are now stored inside {__bridge}  ##  + metadata (args, caller, etc.) are now stored inside {__bridge}
14  ##  ##
# Line 34  use Data::Dumper; Line 41  use Data::Dumper;
41  #use Devel::StackTrace;  #use Devel::StackTrace;
42    
43    
44  # get logger instance  my $_dp_globals;
45  my $logger = eval { Log::Dispatch::Config->instance; };  
46    $_dp_globals = {
47      TRACE => 0,
48    };
49    
50    
51  sub new {  sub new {
52        
# Line 45  sub new { Line 56  sub new {
56    # use already blessed reference, if passed in - else use the very classname    # use already blessed reference, if passed in - else use the very classname
57    my $class = ref ($classname) || $classname;    my $class = ref ($classname) || $classname;
58        
59    $logger->debug( "$classname->new( ... )" . "\t[via " . __PACKAGE__ . "]" ) if $logger;    #$self->log_basic( "$classname->new( ... )" . "\t[via " . __PACKAGE__ . "]" , 'debug');
60        
61    # the base for our object - a plain perl hash, which ....    # the base for our object - a plain perl hash, which ....
62    my $self = {};    my $self = {};
# Line 60  sub new { Line 71  sub new {
71    # TODO: what about logging in here? inherit from    # TODO: what about logging in here? inherit from
72    # DesignPattern::Object::Logger for this purpose....    # DesignPattern::Object::Logger for this purpose....
73    # ... or would this give us (harmful) circular module dependencies???    # ... or would this give us (harmful) circular module dependencies???
74    #$logger->debug( __PACKAGE__ . "->new( @args )" );      # this is not "common"!    #$self->log_basic( __PACKAGE__ . "->new( @args )", 'debug' );      # this is not "common"!
75    
76            
77    # remember the stacktrace: abstract this out (DesignPattern::Object::Trace) or parametrize!    # remember the stacktrace: abstract this out (DesignPattern::Object::Trace) or parametrize!
# Line 130  sub _abstract_function { Line 141  sub _abstract_function {
141    my $self_classname = ref $self;    my $self_classname = ref $self;
142    my $function_name = shift;    my $function_name = shift;
143    # was:    # was:
144    $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');
145    # is:    # is:
146    #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'.");
147    #exit;    #exit;
# Line 147  sub fromPackage { Line 158  sub fromPackage {
158    
159  #print Dumper($args);  #print Dumper($args);
160    
161    $logger->debug( __PACKAGE__ . "->fromPackage( pkgname $pkgname args @args )" );    $self->log_basic( __PACKAGE__ . "->fromPackage( pkgname $pkgname args @args )", 'debug');
162        
163    # perl-load    # perl-load
164      my $evstring = "use $pkgname;";      my $evstring = "use $pkgname;";
# Line 156  sub fromPackage { Line 167  sub fromPackage {
167    # report errors    # report errors
168      if ($@) {      if ($@) {
169        # build error-messages        # build error-messages
170        my $errmsg_native = __PACKAGE__ . ':' . __LINE__ . " Error in eval \"$evstring\": " .  $@;        my $issuer = __PACKAGE__ . ':' . __LINE__;
171          my $errmsg_native = "Error in eval: " .  $@;
172        #my $classname = $self->{__classname};        #my $classname = $self->{__classname};
173        my $errmsg_critical = '';        my $errmsg_critical = '';
174        if ($errmsg_native =~ m/Can't locate (.+?) in \@INC/) {        if ($errmsg_native =~ m/Can't locate (.+?) in \@INC/) {
175          $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).";
176        } else {        } else {
177          $errmsg_critical = $errmsg_native;          $errmsg_critical = $errmsg_native;
178        }        }
179        # write error to logging-output (console|file|database)        # write error to logging-output (console|file|database)
180        $logger->debug( $errmsg_native );        $self->log_basic( $errmsg_native . " (issuer='$issuer', code='$evstring')", 'debug' );
181        $logger->critical( $errmsg_critical );        $self->log_basic( $errmsg_critical, 'warning' );
182        return;        return;
183      }      }
184        
# Line 180  sub fromPackage { Line 192  sub fromPackage {
192    return $object;    return $object;
193  }  }
194    
195    sub log_basic {
196      my $self = shift;
197      my $message = shift;
198      my $level = shift;
199      
200      #return;
201      $level ||= 'info';
202    
203      if ($_dp_globals->{TRACE} || ($level && $level =~ /warning|error|critical/)) {
204        print $level, ": ", $message, "\n";
205      }
206    
207      # get logger instance
208      if (!$_dp_globals->{logger}) {
209        $_dp_globals->{logger} = eval { Log::Dispatch::Config->instance; };
210      }
211      
212      if ($_dp_globals->{logger}) {
213        $_dp_globals->{logger}->log( level => $level, message => $message);
214      #} else {
215        #print $level, ": ", $message, "\n";
216      }
217      
218    }
219    
220  1;  1;
221    __END__
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.8
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed