/[cvs]/nfo/perl/libs/DesignPattern/Bridge.pm
ViewVC logotype

Annotation of /nfo/perl/libs/DesignPattern/Bridge.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (hide annotations)
Fri Jan 31 01:19:50 2003 UTC (21 years, 9 months ago) by root
Branch: MAIN
Changes since 1.4: +19 -10 lines
+ fixed: doesn't need Log::Dispatch any more, but uses it if available

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 RSS 2.0 feed