/[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.3 by joko, Mon Jan 20 16:54:22 2003 UTC revision 1.6 by joko, Tue Feb 11 11:04:27 2003 UTC
# Line 2  Line 2 
2  ##  $Id$  ##  $Id$
3  ## ---------------------------------------------------------------------------  ## ---------------------------------------------------------------------------
4  ##  $Log$  ##  $Log$
5    ##  Revision 1.6  2003/02/11 11:04:27  joko
6    ##  + metadata (args, caller, etc.) are now stored inside {__bridge}
7    ##
8    ##  Revision 1.5  2003/02/09 16:24:46  joko
9    ##  + pseudo constructor mechanism by calling method 'constructor' on object instantiation
10    ##
11    ##  Revision 1.4  2003/01/22 17:56:49  root
12    ##  + fix: just use the logger if it's available
13    ##
14  ##  Revision 1.3  2003/01/20 16:54:22  joko  ##  Revision 1.3  2003/01/20 16:54:22  joko
15  ##  + sub fromPackage: refactored from libp's 'getNewPerlObjFromPkgName' or s.th.l.th.  ##  + sub fromPackage: refactored from libp's 'getNewPerlObjFromPkgName' or s.th.l.th.
16  ##  ##
# Line 26  use Data::Dumper; Line 35  use Data::Dumper;
35    
36    
37  # get logger instance  # get logger instance
38  my $logger = Log::Dispatch::Config->instance;  my $logger = eval { Log::Dispatch::Config->instance; };
39    
40  sub new {  sub new {
41        
# Line 36  sub new { Line 45  sub new {
45    # use already blessed reference, if passed in - else use the very classname    # use already blessed reference, if passed in - else use the very classname
46    my $class = ref ($classname) || $classname;    my $class = ref ($classname) || $classname;
47        
48    $logger->debug( "$classname->new( ... )" . "\t[via " . __PACKAGE__ . "]" );    $logger->debug( "$classname->new( ... )" . "\t[via " . __PACKAGE__ . "]" ) if $logger;
49        
50    # the base for our object - a plain perl hash, which ....    # the base for our object - a plain perl hash, which ....
51    my $self = {};    my $self = {};
# Line 80  sub new { Line 89  sub new {
89    # mixin arguments    # mixin arguments
90    $self = { @args };    $self = { @args };
91        
92    # mixin seperate    # scan for arguments prefixed by a double underscore '__'
93    $self->{'__arg'} = $seperate if $seperate;    foreach (keys %$self) {
94        if (/^__(.+?)$/) {
95          $self->{__bridge}->{$1} = $self->{$_};
96          delete $self->{$_};
97        }
98      }
99      
100      # mixin seperate - FIXME: should this not be done after blessing?
101      $self->{__bridge}->{'arg'} = $seperate if $seperate;
102    
103    # ... bless hash into object using classname    # ... bless hash into object using classname
104    bless $self, $class;    bless $self, $class;
105    
106    # remember the caller    # remember the caller
107      $self->{'__caller'} = caller;      $self->{__bridge}->{caller_module}  = caller;
108      #print Dumper(caller(2));      #print Dumper(caller(2));
109      #exit;      #exit;
110    
111    $self->{__classname} = $classname;    $self->{__bridge}->{class_name} = $classname;
112    
113      # patches for backward compatibility
114        $self->{'__arg'} = $self->{__bridge}->{'arg'} if $self->{__bridge}->{'arg'};
115        $self->{'__caller'} = $self->{__bridge}->{caller_module} if $self->{__bridge}->{caller_module};
116        $self->{'__classname'} = $self->{__bridge}->{class_name} if $self->{__bridge}->{class_name};
117    
118    $self->_init() if $self->can('_init');    $self->_init() if $self->can('_init');
119      $self->constructor() if $self->can('constructor');
120    
121      # trace
122        #print Dumper($self);
123        #exit;
124    
125    return $self;    return $self;
126  }    }  
# Line 148  sub fromPackage { Line 175  sub fromPackage {
175    
176    # run boot-methods on object    # run boot-methods on object
177      $object->_init() if $object->can('_init');      $object->_init() if $object->can('_init');
178        $object->constructor() if $object->can('constructor');
179    
180    return $object;    return $object;
181  }  }
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.6
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed