/[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.5 by root, Fri Jan 31 01:19:50 2003 UTC
# Line 2  Line 2 
2  ##  $Id$  ##  $Id$
3  ## --------------------------------------------------------------------------------  ## --------------------------------------------------------------------------------
4  ##  $Log$  ##  $Log$
5    ##  Revision 1.5  2003/01/31 01:19:50  root
6    ##  + fixed: doesn't need Log::Dispatch any more, but uses it if available
7    ##
8    ##  Revision 1.4  2003/01/20 16:55:15  joko
9    ##  + sub mixinPackage
10    ##  + sub include
11    ##
12    ##  Revision 1.3  2002/12/16 19:57:12  joko
13    ##  + sub unload
14    ##
15    ##  Revision 1.2  2002/12/15 02:06:15  joko
16    ##  + feature to be able to specify module in non-perl-style when loading plugins: e.g. $process->load('Setup/Storage')
17    ##
18  ##  Revision 1.1  2002/12/13 21:46:29  joko  ##  Revision 1.1  2002/12/13 21:46:29  joko
19  ##  + initial check-in  ##  + initial check-in
20  ##  ##
# Line 15  use warnings; Line 28  use warnings;
28    
29  use base qw( DesignPattern::Object );  use base qw( DesignPattern::Object );
30    
31    use Data::Dumper;
32    
33  ## ========   object inheritance   ========  ## ========   object inheritance   ========
34    
35  # TODO:  # TODO:
# Line 29  use base qw( DesignPattern::Object ); Line 44  use base qw( DesignPattern::Object );
44  #   - sub run  #   - sub run
45    
46  # get logger instance  # get logger instance
47  my $logger = Log::Dispatch::Config->instance;  my $logger = eval { Log::Dispatch::Config->instance; };
48        
49    my $meta;
50    
51  ## ========   object constructor   ========  ## ========   object constructor   ========
52    sub new {    sub new {
# Line 38  my $logger = Log::Dispatch::Config->inst Line 54  my $logger = Log::Dispatch::Config->inst
54      my $class = ref($invocant) || $invocant;      my $class = ref($invocant) || $invocant;
55      my @args = ();      my @args = ();
56      @_ && (@args = @_);      @_ && (@args = @_);
57      $logger->debug( __PACKAGE__ . "->new(@args)" );      $logger->debug( __PACKAGE__ . "->new(@args)" ) if $logger;
58      my $self = { @_ };      my $self = { @_ };
59      #print "class: $class", "\n";      #print "class: $class", "\n";
60      bless $self, $class;      bless $self, $class;
# Line 61  my $logger = Log::Dispatch::Config->inst Line 77  my $logger = Log::Dispatch::Config->inst
77      my $method = $AUTOLOAD;      my $method = $AUTOLOAD;
78      $method =~ s/^.*:://;      $method =~ s/^.*:://;
79        
80      $logger->debug( __PACKAGE__ . "->" . $method . "(@_)" . " (AUTOLOAD called, not dispatched)" );      $logger->debug( __PACKAGE__ . "->" . $method . "(@_)" . " (AUTOLOAD called, not dispatched)" ) if $logger;
81    
82      ## ->DESTROY would - if not declared - trigger an AUTOLOAD also      ## ->DESTROY would - if not declared - trigger an AUTOLOAD also
83      return if $method =~ m/::DESTROY$/;      return if $method =~ m/::DESTROY$/;
# Line 72  my $logger = Log::Dispatch::Config->inst Line 88  my $logger = Log::Dispatch::Config->inst
88  ##    }  ##    }
89            
90    }    }
     
   sub load {  
91    
92      sub _getPluginPackage {
93      my $self = shift;      my $self = shift;
94        my $modulename_load = shift;
95    
96        # substitute slashes through double double-colons to load modules perl-style
97        $modulename_load =~ s/\//::/g;
98        
99        # build full package name
100      my $self_classname = ref $self;      my $self_classname = ref $self;
101        my $package = $self_classname . '::' . $modulename_load;
102        return $package;
103      }
104      
105      sub load {
106    
107        my $self = shift;
108      my $modulename_load = shift;      my $modulename_load = shift;
109    
110        my $self_modulename = ref $self;
111        my $package = $self->_getPluginPackage($modulename_load);
112            
113      my $package = $self_classname . '::' . $modulename_load;      if ($meta->{loaded}->{$package}) {
114      $logger->info( __PACKAGE__ . "->load: $package" );        return 1;
115        }
116        
117        #$logger->info( __PACKAGE__ . "->load: $package" ) if $logger;
118        #$logger->info( __PACKAGE__ . "->load: $self_modulename" ) if $logger;
119        $logger->debug( $self_modulename . "->load: $package\t[via " . __PACKAGE__ . "]" ) if $logger;
120    
121      # 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
122      eval("use $package;");      eval("use $package;");
123      if ($@) {      if ($@) {
124        $logger->error( __PACKAGE__ . "->load: $@" );        $meta->{loaded}->{$package} = 0;
125          # include caller information
126          my @caller = caller;
127          my $caller_msg = $caller[1] . ':' . $caller[2];
128          my $msg =  __PACKAGE__ . "->load: $@ ($caller_msg)";
129          if ($logger) {
130            $logger->error($msg);
131          } else {
132            print $msg, "\n";
133          }
134      }      }
135    
136  #print "ref-1: ", ref $self, "\n";  #print "ref-1: ", ref $self, "\n";
# Line 97  my $logger = Log::Dispatch::Config->inst Line 141  my $logger = Log::Dispatch::Config->inst
141    
142      # V2:      # V2:
143      # switch into foreign package and mixin plugin-module      # switch into foreign package and mixin plugin-module
144        $self->mixinPackage($package);
145    
146        return 1;
147        
148      }
149    
150      # TODO: maybe refactor to DesignPattern::Object? what about the '$logger'?
151      sub mixinPackage {
152        my $self = shift;
153        my $package = shift;
154        # switch into foreign package and mixin plugin-module
155        my $self_classname = ref $self;
156      eval("package $self_classname; use mixin '$package';");      eval("package $self_classname; use mixin '$package';");
157      #eval("use mixin_all '$package';");      #eval("use mixin_all '$package';");
158      if ($@) {      if ($@) {
159        $logger->error( __PACKAGE__ . "->load: $@" );        $meta->{loaded}->{$package} = 0;
160          $logger->error( __PACKAGE__ . "->load: $@" ) if $logger;
161        } else {
162          $meta->{loaded}->{$package} = 1;
163      }      }
164      }
165    
166      sub unload {
167    
168        my $self = shift;
169        my $modulename_unload = shift;
170    
171        my $package = $self->_getPluginPackage($modulename_unload);
172            
173        if ($meta->{loaded}->{$package}) {
174          $meta->{loaded}->{$package} = 0;
175          my $where = __PACKAGE__ . ':' . __LINE__;
176          $logger->debug( __PACKAGE__ . "->unload: FIXME: DESTROY object is not implemented at '$where'." ) if $logger;
177        }
178    
179    }    }
180    
181    
182    sub boot {    sub boot {
183      my $self = shift;      my $self = shift;
184      $self->_abstract_function('boot');      $self->_abstract_function('boot');
185    }    }
186      
187      sub include {
188        my $self = shift;
189        my $includefile = shift;
190        my $package = shift;
191        # TODO: do better error-detection here / prevent dies under all circumstances!
192        require $includefile;
193        $self->mixinPackage($package) if $package;
194      }
195    
196  1;  1;
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.5
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed