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

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

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

revision 1.3 by joko, Mon Dec 16 19:57:12 2002 UTC revision 1.6 by joko, Sun Feb 9 16:22:51 2003 UTC
# Line 2  Line 2 
2  ##  $Id$  ##  $Id$
3  ## --------------------------------------------------------------------------------  ## --------------------------------------------------------------------------------
4  ##  $Log$  ##  $Log$
5    ##  Revision 1.6  2003/02/09 16:22:51  joko
6    ##  + pseudo constructor mechanism via options
7    ##
8    ##  Revision 1.5  2003/01/31 01:19:50  root
9    ##  + fixed: doesn't need Log::Dispatch any more, but uses it if available
10    ##
11    ##  Revision 1.4  2003/01/20 16:55:15  joko
12    ##  + sub mixinPackage
13    ##  + sub include
14    ##
15  ##  Revision 1.3  2002/12/16 19:57:12  joko  ##  Revision 1.3  2002/12/16 19:57:12  joko
16  ##  + sub unload  ##  + sub unload
17  ##  ##
# Line 37  use Data::Dumper; Line 47  use Data::Dumper;
47  #   - sub run  #   - sub run
48    
49  # get logger instance  # get logger instance
50  my $logger = Log::Dispatch::Config->instance;  my $logger = eval { Log::Dispatch::Config->instance; };
51        
52  my $meta;  my $meta;
53    
# Line 47  my $meta; Line 57  my $meta;
57      my $class = ref($invocant) || $invocant;      my $class = ref($invocant) || $invocant;
58      my @args = ();      my @args = ();
59      @_ && (@args = @_);      @_ && (@args = @_);
60      $logger->debug( __PACKAGE__ . "->new(@args)" );      $logger->debug( __PACKAGE__ . "->new(@args)" ) if $logger;
61      my $self = { @_ };      my $self = { @_ };
62      #print "class: $class", "\n";      #print "class: $class", "\n";
63      bless $self, $class;      bless $self, $class;
# Line 70  my $meta; Line 80  my $meta;
80      my $method = $AUTOLOAD;      my $method = $AUTOLOAD;
81      $method =~ s/^.*:://;      $method =~ s/^.*:://;
82        
83      $logger->debug( __PACKAGE__ . "->" . $method . "(@_)" . " (AUTOLOAD called, not dispatched)" );      $logger->debug( __PACKAGE__ . "->" . $method . "(@_)" . " (AUTOLOAD called, not dispatched)" ) if $logger;
84    
85      ## ->DESTROY would - if not declared - trigger an AUTOLOAD also      ## ->DESTROY would - if not declared - trigger an AUTOLOAD also
86      return if $method =~ m/::DESTROY$/;      return if $method =~ m/::DESTROY$/;
# Line 100  my $meta; Line 110  my $meta;
110      my $self = shift;      my $self = shift;
111      my $modulename_load = shift;      my $modulename_load = shift;
112    
113        my $options = shift;
114    
115        my $self_modulename = ref $self;
116      my $package = $self->_getPluginPackage($modulename_load);      my $package = $self->_getPluginPackage($modulename_load);
117            
118      if ($meta->{loaded}->{$package}) {      if ($meta->{loaded}->{$package}) {
119        return 1;        return 1;
120      }      }
121            
122      $logger->info( __PACKAGE__ . "->load: $package" );      #$logger->info( __PACKAGE__ . "->load: $package" ) if $logger;
123        #$logger->info( __PACKAGE__ . "->load: $self_modulename" ) if $logger;
124        $logger->debug( $self_modulename . "->load: $package\t[via " . __PACKAGE__ . "]" ) if $logger;
125    
126      # this is the module testing phase - use mixin doesn't seem to propagate errors by default      # this is the module testing phase - use mixin doesn't seem to propagate errors by default
127      eval("use $package;");      eval("use $package;");
# Line 115  my $meta; Line 130  my $meta;
130        # include caller information        # include caller information
131        my @caller = caller;        my @caller = caller;
132        my $caller_msg = $caller[1] . ':' . $caller[2];        my $caller_msg = $caller[1] . ':' . $caller[2];
133        $logger->error( __PACKAGE__ . "->load: $@ ($caller_msg)" );        my $msg =  __PACKAGE__ . "->load: $@ ($caller_msg)";
134          if ($logger) {
135            $logger->error($msg);
136          } else {
137            print $msg, "\n";
138          }
139      }      }
140    
141  #print "ref-1: ", ref $self, "\n";  #print "ref-1: ", ref $self, "\n";
# Line 126  my $meta; Line 146  my $meta;
146    
147      # V2:      # V2:
148      # switch into foreign package and mixin plugin-module      # switch into foreign package and mixin plugin-module
149        $self->mixinPackage($package);
150    
151        if (my $method = $options->{method}) {
152          $self->$method();
153        }
154    
155        return 1;
156        
157      }
158    
159      # TODO: maybe refactor to DesignPattern::Object? what about the '$logger'?
160      sub mixinPackage {
161        my $self = shift;
162        my $package = shift;
163        # switch into foreign package and mixin plugin-module
164      my $self_classname = ref $self;      my $self_classname = ref $self;
165      eval("package $self_classname; use mixin '$package';");      eval("package $self_classname; use mixin '$package';");
166      #eval("use mixin_all '$package';");      #eval("use mixin_all '$package';");
167      if ($@) {      if ($@) {
168        $meta->{loaded}->{$package} = 0;        $meta->{loaded}->{$package} = 0;
169        $logger->error( __PACKAGE__ . "->load: $@" );        $logger->error( __PACKAGE__ . "->load: $@" ) if $logger;
170      } else {      } else {
171        $meta->{loaded}->{$package} = 1;        $meta->{loaded}->{$package} = 1;
172      }      }
   
     return 1;  
       
173    }    }
174    
175    sub unload {    sub unload {
# Line 150  my $meta; Line 182  my $meta;
182      if ($meta->{loaded}->{$package}) {      if ($meta->{loaded}->{$package}) {
183        $meta->{loaded}->{$package} = 0;        $meta->{loaded}->{$package} = 0;
184        my $where = __PACKAGE__ . ':' . __LINE__;        my $where = __PACKAGE__ . ':' . __LINE__;
185        $logger->debug( __PACKAGE__ . "->unload: FIXME: DESTROY object is not implemented at '$where'." );        $logger->debug( __PACKAGE__ . "->unload: FIXME: DESTROY object is not implemented at '$where'." ) if $logger;
186      }      }
187    
188    }    }
# Line 160  my $meta; Line 192  my $meta;
192      my $self = shift;      my $self = shift;
193      $self->_abstract_function('boot');      $self->_abstract_function('boot');
194    }    }
195      
196      sub include {
197        my $self = shift;
198        my $includefile = shift;
199        my $package = shift;
200        # TODO: do better error-detection here / prevent dies under all circumstances!
201        require $includefile;
202        $self->mixinPackage($package) if $package;
203      }
204    
205  1;  1;
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