2 |
## $Id$ |
## $Id$ |
3 |
## -------------------------------------------------------------------------------- |
## -------------------------------------------------------------------------------- |
4 |
## $Log$ |
## $Log$ |
5 |
|
## Revision 1.11 2003/02/21 08:38:21 joko |
6 |
|
## + additional checks |
7 |
|
## + raising exceptions |
8 |
|
## |
9 |
|
## Revision 1.10 2003/02/20 20:50:32 joko |
10 |
|
## + small exception handling: now inheriting from little Exception object |
11 |
|
## |
12 |
|
## Revision 1.9 2003/02/18 18:35:30 joko |
13 |
|
## + encapsulated/abstracted some more functionality: sub load_single |
14 |
|
## |
15 |
## Revision 1.8 2003/02/14 14:20:05 joko |
## Revision 1.8 2003/02/14 14:20:05 joko |
16 |
## + modified mixin behaviour |
## + modified mixin behaviour |
17 |
## |
## |
47 |
use strict; |
use strict; |
48 |
use warnings; |
use warnings; |
49 |
|
|
50 |
use base qw( DesignPattern::Object ); |
use base qw( |
51 |
|
DesignPattern::Object |
52 |
|
DesignPattern::Exception |
53 |
|
); |
54 |
|
|
55 |
|
|
56 |
use Data::Dumper; |
use Data::Dumper; |
57 |
|
|
143 |
sub load { |
sub load { |
144 |
|
|
145 |
my $self = shift; |
my $self = shift; |
146 |
|
my $modulename = shift; |
147 |
|
my $options = shift; |
148 |
|
|
149 |
|
if (ref $modulename eq 'ARRAY') { |
150 |
|
foreach (@$modulename) { |
151 |
|
$self->load_single($_, $options); |
152 |
|
} |
153 |
|
} else { |
154 |
|
$self->load_single($modulename, $options); |
155 |
|
} |
156 |
|
|
157 |
|
} |
158 |
|
|
159 |
|
sub load_single { |
160 |
|
|
161 |
|
my $self = shift; |
162 |
my $modulename_load = shift; |
my $modulename_load = shift; |
163 |
|
|
164 |
my $options = shift; |
my $options = shift; |
176 |
|
|
177 |
# this is the module testing phase - use mixin doesn't seem to propagate errors by default |
# this is the module testing phase - use mixin doesn't seem to propagate errors by default |
178 |
eval("use $package;"); |
eval("use $package;"); |
179 |
|
$self->checkExceptions(); |
180 |
|
|
181 |
|
=pod |
182 |
if ($@) { |
if ($@) { |
183 |
$meta->{loaded}->{$package} = 0; |
$meta->{loaded}->{$package} = 0; |
184 |
# include caller information |
# include caller information |
191 |
print $msg, "\n"; |
print $msg, "\n"; |
192 |
} |
} |
193 |
} |
} |
194 |
|
=cut |
195 |
|
|
196 |
#print "ref-1: ", ref $self, "\n"; |
#print "ref-1: ", ref $self, "\n"; |
197 |
#print "ref-2: ", ref $self::SUPER, "\n"; |
#print "ref-2: ", ref $self::SUPER, "\n"; |
284 |
my $self = shift; |
my $self = shift; |
285 |
my $includefile = shift; |
my $includefile = shift; |
286 |
my $package = shift; |
my $package = shift; |
287 |
# TODO: do better error-detection here / prevent dies under all circumstances! |
|
288 |
require $includefile; |
# pre-flight checks |
289 |
|
if (!$includefile) { |
290 |
|
$self->raiseException('Filename for inclusion was empty.'); |
291 |
|
return; |
292 |
|
} |
293 |
|
|
294 |
|
# go for it ... |
295 |
|
eval("require '$includefile';"); |
296 |
|
# ... and handle errors afterwards catching every message from perl itself ... |
297 |
|
return if $self->checkExceptions(); |
298 |
|
|
299 |
|
# ... otherwise continue assuming everything is fine |
300 |
$self->mixinPackage($package) if $package; |
$self->mixinPackage($package) if $package; |
301 |
|
|
302 |
} |
} |
303 |
|
|
304 |
1; |
1; |