/[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.7 by joko, Tue Feb 18 18:34:35 2003 UTC revision 1.9 by joko, Thu Mar 27 15:44:32 2003 UTC
# Line 2  Line 2 
2  ##  $Id$  ##  $Id$
3  ## ---------------------------------------------------------------------------  ## ---------------------------------------------------------------------------
4  ##  $Log$  ##  $Log$
5    ##  Revision 1.9  2003/03/27 15:44:32  joko
6    ##  fixes/enhancements to 'sub log_basic'
7    ##
8    ##  Revision 1.8  2003/02/19 00:36:59  joko
9    ##  + bugfix: this {logger} is the instance itself, so has to be fed with ( level => xyz and namespace => xyz )
10    ##  + minor modifications in behaviour
11    ##
12  ##  Revision 1.7  2003/02/18 18:34:35  joko  ##  Revision 1.7  2003/02/18 18:34:35  joko
13  ##  + fix: just logs if possible (sub log_basic)  ##  + fix: just logs if possible (sub log_basic)
14  ##  ##
# Line 163  sub fromPackage { Line 170  sub fromPackage {
170    # report errors    # report errors
171      if ($@) {      if ($@) {
172        # build error-messages        # build error-messages
173        my $errmsg_native = __PACKAGE__ . ':' . __LINE__ . " Error in eval \"$evstring\": " .  $@;        my $issuer = __PACKAGE__ . ':' . __LINE__;
174          my $errmsg_native = "Error in eval: " .  $@;
175        #my $classname = $self->{__classname};        #my $classname = $self->{__classname};
176        my $errmsg_critical = '';        my $errmsg_critical = '';
177        if ($errmsg_native =~ m/Can't locate (.+?) in \@INC/) {        if ($errmsg_native =~ m/Can't locate (.+?) in \@INC/) {
# Line 172  sub fromPackage { Line 180  sub fromPackage {
180          $errmsg_critical = $errmsg_native;          $errmsg_critical = $errmsg_native;
181        }        }
182        # write error to logging-output (console|file|database)        # write error to logging-output (console|file|database)
183        $self->log_basic( $errmsg_native, 'debug' );        $self->log_basic( $errmsg_native . " (issuer='$issuer', code='$evstring')", 'debug' );
184        $self->log_basic( $errmsg_critical, 'warning' );        $self->log_basic( $errmsg_critical, 'warning' );
185        return;        return;
186      }      }
# Line 180  sub fromPackage { Line 188  sub fromPackage {
188    # object-creation    # object-creation
189      my $object = $pkgname->new(@args);      my $object = $pkgname->new(@args);
190    
191      # trace
192        #print Dumper($object);
193    
194    # run boot-methods on object    # run boot-methods on object
195      $object->_init() if $object->can('_init');      $object->_init() if $object->can('_init');
196      $object->constructor() if $object->can('constructor');      $object->constructor() if $object->can('constructor');
# Line 191  sub log_basic { Line 202  sub log_basic {
202    my $self = shift;    my $self = shift;
203    my $message = shift;    my $message = shift;
204    my $level = shift;    my $level = shift;
205      
206      #return;
207      $level ||= 'info';
208    
209      my $notSoGood = ($level =~ /warning|error|critical/);
210      
211      # STDERR?
212      if ($level && $notSoGood) {
213        print STDERR $level, ": ", $message, "\n";
214      }
215    
216    if ($_dp_globals->{TRACE} || ($level && $level =~ /warning|error|critical/)) {    # STDOUT?
217      if ($_dp_globals->{TRACE} || $notSoGood) {
218      print $level, ": ", $message, "\n";      print $level, ": ", $message, "\n";
219    }    }
220    
# Line 202  sub log_basic { Line 224  sub log_basic {
224    }    }
225        
226    if ($_dp_globals->{logger}) {    if ($_dp_globals->{logger}) {
227      $_dp_globals->{logger}->log($level, $message);      $_dp_globals->{logger}->log( level => $level, message => $message);
228    #} else {    #} else {
229      #print $level, ": ", $message, "\n";      #print $level, ": ", $message, "\n";
230    }    }
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.9
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed