1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
|
#============================================================= -*-perl-*-
#
# t/core/modules.t
#
# Test the Badger::Modules module.
#
# Copyright (C) 2006-2010 Andy Wardley. All Rights Reserved.
#
# This is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
#========================================================================
use strict;
use warnings;
use lib qw( core/lib t/core/lib ./lib ../lib ../../lib );
use Badger::Test
debug => 'Badger::Modules',
args => \@ARGV,
tests => 13;
use Badger::Modules;
pass('Loaded Badger::Modules');
#-----------------------------------------------------------------------
# define a modules object
#-----------------------------------------------------------------------
my $modules = Badger::Modules->new(
path => ['My', 'Your'],
tolerant => 1,
);
ok( $modules, 'Created module manager' );
# this should be located in the first path, e.g. My::Widget
my $widget = $modules->module('widget');
is( $widget, 'My::Widget', "got widget module: $widget" );
# this should be located in the second path, e.g. Your::Doodah
my $doodah = $modules->module('doodah');
ok( $doodah, "got doodah module: $doodah" );
# this should fail because we can't automatically capitalise it
my $url = $modules->module('url');
ok( ! $url, "could not find url" );
# provide a name lookup
$modules->names(
url => 'URL',
);
# should find it now
$url = $modules->module('url');
ok( $url, "got URL module: $url" );
# should also be able to define the name mapping up front
$modules = Badger::Modules->new(
item => 'thingy',
path => ['My', 'Your'],
names => {
url => 'URL',
},
);
ok( $modules->module('url'), 'got url module again' );
# this should fail
eval { $modules->module('fail') };
if ($@) {
like( $@, qr/Can't locate Some.+Module/, "error thrown on missing module" );
print "caught: ", "$@\n";
print "error: ", $modules->error, "\n";
}
else {
fail('Should have failed to load "fail" module');
};
#-----------------------------------------------------------------------
# define a modules subclass
#-----------------------------------------------------------------------
package My::Modules;
use Badger::Class
base => 'Badger::Modules';
our $ITEM = 'thing';
our $THING_PATH = ['My', 'Your'];
our $THINGS = {
dangly => 'My::Extra::Wudget',
spangly => ['My::Extra::Wudget', 'My::Extra::Wudgetola'],
};
#-----------------------------------------------------------------------
# define a class inline to illustrate autoload defeating
#-----------------------------------------------------------------------
package Your::Sparkly;
use Badger::Class
version => 1, # defines VERSION to indicate class is already loaded
base => 'Badger::Base',
accessors => 'name';
sub init {
my ($self, $config) = @_;
$self->{ name } = $config->{ name };
return $self;
}
#-----------------------------------------------------------------------
# test it with modules loaded from $THING_PATH
#-----------------------------------------------------------------------
package main;
$widget = My::Modules->module('Widget');
is( $widget, 'My::Widget', 'My::Widget' );
# should also work in lower case
my $wodget = My::Modules->module('wodget');
is( $wodget, 'My::Wodget', 'My::Wodget' );
#-----------------------------------------------------------------------
# test it with Your::Sparkly module defined inline above
#-----------------------------------------------------------------------
my $sparkly = My::Modules->module('sparkly');
is( $sparkly, 'Your::Sparkly', 'Your::Sparkly' );
#-----------------------------------------------------------------------
# test that it still loads a module, even if a (limited) symbol table
# already exists
#-----------------------------------------------------------------------
BEGIN {
no warnings 'once';
$Your::Answer::DEBUG = 1;
}
my $answer = My::Modules->module('answer');
is( $answer, 'Your::Answer', 'Your::Answer' );
is( Your::Answer::answer(), 42, 'Your::Answer is 42' );
__END__
# Local Variables:
# mode: perl
# perl-indent-level: 4
# indent-tabs-mode: nil
# End:
#
# vim: expandtab shiftwidth=4:
|
