--- nfo/perl/libs/DesignPattern/Bridge.pm 2003/01/20 16:55:15 1.4 +++ nfo/perl/libs/DesignPattern/Bridge.pm 2003/02/18 18:35:30 1.9 @@ -1,7 +1,24 @@ ## -------------------------------------------------------------------------------- -## $Id: Bridge.pm,v 1.4 2003/01/20 16:55:15 joko Exp $ +## $Id: Bridge.pm,v 1.9 2003/02/18 18:35:30 joko Exp $ ## -------------------------------------------------------------------------------- ## $Log: Bridge.pm,v $ +## Revision 1.9 2003/02/18 18:35:30 joko +## + encapsulated/abstracted some more functionality: sub load_single +## +## Revision 1.8 2003/02/14 14:20:05 joko +## + modified mixin behaviour +## +## Revision 1.7 2003/02/11 10:34:19 joko +## + loaded module may now lack 'mixin::with' declaration +## + this gets us the possibility to load modules from any perl namespace +## + enabled this mechanism +## +## Revision 1.6 2003/02/09 16:22:51 joko +## + pseudo constructor mechanism via options +## +## Revision 1.5 2003/01/31 01:19:50 root +## + fixed: doesn't need Log::Dispatch any more, but uses it if available +## ## Revision 1.4 2003/01/20 16:55:15 joko ## + sub mixinPackage ## + sub include @@ -29,7 +46,8 @@ ## ======== object inheritance ======== -# TODO: +# TODO / REFACTORING PROPOSAL +# leading from Data::Storage to code abstracted out into this module - DesignPattern::Bridge # - this is no inheritance and it doesn't have to be # - implement this module as a bridge to its sub-modules # - use the BridgePattern (http://c2.com/cgi/wiki?BridgePattern) @@ -40,27 +58,31 @@ # - sub getChildNodes # - sub run +# 2003-02-11, joko: does this have anything in parallel with CPAN's Class::Inner? + + # get logger instance -my $logger = Log::Dispatch::Config->instance; +my $logger = eval { Log::Dispatch::Config->instance; }; my $meta; ## ======== object constructor ======== - sub new { - my $invocant = shift; - my $class = ref($invocant) || $invocant; - my @args = (); - @_ && (@args = @_); - $logger->debug( __PACKAGE__ . "->new(@args)" ); - my $self = { @_ }; +sub new { + my $invocant = shift; + my $class = ref($invocant) || $invocant; + my @args = (); + @_ && (@args = @_); + $logger->debug( __PACKAGE__ . "->new(@args)" ) if $logger; + my $self = { @_ }; + + # trace #print "class: $class", "\n"; - bless $self, $class; - ##if (my $bizWorks = shift) { - ##$self->boot($bizWorks); - ##} - - return $self; - } + + # create instance + bless $self, $class; + + return $self; +} ## ======== method overrider ======== @@ -74,7 +96,7 @@ my $method = $AUTOLOAD; $method =~ s/^.*:://; - $logger->debug( __PACKAGE__ . "->" . $method . "(@_)" . " (AUTOLOAD called, not dispatched)" ); + $logger->debug( __PACKAGE__ . "->" . $method . "(@_)" . " (AUTOLOAD called, not dispatched)" ) if $logger; ## ->DESTROY would - if not declared - trigger an AUTOLOAD also return if $method =~ m/::DESTROY$/; @@ -95,15 +117,41 @@ # build full package name my $self_classname = ref $self; - my $package = $self_classname . '::' . $modulename_load; + # name + my $package = $modulename_load; + + # if package is absolute, cut away prefix ('/' or '::') + if ($package !~ s/^:://) { + # else: prefix with base classname if above name is relative (lacks of '/' or '::') + $package = $self_classname . '::' . $package + } + return $package; } sub load { my $self = shift; + my $modulename = shift; + my $options = shift; + + if (ref $modulename eq 'ARRAY') { + foreach (@$modulename) { + $self->load_single($_, $options); + } + } else { + $self->load_single($modulename, $options); + } + + } + + sub load_single { + + my $self = shift; my $modulename_load = shift; + my $options = shift; + my $self_modulename = ref $self; my $package = $self->_getPluginPackage($modulename_load); @@ -111,9 +159,9 @@ return 1; } - #$logger->info( __PACKAGE__ . "->load: $package" ); - #$logger->info( __PACKAGE__ . "->load: $self_modulename" ); - $logger->debug( $self_modulename . "->load: $package\t[via " . __PACKAGE__ . "]" ); + #$logger->info( __PACKAGE__ . "->load: $package" ) if $logger; + #$logger->info( __PACKAGE__ . "->load: $self_modulename" ) if $logger; + $logger->debug( $self_modulename . "->load: $package\t[via " . __PACKAGE__ . "]" ) if $logger; # this is the module testing phase - use mixin doesn't seem to propagate errors by default eval("use $package;"); @@ -122,7 +170,12 @@ # include caller information my @caller = caller; my $caller_msg = $caller[1] . ':' . $caller[2]; - $logger->error( __PACKAGE__ . "->load: $@ ($caller_msg)" ); + my $msg = __PACKAGE__ . "->load: $@ ($caller_msg)"; + if ($logger) { + $logger->error($msg); + } else { + print $msg, "\n"; + } } #print "ref-1: ", ref $self, "\n"; @@ -132,27 +185,63 @@ #bless $self, $package; # V2: - # switch into foreign package and mixin plugin-module $self->mixinPackage($package); + + if (my $method = $options->{method}) { + $self->$method(); + } return 1; } + + sub mixinPackage { + my $self = shift; + my $package = shift; + + # switch into foreign package and prepare for mixin + $self->mixin_prepare($package); + + # switch into local package (scope which uses DesignPattern::Bridge) and mixin plugin-module + $self->mixin_do($package); + + } # TODO: maybe refactor to DesignPattern::Object? what about the '$logger'? - sub mixinPackage { + sub mixin_prepare { + my $self = shift; + my $package = shift; + my $self_classname = ref $self; + eval("package $package; use mixin::with '$self_classname';"); + + # FIXME: --- this is redundant --- + if ($@) { + $meta->{loaded}->{$package} = 0; + $logger->error( __PACKAGE__ . "->load: $@" ) if $logger; + } else { + $meta->{loaded}->{$package} = 1; + } + # FIXME: --- this is redundant --- + + } + + sub mixin_do { my $self = shift; my $package = shift; # 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';"); + + # FIXME: --- this is redundant --- if ($@) { $meta->{loaded}->{$package} = 0; - $logger->error( __PACKAGE__ . "->load: $@" ); + $logger->error( __PACKAGE__ . "->load: $@" ) if $logger; } else { $meta->{loaded}->{$package} = 1; } + # FIXME: --- this is redundant --- + } sub unload { @@ -165,7 +254,7 @@ if ($meta->{loaded}->{$package}) { $meta->{loaded}->{$package} = 0; my $where = __PACKAGE__ . ':' . __LINE__; - $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; } } @@ -186,3 +275,4 @@ } 1; +__END__