/[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.2 by joko, Sun Dec 15 02:06:15 2002 UTC revision 1.4 by joko, Mon Jan 20 16:55:15 2003 UTC
# Line 2  Line 2 
2  ##  $Id$  ##  $Id$
3  ## --------------------------------------------------------------------------------  ## --------------------------------------------------------------------------------
4  ##  $Log$  ##  $Log$
5    ##  Revision 1.4  2003/01/20 16:55:15  joko
6    ##  + sub mixinPackage
7    ##  + sub include
8    ##
9    ##  Revision 1.3  2002/12/16 19:57:12  joko
10    ##  + sub unload
11    ##
12  ##  Revision 1.2  2002/12/15 02:06:15  joko  ##  Revision 1.2  2002/12/15 02:06:15  joko
13  ##  + feature to be able to specify module in non-perl-style when loading plugins: e.g. $process->load('Setup/Storage')  ##  + feature to be able to specify module in non-perl-style when loading plugins: e.g. $process->load('Setup/Storage')
14  ##  ##
# Line 36  use Data::Dumper; Line 43  use Data::Dumper;
43  # get logger instance  # get logger instance
44  my $logger = Log::Dispatch::Config->instance;  my $logger = Log::Dispatch::Config->instance;
45        
46    my $meta;
47    
48  ## ========   object constructor   ========  ## ========   object constructor   ========
49    sub new {    sub new {
# Line 77  my $logger = Log::Dispatch::Config->inst Line 85  my $logger = Log::Dispatch::Config->inst
85  ##    }  ##    }
86            
87    }    }
     
   sub load {  
88    
89      sub _getPluginPackage {
90      my $self = shift;      my $self = shift;
     my $self_classname = ref $self;  
   
91      my $modulename_load = shift;      my $modulename_load = shift;
92        
93      # substitute slashes through double double-colons to load modules perl-style      # substitute slashes through double double-colons to load modules perl-style
94      $modulename_load =~ s/\//::/g;      $modulename_load =~ s/\//::/g;
95            
96        # build full package name
97        my $self_classname = ref $self;
98      my $package = $self_classname . '::' . $modulename_load;      my $package = $self_classname . '::' . $modulename_load;
99      $logger->info( __PACKAGE__ . "->load: $package" );      return $package;
100      }
101      
102      sub load {
103    
104        my $self = shift;
105        my $modulename_load = shift;
106    
107        my $self_modulename = ref $self;
108        my $package = $self->_getPluginPackage($modulename_load);
109        
110        if ($meta->{loaded}->{$package}) {
111          return 1;
112        }
113        
114        #$logger->info( __PACKAGE__ . "->load: $package" );
115        #$logger->info( __PACKAGE__ . "->load: $self_modulename" );
116        $logger->debug( $self_modulename . "->load: $package\t[via " . __PACKAGE__ . "]" );
117    
118      # 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
119      eval("use $package;");      eval("use $package;");
120      if ($@) {      if ($@) {
121          $meta->{loaded}->{$package} = 0;
122        # include caller information        # include caller information
123        my @caller = caller;        my @caller = caller;
124        my $caller_msg = $caller[1] . ':' . $caller[2];        my $caller_msg = $caller[1] . ':' . $caller[2];
# Line 108  my $logger = Log::Dispatch::Config->inst Line 133  my $logger = Log::Dispatch::Config->inst
133    
134      # V2:      # V2:
135      # switch into foreign package and mixin plugin-module      # switch into foreign package and mixin plugin-module
136        $self->mixinPackage($package);
137    
138        return 1;
139        
140      }
141    
142      # TODO: maybe refactor to DesignPattern::Object? what about the '$logger'?
143      sub mixinPackage {
144        my $self = shift;
145        my $package = shift;
146        # switch into foreign package and mixin plugin-module
147        my $self_classname = ref $self;
148      eval("package $self_classname; use mixin '$package';");      eval("package $self_classname; use mixin '$package';");
149      #eval("use mixin_all '$package';");      #eval("use mixin_all '$package';");
150      if ($@) {      if ($@) {
151          $meta->{loaded}->{$package} = 0;
152        $logger->error( __PACKAGE__ . "->load: $@" );        $logger->error( __PACKAGE__ . "->load: $@" );
153        } else {
154          $meta->{loaded}->{$package} = 1;
155      }      }
156      }
157    
158      sub unload {
159    
160        my $self = shift;
161        my $modulename_unload = shift;
162    
163        my $package = $self->_getPluginPackage($modulename_unload);
164            
165        if ($meta->{loaded}->{$package}) {
166          $meta->{loaded}->{$package} = 0;
167          my $where = __PACKAGE__ . ':' . __LINE__;
168          $logger->debug( __PACKAGE__ . "->unload: FIXME: DESTROY object is not implemented at '$where'." );
169        }
170    
171    }    }
172    
173    
174    sub boot {    sub boot {
175      my $self = shift;      my $self = shift;
176      $self->_abstract_function('boot');      $self->_abstract_function('boot');
177    }    }
178      
179      sub include {
180        my $self = shift;
181        my $includefile = shift;
182        my $package = shift;
183        # TODO: do better error-detection here / prevent dies under all circumstances!
184        require $includefile;
185        $self->mixinPackage($package) if $package;
186      }
187    
188  1;  1;
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.4
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed