/[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.3 by joko, Mon Dec 16 19:57:12 2002 UTC
# Line 2  Line 2 
2  ##  $Id$  ##  $Id$
3  ## --------------------------------------------------------------------------------  ## --------------------------------------------------------------------------------
4  ##  $Log$  ##  $Log$
5    ##  Revision 1.3  2002/12/16 19:57:12  joko
6    ##  + sub unload
7    ##
8    ##  Revision 1.2  2002/12/15 02:06:15  joko
9    ##  + feature to be able to specify module in non-perl-style when loading plugins: e.g. $process->load('Setup/Storage')
10    ##
11  ##  Revision 1.1  2002/12/13 21:46:29  joko  ##  Revision 1.1  2002/12/13 21:46:29  joko
12  ##  + initial check-in  ##  + initial check-in
13  ##  ##
# Line 15  use warnings; Line 21  use warnings;
21    
22  use base qw( DesignPattern::Object );  use base qw( DesignPattern::Object );
23    
24    use Data::Dumper;
25    
26  ## ========   object inheritance   ========  ## ========   object inheritance   ========
27    
28  # TODO:  # TODO:
# Line 31  use base qw( DesignPattern::Object ); Line 39  use base qw( DesignPattern::Object );
39  # get logger instance  # get logger instance
40  my $logger = Log::Dispatch::Config->instance;  my $logger = Log::Dispatch::Config->instance;
41        
42    my $meta;
43    
44  ## ========   object constructor   ========  ## ========   object constructor   ========
45    sub new {    sub new {
# Line 72  my $logger = Log::Dispatch::Config->inst Line 81  my $logger = Log::Dispatch::Config->inst
81  ##    }  ##    }
82            
83    }    }
     
   sub load {  
84    
85      sub _getPluginPackage {
86      my $self = shift;      my $self = shift;
87        my $modulename_load = shift;
88    
89        # substitute slashes through double double-colons to load modules perl-style
90        $modulename_load =~ s/\//::/g;
91        
92        # build full package name
93      my $self_classname = ref $self;      my $self_classname = ref $self;
94        my $package = $self_classname . '::' . $modulename_load;
95        return $package;
96      }
97      
98      sub load {
99    
100        my $self = shift;
101      my $modulename_load = shift;      my $modulename_load = shift;
102    
103        my $package = $self->_getPluginPackage($modulename_load);
104        
105        if ($meta->{loaded}->{$package}) {
106          return 1;
107        }
108            
     my $package = $self_classname . '::' . $modulename_load;  
109      $logger->info( __PACKAGE__ . "->load: $package" );      $logger->info( __PACKAGE__ . "->load: $package" );
110    
111      # 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
112      eval("use $package;");      eval("use $package;");
113      if ($@) {      if ($@) {
114        $logger->error( __PACKAGE__ . "->load: $@" );        $meta->{loaded}->{$package} = 0;
115          # include caller information
116          my @caller = caller;
117          my $caller_msg = $caller[1] . ':' . $caller[2];
118          $logger->error( __PACKAGE__ . "->load: $@ ($caller_msg)" );
119      }      }
120    
121  #print "ref-1: ", ref $self, "\n";  #print "ref-1: ", ref $self, "\n";
# Line 97  my $logger = Log::Dispatch::Config->inst Line 126  my $logger = Log::Dispatch::Config->inst
126    
127      # V2:      # V2:
128      # switch into foreign package and mixin plugin-module      # switch into foreign package and mixin plugin-module
129        my $self_classname = ref $self;
130      eval("package $self_classname; use mixin '$package';");      eval("package $self_classname; use mixin '$package';");
131      #eval("use mixin_all '$package';");      #eval("use mixin_all '$package';");
132      if ($@) {      if ($@) {
133          $meta->{loaded}->{$package} = 0;
134        $logger->error( __PACKAGE__ . "->load: $@" );        $logger->error( __PACKAGE__ . "->load: $@" );
135        } else {
136          $meta->{loaded}->{$package} = 1;
137      }      }
138    
139        return 1;
140        
141      }
142    
143      sub unload {
144    
145        my $self = shift;
146        my $modulename_unload = shift;
147    
148        my $package = $self->_getPluginPackage($modulename_unload);
149            
150        if ($meta->{loaded}->{$package}) {
151          $meta->{loaded}->{$package} = 0;
152          my $where = __PACKAGE__ . ':' . __LINE__;
153          $logger->debug( __PACKAGE__ . "->unload: FIXME: DESTROY object is not implemented at '$where'." );
154        }
155    
156    }    }
157    
158    
159    sub boot {    sub boot {
160      my $self = shift;      my $self = shift;
161      $self->_abstract_function('boot');      $self->_abstract_function('boot');
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.3
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed