/[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.4 by joko, Mon Jan 20 16:55:15 2003 UTC revision 1.9 by joko, Tue Feb 18 18:35:30 2003 UTC
# Line 2  Line 2 
2  ##  $Id$  ##  $Id$
3  ## --------------------------------------------------------------------------------  ## --------------------------------------------------------------------------------
4  ##  $Log$  ##  $Log$
5    ##  Revision 1.9  2003/02/18 18:35:30  joko
6    ##  + encapsulated/abstracted some more functionality: sub load_single
7    ##
8    ##  Revision 1.8  2003/02/14 14:20:05  joko
9    ##  + modified mixin behaviour
10    ##
11    ##  Revision 1.7  2003/02/11 10:34:19  joko
12    ##  + loaded module may now lack 'mixin::with' declaration
13    ##  + this gets us the possibility to load modules from any perl namespace
14    ##     + enabled this mechanism
15    ##
16    ##  Revision 1.6  2003/02/09 16:22:51  joko
17    ##  + pseudo constructor mechanism via options
18    ##
19    ##  Revision 1.5  2003/01/31 01:19:50  root
20    ##  + fixed: doesn't need Log::Dispatch any more, but uses it if available
21    ##
22  ##  Revision 1.4  2003/01/20 16:55:15  joko  ##  Revision 1.4  2003/01/20 16:55:15  joko
23  ##  + sub mixinPackage  ##  + sub mixinPackage
24  ##  + sub include  ##  + sub include
# Line 29  use Data::Dumper; Line 46  use Data::Dumper;
46    
47  ## ========   object inheritance   ========  ## ========   object inheritance   ========
48    
49  # TODO:  # TODO / REFACTORING PROPOSAL
50    # leading from Data::Storage to code abstracted out into this module - DesignPattern::Bridge
51  #   - this is no inheritance and it doesn't have to be  #   - this is no inheritance and it doesn't have to be
52  #   - implement this module as a bridge to its sub-modules  #   - implement this module as a bridge to its sub-modules
53  #   - use the BridgePattern (http://c2.com/cgi/wiki?BridgePattern)  #   - use the BridgePattern (http://c2.com/cgi/wiki?BridgePattern)
# Line 40  use Data::Dumper; Line 58  use Data::Dumper;
58  #   - sub getChildNodes  #   - sub getChildNodes
59  #   - sub run  #   - sub run
60    
61    # 2003-02-11, joko: does this have anything in parallel with CPAN's Class::Inner?
62    
63    
64  # get logger instance  # get logger instance
65  my $logger = Log::Dispatch::Config->instance;  my $logger = eval { Log::Dispatch::Config->instance; };
66        
67  my $meta;  my $meta;
68    
69  ## ========   object constructor   ========  ## ========   object constructor   ========
70    sub new {  sub new {
71      my $invocant = shift;    my $invocant = shift;
72      my $class = ref($invocant) || $invocant;    my $class = ref($invocant) || $invocant;
73      my @args = ();    my @args = ();
74      @_ && (@args = @_);    @_ && (@args = @_);
75      $logger->debug( __PACKAGE__ . "->new(@args)" );    $logger->debug( __PACKAGE__ . "->new(@args)" ) if $logger;
76      my $self = { @_ };    my $self = { @_ };
77    
78      # trace
79      #print "class: $class", "\n";      #print "class: $class", "\n";
80      bless $self, $class;  
81      ##if (my $bizWorks = shift) {    # create instance
82        ##$self->boot($bizWorks);    bless $self, $class;
83      ##}    
84          return $self;
85      return $self;  }
   }  
86    
87    
88  ## ========   method overrider   ========  ## ========   method overrider   ========
# Line 74  my $meta; Line 96  my $meta;
96      my $method = $AUTOLOAD;      my $method = $AUTOLOAD;
97      $method =~ s/^.*:://;      $method =~ s/^.*:://;
98        
99      $logger->debug( __PACKAGE__ . "->" . $method . "(@_)" . " (AUTOLOAD called, not dispatched)" );      $logger->debug( __PACKAGE__ . "->" . $method . "(@_)" . " (AUTOLOAD called, not dispatched)" ) if $logger;
100    
101      ## ->DESTROY would - if not declared - trigger an AUTOLOAD also      ## ->DESTROY would - if not declared - trigger an AUTOLOAD also
102      return if $method =~ m/::DESTROY$/;      return if $method =~ m/::DESTROY$/;
# Line 95  my $meta; Line 117  my $meta;
117            
118      # build full package name      # build full package name
119      my $self_classname = ref $self;      my $self_classname = ref $self;
120      my $package = $self_classname . '::' . $modulename_load;        # name
121          my $package = $modulename_load;
122          
123          # if package is absolute, cut away prefix ('/' or '::')
124          if ($package !~ s/^:://) {
125            # else: prefix with base classname if above name is relative (lacks of '/' or '::')
126            $package = $self_classname . '::' . $package
127          }
128        
129      return $package;      return $package;
130    }    }
131        
132    sub load {    sub load {
133    
134      my $self = shift;      my $self = shift;
135        my $modulename = shift;
136        my $options = shift;
137    
138        if (ref $modulename eq 'ARRAY') {
139          foreach (@$modulename) {
140            $self->load_single($_, $options);
141          }
142        } else {
143          $self->load_single($modulename, $options);
144        }
145    
146      }
147    
148      sub load_single {
149    
150        my $self = shift;
151      my $modulename_load = shift;      my $modulename_load = shift;
152    
153        my $options = shift;
154    
155      my $self_modulename = ref $self;      my $self_modulename = ref $self;
156      my $package = $self->_getPluginPackage($modulename_load);      my $package = $self->_getPluginPackage($modulename_load);
157            
# Line 111  my $meta; Line 159  my $meta;
159        return 1;        return 1;
160      }      }
161            
162      #$logger->info( __PACKAGE__ . "->load: $package" );      #$logger->info( __PACKAGE__ . "->load: $package" ) if $logger;
163      #$logger->info( __PACKAGE__ . "->load: $self_modulename" );      #$logger->info( __PACKAGE__ . "->load: $self_modulename" ) if $logger;
164      $logger->debug( $self_modulename . "->load: $package\t[via " . __PACKAGE__ . "]" );      $logger->debug( $self_modulename . "->load: $package\t[via " . __PACKAGE__ . "]" ) if $logger;
165    
166      # 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
167      eval("use $package;");      eval("use $package;");
# Line 122  my $meta; Line 170  my $meta;
170        # include caller information        # include caller information
171        my @caller = caller;        my @caller = caller;
172        my $caller_msg = $caller[1] . ':' . $caller[2];        my $caller_msg = $caller[1] . ':' . $caller[2];
173        $logger->error( __PACKAGE__ . "->load: $@ ($caller_msg)" );        my $msg =  __PACKAGE__ . "->load: $@ ($caller_msg)";
174          if ($logger) {
175            $logger->error($msg);
176          } else {
177            print $msg, "\n";
178          }
179      }      }
180    
181  #print "ref-1: ", ref $self, "\n";  #print "ref-1: ", ref $self, "\n";
# Line 132  my $meta; Line 185  my $meta;
185      #bless $self, $package;      #bless $self, $package;
186    
187      # V2:      # V2:
     # switch into foreign package and mixin plugin-module  
188      $self->mixinPackage($package);      $self->mixinPackage($package);
189        
190        if (my $method = $options->{method}) {
191          $self->$method();
192        }
193    
194      return 1;      return 1;
195            
196    }    }
197      
198      sub mixinPackage {
199        my $self = shift;
200        my $package = shift;
201        
202        # switch into foreign package and prepare for mixin
203        $self->mixin_prepare($package);
204    
205        # switch into local package (scope which uses DesignPattern::Bridge) and mixin plugin-module
206        $self->mixin_do($package);
207    
208      }
209    
210    # TODO: maybe refactor to DesignPattern::Object? what about the '$logger'?    # TODO: maybe refactor to DesignPattern::Object? what about the '$logger'?
211    sub mixinPackage {    sub mixin_prepare {
212        my $self = shift;
213        my $package = shift;
214        my $self_classname = ref $self;
215        eval("package $package; use mixin::with '$self_classname';");
216    
217        # FIXME: --- this is redundant ---
218        if ($@) {
219          $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 mixin_do {
229      my $self = shift;      my $self = shift;
230      my $package = shift;      my $package = shift;
231      # switch into foreign package and mixin plugin-module      # switch into foreign package and mixin plugin-module
232      my $self_classname = ref $self;      my $self_classname = ref $self;
233      eval("package $self_classname; use mixin '$package';");      eval("package $self_classname; use mixin '$package';");
234      #eval("use mixin_all '$package';");      #eval("use mixin_all '$package';");
235    
236        # FIXME: --- this is redundant ---
237      if ($@) {      if ($@) {
238        $meta->{loaded}->{$package} = 0;        $meta->{loaded}->{$package} = 0;
239        $logger->error( __PACKAGE__ . "->load: $@" );        $logger->error( __PACKAGE__ . "->load: $@" ) if $logger;
240      } else {      } else {
241        $meta->{loaded}->{$package} = 1;        $meta->{loaded}->{$package} = 1;
242      }      }
243        # FIXME: --- this is redundant ---
244    
245    }    }
246    
247    sub unload {    sub unload {
# Line 165  my $meta; Line 254  my $meta;
254      if ($meta->{loaded}->{$package}) {      if ($meta->{loaded}->{$package}) {
255        $meta->{loaded}->{$package} = 0;        $meta->{loaded}->{$package} = 0;
256        my $where = __PACKAGE__ . ':' . __LINE__;        my $where = __PACKAGE__ . ':' . __LINE__;
257        $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;
258      }      }
259    
260    }    }
# Line 186  my $meta; Line 275  my $meta;
275    }    }
276    
277  1;  1;
278    __END__
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.9
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed