libs/DesignPattern/Bridge.pm

## --------------------------------------------------------------------------------
##  $Id: Bridge.pm,v 1.2 2002/12/15 02:06:15 joko Exp $
## --------------------------------------------------------------------------------
##  $Log: Bridge.pm,v $
##  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 = 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 = { @_ };
    #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)" );

    ## ->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 $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];
      $logger->error( __PACKAGE__ . "->load: $@ ($caller_msg)" );
    }

#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
    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');
  }

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