/[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.1 by joko, Fri Dec 13 21:46:29 2002 UTC revision 1.8 by joko, Fri Feb 14 14:20:05 2003 UTC
# Line 2  Line 2 
2  ##  $Id$  ##  $Id$
3  ## --------------------------------------------------------------------------------  ## --------------------------------------------------------------------------------
4  ##  $Log$  ##  $Log$
5    ##  Revision 1.8  2003/02/14 14:20:05  joko
6    ##  + modified mixin behaviour
7    ##
8    ##  Revision 1.7  2003/02/11 10:34:19  joko
9    ##  + loaded module may now lack 'mixin::with' declaration
10    ##  + this gets us the possibility to load modules from any perl namespace
11    ##     + enabled this mechanism
12    ##
13    ##  Revision 1.6  2003/02/09 16:22:51  joko
14    ##  + pseudo constructor mechanism via options
15    ##
16    ##  Revision 1.5  2003/01/31 01:19:50  root
17    ##  + fixed: doesn't need Log::Dispatch any more, but uses it if available
18    ##
19    ##  Revision 1.4  2003/01/20 16:55:15  joko
20    ##  + sub mixinPackage
21    ##  + sub include
22    ##
23    ##  Revision 1.3  2002/12/16 19:57:12  joko
24    ##  + sub unload
25    ##
26    ##  Revision 1.2  2002/12/15 02:06:15  joko
27    ##  + feature to be able to specify module in non-perl-style when loading plugins: e.g. $process->load('Setup/Storage')
28    ##
29  ##  Revision 1.1  2002/12/13 21:46:29  joko  ##  Revision 1.1  2002/12/13 21:46:29  joko
30  ##  + initial check-in  ##  + initial check-in
31  ##  ##
# Line 15  use warnings; Line 39  use warnings;
39    
40  use base qw( DesignPattern::Object );  use base qw( DesignPattern::Object );
41    
42    use Data::Dumper;
43    
44  ## ========   object inheritance   ========  ## ========   object inheritance   ========
45    
46  # TODO:  # TODO / REFACTORING PROPOSAL
47    # leading from Data::Storage to code abstracted out into this module - DesignPattern::Bridge
48  #   - this is no inheritance and it doesn't have to be  #   - this is no inheritance and it doesn't have to be
49  #   - implement this module as a bridge to its sub-modules  #   - implement this module as a bridge to its sub-modules
50  #   - use the BridgePattern (http://c2.com/cgi/wiki?BridgePattern)  #   - use the BridgePattern (http://c2.com/cgi/wiki?BridgePattern)
# Line 28  use base qw( DesignPattern::Object ); Line 55  use base qw( DesignPattern::Object );
55  #   - sub getChildNodes  #   - sub getChildNodes
56  #   - sub run  #   - sub run
57    
58    # 2003-02-11, joko: does this have anything in parallel with CPAN's Class::Inner?
59    
60    
61  # get logger instance  # get logger instance
62  my $logger = Log::Dispatch::Config->instance;  my $logger = eval { Log::Dispatch::Config->instance; };
63        
64    my $meta;
65    
66  ## ========   object constructor   ========  ## ========   object constructor   ========
67    sub new {  sub new {
68      my $invocant = shift;    my $invocant = shift;
69      my $class = ref($invocant) || $invocant;    my $class = ref($invocant) || $invocant;
70      my @args = ();    my @args = ();
71      @_ && (@args = @_);    @_ && (@args = @_);
72      $logger->debug( __PACKAGE__ . "->new(@args)" );    $logger->debug( __PACKAGE__ . "->new(@args)" ) if $logger;
73      my $self = { @_ };    my $self = { @_ };
74    
75      # trace
76      #print "class: $class", "\n";      #print "class: $class", "\n";
77      bless $self, $class;  
78      ##if (my $bizWorks = shift) {    # create instance
79        ##$self->boot($bizWorks);    bless $self, $class;
80      ##}    
81          return $self;
82      return $self;  }
   }  
83    
84    
85  ## ========   method overrider   ========  ## ========   method overrider   ========
# Line 61  my $logger = Log::Dispatch::Config->inst Line 93  my $logger = Log::Dispatch::Config->inst
93      my $method = $AUTOLOAD;      my $method = $AUTOLOAD;
94      $method =~ s/^.*:://;      $method =~ s/^.*:://;
95        
96      $logger->debug( __PACKAGE__ . "->" . $method . "(@_)" . " (AUTOLOAD called, not dispatched)" );      $logger->debug( __PACKAGE__ . "->" . $method . "(@_)" . " (AUTOLOAD called, not dispatched)" ) if $logger;
97    
98      ## ->DESTROY would - if not declared - trigger an AUTOLOAD also      ## ->DESTROY would - if not declared - trigger an AUTOLOAD also
99      return if $method =~ m/::DESTROY$/;      return if $method =~ m/::DESTROY$/;
# Line 72  my $logger = Log::Dispatch::Config->inst Line 104  my $logger = Log::Dispatch::Config->inst
104  ##    }  ##    }
105            
106    }    }
     
   sub load {  
107    
108      sub _getPluginPackage {
109      my $self = shift;      my $self = shift;
110        my $modulename_load = shift;
111    
112        # substitute slashes through double double-colons to load modules perl-style
113        $modulename_load =~ s/\//::/g;
114        
115        # build full package name
116      my $self_classname = ref $self;      my $self_classname = ref $self;
117          # name
118          my $package = $modulename_load;
119          
120          # if package is absolute, cut away prefix ('/' or '::')
121          if ($package !~ s/^:://) {
122            # else: prefix with base classname if above name is relative (lacks of '/' or '::')
123            $package = $self_classname . '::' . $package
124          }
125        
126        return $package;
127      }
128      
129      sub load {
130    
131        my $self = shift;
132      my $modulename_load = shift;      my $modulename_load = shift;
133    
134        my $options = shift;
135    
136        my $self_modulename = ref $self;
137        my $package = $self->_getPluginPackage($modulename_load);
138        
139        if ($meta->{loaded}->{$package}) {
140          return 1;
141        }
142            
143      my $package = $self_classname . '::' . $modulename_load;      #$logger->info( __PACKAGE__ . "->load: $package" ) if $logger;
144      $logger->info( __PACKAGE__ . "->load: $package" );      #$logger->info( __PACKAGE__ . "->load: $self_modulename" ) if $logger;
145        $logger->debug( $self_modulename . "->load: $package\t[via " . __PACKAGE__ . "]" ) if $logger;
146    
147      # 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
148      eval("use $package;");      eval("use $package;");
149      if ($@) {      if ($@) {
150        $logger->error( __PACKAGE__ . "->load: $@" );        $meta->{loaded}->{$package} = 0;
151          # include caller information
152          my @caller = caller;
153          my $caller_msg = $caller[1] . ':' . $caller[2];
154          my $msg =  __PACKAGE__ . "->load: $@ ($caller_msg)";
155          if ($logger) {
156            $logger->error($msg);
157          } else {
158            print $msg, "\n";
159          }
160      }      }
161    
162  #print "ref-1: ", ref $self, "\n";  #print "ref-1: ", ref $self, "\n";
# Line 96  my $logger = Log::Dispatch::Config->inst Line 166  my $logger = Log::Dispatch::Config->inst
166      #bless $self, $package;      #bless $self, $package;
167    
168      # V2:      # V2:
169        $self->mixinPackage($package);
170        
171        if (my $method = $options->{method}) {
172          $self->$method();
173        }
174    
175        return 1;
176        
177      }
178      
179      sub mixinPackage {
180        my $self = shift;
181        my $package = shift;
182        
183        # switch into foreign package and prepare for mixin
184        $self->mixin_prepare($package);
185    
186        # switch into local package (scope which uses DesignPattern::Bridge) and mixin plugin-module
187        $self->mixin_do($package);
188    
189      }
190    
191      # TODO: maybe refactor to DesignPattern::Object? what about the '$logger'?
192      sub mixin_prepare {
193        my $self = shift;
194        my $package = shift;
195        my $self_classname = ref $self;
196        eval("package $package; use mixin::with '$self_classname';");
197    
198        # FIXME: --- this is redundant ---
199        if ($@) {
200          $meta->{loaded}->{$package} = 0;
201          $logger->error( __PACKAGE__ . "->load: $@" ) if $logger;
202        } else {
203          $meta->{loaded}->{$package} = 1;
204        }
205        # FIXME: --- this is redundant ---
206    
207      }
208    
209      sub mixin_do {
210        my $self = shift;
211        my $package = shift;
212      # switch into foreign package and mixin plugin-module      # switch into foreign package and mixin plugin-module
213        my $self_classname = ref $self;
214      eval("package $self_classname; use mixin '$package';");      eval("package $self_classname; use mixin '$package';");
215      #eval("use mixin_all '$package';");      #eval("use mixin_all '$package';");
216    
217        # FIXME: --- this is redundant ---
218      if ($@) {      if ($@) {
219        $logger->error( __PACKAGE__ . "->load: $@" );        $meta->{loaded}->{$package} = 0;
220          $logger->error( __PACKAGE__ . "->load: $@" ) if $logger;
221        } else {
222          $meta->{loaded}->{$package} = 1;
223      }      }
224        # FIXME: --- this is redundant ---
225    
226      }
227    
228      sub unload {
229    
230        my $self = shift;
231        my $modulename_unload = shift;
232    
233        my $package = $self->_getPluginPackage($modulename_unload);
234            
235        if ($meta->{loaded}->{$package}) {
236          $meta->{loaded}->{$package} = 0;
237          my $where = __PACKAGE__ . ':' . __LINE__;
238          $logger->debug( __PACKAGE__ . "->unload: FIXME: DESTROY object is not implemented at '$where'." ) if $logger;
239        }
240    
241    }    }
242    
243    
244    sub boot {    sub boot {
245      my $self = shift;      my $self = shift;
246      $self->_abstract_function('boot');      $self->_abstract_function('boot');
247    }    }
248      
249      sub include {
250        my $self = shift;
251        my $includefile = shift;
252        my $package = shift;
253        # TODO: do better error-detection here / prevent dies under all circumstances!
254        require $includefile;
255        $self->mixinPackage($package) if $package;
256      }
257    
258  1;  1;
259    __END__
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.8
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed