libs/DesignPattern/Bridge.pm

## --------------------------------------------------------------------------------
##  $Id: Bridge.pm,v 1.4 2003/01/20 16:55:15 joko Exp $
## --------------------------------------------------------------------------------
##  $Log: Bridge.pm,v $
##  Revision 1.4  2003/01/20 16:55:15  joko
##  + sub mixinPackage
##  + sub include
##
##  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')
##
##  Revision 1.1  2002/12/13 21:46:29  joko
##  + initial check-in
##
## --------------------------------------------------------------------------------


package DesignPattern::Bridge;

use strict;
use warnings;

use base qw( DesignPattern::Object );

use Data::Dumper;

## ========   object inheritance   ========

# TODO:
#   - 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) 
#       Using patterns was already successfully done with Data::Storage::Handler
#       by implementing the AdapterPattern (http://c2.com/cgi/wiki?AdapterPattern)
#       with Perl's AUTOLOAD-mechanism
#   - try to use Perl's "tie" command to implement this functionality here instead of using AUTOLOAD!
#   - sub getChildNodes
#   - sub run

# get logger 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)" ) if $logger;
    my $self = { @_ };
    #print "class: $class", "\n";
    bless $self, $class;
    ##if (my $bizWorks = shift) {
      ##$self->boot($bizWorks);
    ##}
    
    return $self;
  }


## ========   method overrider   ========
  sub AUTOLOAD2 {
    
    my $self = shift;
    our $AUTOLOAD;
    
    ##print "AUTOLOAD\n";

    my $method = $AUTOLOAD;
    $method =~ s/^.*:://;
  
    $logger->debug( __PACKAGE__ . "->" . $method . "(@_)" . " (AUTOLOAD called, not dispatched)" ) if $logger;

    ## ->DESTROY would - if not declared - trigger an AUTOLOAD also
    return if $method =~ m/::DESTROY$/;
  
##    if ($self->_filter_AUTOLOAD($method)) {
##      $self->_accessStorage();
##      $self->{STORAGEHANDLE}->$method(@_);
##    }
    
  }

  sub _getPluginPackage {
    my $self = shift;
    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 $self_modulename = ref $self;
    my $package = $self->_getPluginPackage($modulename_load);
    
    if ($meta->{loaded}->{$package}) {
      return 1;
    }
    
    #$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;");
    if ($@) {
      $meta->{loaded}->{$package} = 0;
      # include caller information
      my @caller = caller;
      my $caller_msg = $caller[1] . ':' . $caller[2];
      my $msg =  __PACKAGE__ . "->load: $@ ($caller_msg)";
      if ($logger) {
        $logger->error($msg);
      } else {
        print $msg, "\n";
      }
    }

#print "ref-1: ", ref $self, "\n";
#print "ref-2: ", ref $self::SUPER, "\n";
    
    # V1:
    #bless $self, $package;

    # V2:
    # switch into foreign package and mixin plugin-module
    $self->mixinPackage($package);

    return 1;
    
  }

  # TODO: maybe refactor to DesignPattern::Object? what about the '$logger'?
  sub mixinPackage {
    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';");
    if ($@) {
      $meta->{loaded}->{$package} = 0;
      $logger->error( __PACKAGE__ . "->load: $@" ) if $logger;
    } else {
      $meta->{loaded}->{$package} = 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'." ) if $logger;
    }

  }


  sub boot {
    my $self = shift;
    $self->_abstract_function('boot');
  }
  
  sub include {
    my $self = shift;
    my $includefile = shift;
    my $package = shift;
    # TODO: do better error-detection here / prevent dies under all circumstances!
    require $includefile;
    $self->mixinPackage($package) if $package;
  }

1;
1	joko	1.1	## --------------------------------------------------------------------------------
2	root	1.5	## $Id: Bridge.pm,v 1.4 2003/01/20 16:55:15 joko Exp $
3	joko	1.1	## --------------------------------------------------------------------------------
4	joko	1.2	## $Log: Bridge.pm,v $
5	root	1.5	## Revision 1.4 2003/01/20 16:55:15 joko
6			## + sub mixinPackage
7			## + sub include
8			##
9	joko	1.4	## Revision 1.3 2002/12/16 19:57:12 joko
10			## + sub unload
11			##
12	joko	1.3	## 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')
14			##
15	joko	1.2	## Revision 1.1 2002/12/13 21:46:29 joko
16			## + initial check-in
17			##
18	joko	1.1	## --------------------------------------------------------------------------------
19
20
21			package DesignPattern::Bridge;
22
23			use strict;
24			use warnings;
25
26			use base qw( DesignPattern::Object );
27
28	joko	1.2	use Data::Dumper;
29
30	joko	1.1	## ======== object inheritance ========
31
32			# TODO:
33			# - this is no inheritance and it doesn't have to be
34			# - implement this module as a bridge to its sub-modules
35			# - use the BridgePattern (http://c2.com/cgi/wiki?BridgePattern)
36			# Using patterns was already successfully done with Data::Storage::Handler
37			# by implementing the AdapterPattern (http://c2.com/cgi/wiki?AdapterPattern)
38			# with Perl's AUTOLOAD-mechanism
39			# - try to use Perl's "tie" command to implement this functionality here instead of using AUTOLOAD!
40			# - sub getChildNodes
41			# - sub run
42
43			# get logger instance
44	root	1.5	my $logger = eval { Log::Dispatch::Config->instance; };
45	joko	1.1
46	joko	1.3	my $meta;
47	joko	1.1
48			## ======== object constructor ========
49			sub new {
50			my $invocant = shift;
51			my $class = ref($invocant) \|\| $invocant;
52			my @args = ();
53			@_ && (@args = @_);
54	root	1.5	$logger->debug( __PACKAGE__ . "->new(@args)" ) if $logger;
55	joko	1.1	my $self = { @_ };
56			#print "class: $class", "\n";
57			bless $self, $class;
58			##if (my $bizWorks = shift) {
59			##$self->boot($bizWorks);
60			##}
61
62			return $self;
63			}
64
65
66			## ======== method overrider ========
67			sub AUTOLOAD2 {
68
69			my $self = shift;
70			our $AUTOLOAD;
71
72			##print "AUTOLOAD\n";
73
74			my $method = $AUTOLOAD;
75			$method =~ s/^.*:://;
76
77	root	1.5	$logger->debug( __PACKAGE__ . "->" . $method . "(@_)" . " (AUTOLOAD called, not dispatched)" ) if $logger;
78	joko	1.1
79			## ->DESTROY would - if not declared - trigger an AUTOLOAD also
80			return if $method =~ m/::DESTROY$/;
81
82			## if ($self->_filter_AUTOLOAD($method)) {
83			## $self->_accessStorage();
84			## $self->{STORAGEHANDLE}->$method(@_);
85			## }
86
87			}
88	joko	1.3
89			sub _getPluginPackage {
90			my $self = shift;
91			my $modulename_load = shift;
92
93			# substitute slashes through double double-colons to load modules perl-style
94			$modulename_load =~ s/\//::/g;
95
96			# build full package name
97			my $self_classname = ref $self;
98			my $package = $self_classname . '::' . $modulename_load;
99			return $package;
100			}
101	joko	1.1
102			sub load {
103
104			my $self = shift;
105	joko	1.3	my $modulename_load = shift;
106	joko	1.1
107	joko	1.4	my $self_modulename = ref $self;
108	joko	1.3	my $package = $self->_getPluginPackage($modulename_load);
109	joko	1.1
110	joko	1.3	if ($meta->{loaded}->{$package}) {
111			return 1;
112			}
113	joko	1.2
114	root	1.5	#$logger->info( __PACKAGE__ . "->load: $package" ) if $logger;
115			#$logger->info( __PACKAGE__ . "->load: $self_modulename" ) if $logger;
116			$logger->debug( $self_modulename . "->load: $package\t[via " . __PACKAGE__ . "]" ) if $logger;
117	joko	1.1
118			# this is the module testing phase - use mixin doesn't seem to propagate errors by default
119			eval("use $package;");
120			if ($@) {
121	joko	1.3	$meta->{loaded}->{$package} = 0;
122	joko	1.2	# include caller information
123			my @caller = caller;
124			my $caller_msg = $caller[1] . ':' . $caller[2];
125	root	1.5	my $msg = __PACKAGE__ . "->load: $@ ($caller_msg)";
126			if ($logger) {
127			$logger->error($msg);
128			} else {
129			print $msg, "\n";
130			}
131	joko	1.1	}
132
133			#print "ref-1: ", ref $self, "\n";
134			#print "ref-2: ", ref $self::SUPER, "\n";
135
136			# V1:
137			#bless $self, $package;
138
139			# V2:
140			# switch into foreign package and mixin plugin-module
141	joko	1.4	$self->mixinPackage($package);
142
143			return 1;
144
145			}
146
147			# TODO: maybe refactor to DesignPattern::Object? what about the '$logger'?
148			sub mixinPackage {
149			my $self = shift;
150			my $package = shift;
151			# switch into foreign package and mixin plugin-module
152	joko	1.3	my $self_classname = ref $self;
153	joko	1.1	eval("package $self_classname; use mixin '$package';");
154			#eval("use mixin_all '$package';");
155			if ($@) {
156	joko	1.3	$meta->{loaded}->{$package} = 0;
157	root	1.5	$logger->error( __PACKAGE__ . "->load: $@" ) if $logger;
158	joko	1.3	} else {
159			$meta->{loaded}->{$package} = 1;
160	joko	1.1	}
161	joko	1.3	}
162
163			sub unload {
164
165			my $self = shift;
166			my $modulename_unload = shift;
167
168			my $package = $self->_getPluginPackage($modulename_unload);
169	joko	1.1
170	joko	1.3	if ($meta->{loaded}->{$package}) {
171			$meta->{loaded}->{$package} = 0;
172			my $where = __PACKAGE__ . ':' . __LINE__;
173	root	1.5	$logger->debug( __PACKAGE__ . "->unload: FIXME: DESTROY object is not implemented at '$where'." ) if $logger;
174	joko	1.3	}
175
176	joko	1.1	}
177	joko	1.3
178	joko	1.1
179			sub boot {
180			my $self = shift;
181			$self->_abstract_function('boot');
182	joko	1.4	}
183
184			sub include {
185			my $self = shift;
186			my $includefile = shift;
187			my $package = shift;
188			# TODO: do better error-detection here / prevent dies under all circumstances!
189			require $includefile;
190			$self->mixinPackage($package) if $package;
191	joko	1.1	}
192
193			1;
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26