/[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.5 by root, Fri Jan 31 01:19:50 2003 UTC revision 1.10 by joko, Thu Feb 20 20:50:32 2003 UTC
# Line 2  Line 2 
2  ##  $Id$  ##  $Id$
3  ## --------------------------------------------------------------------------------  ## --------------------------------------------------------------------------------
4  ##  $Log$  ##  $Log$
5    ##  Revision 1.10  2003/02/20 20:50:32  joko
6    ##  + small exception handling: now inheriting from little Exception object
7    ##
8    ##  Revision 1.9  2003/02/18 18:35:30  joko
9    ##  + encapsulated/abstracted some more functionality: sub load_single
10    ##
11    ##  Revision 1.8  2003/02/14 14:20:05  joko
12    ##  + modified mixin behaviour
13    ##
14    ##  Revision 1.7  2003/02/11 10:34:19  joko
15    ##  + loaded module may now lack 'mixin::with' declaration
16    ##  + this gets us the possibility to load modules from any perl namespace
17    ##     + enabled this mechanism
18    ##
19    ##  Revision 1.6  2003/02/09 16:22:51  joko
20    ##  + pseudo constructor mechanism via options
21    ##
22  ##  Revision 1.5  2003/01/31 01:19:50  root  ##  Revision 1.5  2003/01/31 01:19:50  root
23  ##  + fixed: doesn't need Log::Dispatch any more, but uses it if available  ##  + fixed: doesn't need Log::Dispatch any more, but uses it if available
24  ##  ##
# Line 26  package DesignPattern::Bridge; Line 43  package DesignPattern::Bridge;
43  use strict;  use strict;
44  use warnings;  use warnings;
45    
46  use base qw( DesignPattern::Object );  use base qw(
47      DesignPattern::Object
48      DesignPattern::Exception
49    );
50    
51  use Data::Dumper;  use Data::Dumper;
52    
53  ## ========   object inheritance   ========  ## ========   object inheritance   ========
54    
55  # TODO:  # TODO / REFACTORING PROPOSAL
56    # leading from Data::Storage to code abstracted out into this module - DesignPattern::Bridge
57  #   - this is no inheritance and it doesn't have to be  #   - this is no inheritance and it doesn't have to be
58  #   - implement this module as a bridge to its sub-modules  #   - implement this module as a bridge to its sub-modules
59  #   - use the BridgePattern (http://c2.com/cgi/wiki?BridgePattern)  #   - use the BridgePattern (http://c2.com/cgi/wiki?BridgePattern)
# Line 43  use Data::Dumper; Line 64  use Data::Dumper;
64  #   - sub getChildNodes  #   - sub getChildNodes
65  #   - sub run  #   - sub run
66    
67    # 2003-02-11, joko: does this have anything in parallel with CPAN's Class::Inner?
68    
69    
70  # get logger instance  # get logger instance
71  my $logger = eval { Log::Dispatch::Config->instance; };  my $logger = eval { Log::Dispatch::Config->instance; };
72        
73  my $meta;  my $meta;
74    
75  ## ========   object constructor   ========  ## ========   object constructor   ========
76    sub new {  sub new {
77      my $invocant = shift;    my $invocant = shift;
78      my $class = ref($invocant) || $invocant;    my $class = ref($invocant) || $invocant;
79      my @args = ();    my @args = ();
80      @_ && (@args = @_);    @_ && (@args = @_);
81      $logger->debug( __PACKAGE__ . "->new(@args)" ) if $logger;    $logger->debug( __PACKAGE__ . "->new(@args)" ) if $logger;
82      my $self = { @_ };    my $self = { @_ };
83    
84      # trace
85      #print "class: $class", "\n";      #print "class: $class", "\n";
86      bless $self, $class;  
87      ##if (my $bizWorks = shift) {    # create instance
88        ##$self->boot($bizWorks);    bless $self, $class;
89      ##}    
90          return $self;
91      return $self;  }
   }  
92    
93    
94  ## ========   method overrider   ========  ## ========   method overrider   ========
# Line 98  my $meta; Line 123  my $meta;
123            
124      # build full package name      # build full package name
125      my $self_classname = ref $self;      my $self_classname = ref $self;
126      my $package = $self_classname . '::' . $modulename_load;        # name
127          my $package = $modulename_load;
128          
129          # if package is absolute, cut away prefix ('/' or '::')
130          if ($package !~ s/^:://) {
131            # else: prefix with base classname if above name is relative (lacks of '/' or '::')
132            $package = $self_classname . '::' . $package
133          }
134        
135      return $package;      return $package;
136    }    }
137        
138    sub load {    sub load {
139    
140      my $self = shift;      my $self = shift;
141        my $modulename = shift;
142        my $options = shift;
143    
144        if (ref $modulename eq 'ARRAY') {
145          foreach (@$modulename) {
146            $self->load_single($_, $options);
147          }
148        } else {
149          $self->load_single($modulename, $options);
150        }
151    
152      }
153    
154      sub load_single {
155    
156        my $self = shift;
157      my $modulename_load = shift;      my $modulename_load = shift;
158    
159        my $options = shift;
160    
161      my $self_modulename = ref $self;      my $self_modulename = ref $self;
162      my $package = $self->_getPluginPackage($modulename_load);      my $package = $self->_getPluginPackage($modulename_load);
163            
# Line 120  my $meta; Line 171  my $meta;
171    
172      # 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
173      eval("use $package;");      eval("use $package;");
174        $self->checkExceptions();
175        
176    =pod    
177      if ($@) {      if ($@) {
178        $meta->{loaded}->{$package} = 0;        $meta->{loaded}->{$package} = 0;
179        # include caller information        # include caller information
# Line 132  my $meta; Line 186  my $meta;
186          print $msg, "\n";          print $msg, "\n";
187        }        }
188      }      }
189    =cut
190    
191  #print "ref-1: ", ref $self, "\n";  #print "ref-1: ", ref $self, "\n";
192  #print "ref-2: ", ref $self::SUPER, "\n";  #print "ref-2: ", ref $self::SUPER, "\n";
# Line 140  my $meta; Line 195  my $meta;
195      #bless $self, $package;      #bless $self, $package;
196    
197      # V2:      # V2:
     # switch into foreign package and mixin plugin-module  
198      $self->mixinPackage($package);      $self->mixinPackage($package);
199        
200        if (my $method = $options->{method}) {
201          $self->$method();
202        }
203    
204      return 1;      return 1;
205            
206    }    }
207      
208      sub mixinPackage {
209        my $self = shift;
210        my $package = shift;
211        
212        # switch into foreign package and prepare for mixin
213        $self->mixin_prepare($package);
214    
215        # switch into local package (scope which uses DesignPattern::Bridge) and mixin plugin-module
216        $self->mixin_do($package);
217    
218      }
219    
220    # TODO: maybe refactor to DesignPattern::Object? what about the '$logger'?    # TODO: maybe refactor to DesignPattern::Object? what about the '$logger'?
221    sub mixinPackage {    sub mixin_prepare {
222        my $self = shift;
223        my $package = shift;
224        my $self_classname = ref $self;
225        eval("package $package; use mixin::with '$self_classname';");
226    
227        # FIXME: --- this is redundant ---
228        if ($@) {
229          $meta->{loaded}->{$package} = 0;
230          $logger->error( __PACKAGE__ . "->load: $@" ) if $logger;
231        } else {
232          $meta->{loaded}->{$package} = 1;
233        }
234        # FIXME: --- this is redundant ---
235    
236      }
237    
238      sub mixin_do {
239      my $self = shift;      my $self = shift;
240      my $package = shift;      my $package = shift;
241      # switch into foreign package and mixin plugin-module      # switch into foreign package and mixin plugin-module
242      my $self_classname = ref $self;      my $self_classname = ref $self;
243      eval("package $self_classname; use mixin '$package';");      eval("package $self_classname; use mixin '$package';");
244      #eval("use mixin_all '$package';");      #eval("use mixin_all '$package';");
245    
246        # FIXME: --- this is redundant ---
247      if ($@) {      if ($@) {
248        $meta->{loaded}->{$package} = 0;        $meta->{loaded}->{$package} = 0;
249        $logger->error( __PACKAGE__ . "->load: $@" ) if $logger;        $logger->error( __PACKAGE__ . "->load: $@" ) if $logger;
250      } else {      } else {
251        $meta->{loaded}->{$package} = 1;        $meta->{loaded}->{$package} = 1;
252      }      }
253        # FIXME: --- this is redundant ---
254    
255    }    }
256    
257    sub unload {    sub unload {
# Line 194  my $meta; Line 285  my $meta;
285    }    }
286    
287  1;  1;
288    __END__
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.10
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed