/[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.2 - (hide annotations)
Sun Dec 15 02:06:15 2002 UTC (21 years, 5 months ago) by joko
Branch: MAIN
Changes since 1.1: +14 -3 lines
+ feature to be able to specify module in non-perl-style when loading plugins: e.g. $process->load('Setup/Storage')

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

MailToCvsAdmin">MailToCvsAdmin
ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed