--- nfo/perl/libs/DesignPattern/Bridge.pm 2002/12/15 02:06:15 1.2 +++ nfo/perl/libs/DesignPattern/Bridge.pm 2002/12/16 19:57:12 1.3 @@ -1,7 +1,10 @@ ## -------------------------------------------------------------------------------- -## $Id: Bridge.pm,v 1.2 2002/12/15 02:06:15 joko Exp $ +## $Id: Bridge.pm,v 1.3 2002/12/16 19:57:12 joko Exp $ ## -------------------------------------------------------------------------------- ## $Log: Bridge.pm,v $ +## Revision 1.3 2002/12/16 19:57:12 joko +## + sub unload +## ## Revision 1.2 2002/12/15 02:06:15 joko ## + feature to be able to specify module in non-perl-style when loading plugins: e.g. $process->load('Setup/Storage') ## @@ -36,6 +39,7 @@ # get logger instance my $logger = Log::Dispatch::Config->instance; +my $meta; ## ======== object constructor ======== sub new { @@ -77,23 +81,37 @@ ## } } - - sub load { + sub _getPluginPackage { my $self = shift; - my $self_classname = ref $self; - my $modulename_load = shift; - + # substitute slashes through double double-colons to load modules perl-style $modulename_load =~ s/\//::/g; + # build full package name + my $self_classname = ref $self; my $package = $self_classname . '::' . $modulename_load; + return $package; + } + + sub load { + + my $self = shift; + my $modulename_load = shift; + + my $package = $self->_getPluginPackage($modulename_load); + + if ($meta->{loaded}->{$package}) { + return 1; + } + $logger->info( __PACKAGE__ . "->load: $package" ); # this is the module testing phase - use mixin doesn't seem to propagate errors by default eval("use $package;"); if ($@) { + $meta->{loaded}->{$package} = 0; # include caller information my @caller = caller; my $caller_msg = $caller[1] . ':' . $caller[2]; @@ -108,14 +126,36 @@ # V2: # switch into foreign package and mixin plugin-module + my $self_classname = ref $self; eval("package $self_classname; use mixin '$package';"); #eval("use mixin_all '$package';"); if ($@) { + $meta->{loaded}->{$package} = 0; $logger->error( __PACKAGE__ . "->load: $@" ); + } else { + $meta->{loaded}->{$package} = 1; } + + return 1; + + } + + sub unload { + + my $self = shift; + my $modulename_unload = shift; + + my $package = $self->_getPluginPackage($modulename_unload); + if ($meta->{loaded}->{$package}) { + $meta->{loaded}->{$package} = 0; + my $where = __PACKAGE__ . ':' . __LINE__; + $logger->debug( __PACKAGE__ . "->unload: FIXME: DESTROY object is not implemented at '$where'." ); + } + } + sub boot { my $self = shift; $self->_abstract_function('boot');