line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Kelp::Module; |
2
|
|
|
|
|
|
|
|
3
|
34
|
|
|
34
|
|
702
|
use Kelp::Base; |
|
34
|
|
|
|
|
96
|
|
|
34
|
|
|
|
|
328
|
|
4
|
34
|
|
|
34
|
|
2745
|
use Carp; |
|
34
|
|
|
|
|
128
|
|
|
34
|
|
|
|
|
7480
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
attr -app => sub { die "app is required" }; |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
sub new { |
9
|
166
|
|
|
166
|
0
|
1107
|
my $self = shift->SUPER::new(@_); |
10
|
166
|
|
|
|
|
768
|
$self->app; |
11
|
165
|
|
|
|
|
537
|
return $self; |
12
|
|
|
|
|
|
|
} |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
# Override this to register items |
15
|
|
|
|
|
|
|
sub build { |
16
|
0
|
|
|
0
|
1
|
0
|
my ( $self, %args ) = @_; |
17
|
|
|
|
|
|
|
} |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
sub register { |
20
|
209
|
|
|
209
|
1
|
25857
|
my ( $self, %items ) = @_; |
21
|
209
|
|
|
|
|
828
|
while ( my ( $name, $item ) = each(%items) ) { |
22
|
34
|
|
|
34
|
|
339
|
no strict 'refs'; |
|
34
|
|
|
|
|
82
|
|
|
34
|
|
|
|
|
1398
|
|
23
|
34
|
|
|
34
|
|
242
|
no warnings 'redefine'; |
|
34
|
|
|
|
|
71
|
|
|
34
|
|
|
|
|
9037
|
|
24
|
|
|
|
|
|
|
|
25
|
296
|
|
|
|
|
725
|
my $app = ref $self->app; |
26
|
296
|
|
|
|
|
698
|
my $glob = "${app}::$name"; |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
# Manually check if the glob is being redefined |
29
|
296
|
100
|
100
|
|
|
964
|
if ( !$ENV{KELP_REDEFINE} && $self->app->can($name) ) { |
30
|
17
|
|
|
|
|
199
|
croak "Redefining of $glob not allowed"; |
31
|
|
|
|
|
|
|
} |
32
|
|
|
|
|
|
|
|
33
|
279
|
100
|
|
|
|
792
|
if ( ref $item eq 'CODE' ) { |
34
|
136
|
|
|
|
|
201
|
*{$glob} = $item; |
|
136
|
|
|
|
|
927
|
|
35
|
|
|
|
|
|
|
} |
36
|
|
|
|
|
|
|
else { |
37
|
143
|
|
|
|
|
349
|
$self->app->{$name} = $item; |
38
|
143
|
|
|
520
|
|
1067
|
*{$glob} = sub { $_[0]->{$name} } |
|
520
|
|
|
|
|
8290
|
|
39
|
143
|
|
|
|
|
571
|
} |
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
1; |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
__END__ |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
=pod |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
=head1 NAME |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
Kelp::Module - Base class for Kelp modules |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
=head1 SYNOPSIS |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
package Kelp::Module::MyModule; |
56
|
|
|
|
|
|
|
use parent 'Kelp::Module'; |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
sub build { |
59
|
|
|
|
|
|
|
my ( $self, %args ) = @_; |
60
|
|
|
|
|
|
|
$self->register( greet => sub { print "Hi there." } ); |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
=head1 DESCRIPTION |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
Provides the base class for creating Kelp modules. Creating a Kelp module means |
66
|
|
|
|
|
|
|
extending this class and overriding the C<build> method. |
67
|
|
|
|
|
|
|
Kelp modules usually C<register> a new method into the web application. |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=head2 Registering methods |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
Modules use the L</register> method to register new methods into the underlying |
72
|
|
|
|
|
|
|
web application. All the registrations are done in the L</build> subroutine. |
73
|
|
|
|
|
|
|
All types of values can be registered and then accessed as a read-only attribute |
74
|
|
|
|
|
|
|
from the web app. The simplest thing you can register is a scalar value: |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
First... |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
# lib/Kelp/Module/Month.pm |
79
|
|
|
|
|
|
|
package Kelp::Module::Month; |
80
|
|
|
|
|
|
|
use Kelp::Base 'Kelp::Module'; |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
sub build { |
83
|
|
|
|
|
|
|
my ( $self, %args ) = @_; |
84
|
|
|
|
|
|
|
$self->register( month => 'October' ); |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
Then ... |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
# lib/MyApp.pm |
90
|
|
|
|
|
|
|
package MyApp; |
91
|
|
|
|
|
|
|
use parent 'Kelp'; |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
sub build { |
94
|
|
|
|
|
|
|
my $self = shift; |
95
|
|
|
|
|
|
|
$self->load_module("Month"); |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
sub is_it_october_yet { |
99
|
|
|
|
|
|
|
my $self = shift; |
100
|
|
|
|
|
|
|
if ( $self->month eq 'October' ) { |
101
|
|
|
|
|
|
|
return "It is October"; |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
return "Not yet."; |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
The above example doesn't do anything meaningful, but it's a good |
107
|
|
|
|
|
|
|
way to show how to create and use Kelp modules. Pay attention to the next |
108
|
|
|
|
|
|
|
example, as it will show you how to register an anonymous subroutine: |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
package Kelp::Module::Date; |
111
|
|
|
|
|
|
|
use Kelp::Base 'Kelp::Module'; |
112
|
|
|
|
|
|
|
use DateTime; |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
sub build { |
115
|
|
|
|
|
|
|
my ( $self, %args ) = @_; |
116
|
|
|
|
|
|
|
$self->register( |
117
|
|
|
|
|
|
|
date => sub { |
118
|
|
|
|
|
|
|
return DateTime->from_epoch( epoch => time ); |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
); |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
Now, each time you use C<$self-E<gt>date> in the web application, you will create |
124
|
|
|
|
|
|
|
a new C<DateTime> object for the current time. |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
It is more practical to register an already created object. Consider this |
127
|
|
|
|
|
|
|
example, which uses C<Redis>, initializes an instance of it and registers it as |
128
|
|
|
|
|
|
|
a method in the web app: |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
package Kelp::Module::Redis; |
131
|
|
|
|
|
|
|
use Kelp::Base 'Kelp::Module'; |
132
|
|
|
|
|
|
|
use Redis; |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
sub build { |
135
|
|
|
|
|
|
|
my ( $self, %args ) = @_; |
136
|
|
|
|
|
|
|
my $redis = Redis->new(%args); |
137
|
|
|
|
|
|
|
$self->register( redis => $redis ); |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
=head2 Passing arguments to your module |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
The arguments for all modules are taken from the configuration. If you want to |
143
|
|
|
|
|
|
|
pass arguments for your C<Redis> module (example above), you will have to have a |
144
|
|
|
|
|
|
|
structure in your config, similar to this: |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
Example of C<conf/myapp.pl>: |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
{ |
149
|
|
|
|
|
|
|
# Load module Redis on start |
150
|
|
|
|
|
|
|
modules => ['Redis'], |
151
|
|
|
|
|
|
|
modules_init => { |
152
|
|
|
|
|
|
|
Redis => { |
153
|
|
|
|
|
|
|
server => '192.168.0.1:6379', |
154
|
|
|
|
|
|
|
encoding => 'UTF-8', |
155
|
|
|
|
|
|
|
password => 'boo' |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
}; |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
The hash specified by C<Redis> will be sent as C<%args> in the C<build> method |
161
|
|
|
|
|
|
|
of the module. |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
=head2 Loading modules that live outside of the Kelp::Module namespace |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
Kelp will automatically prefix all modules with C<Kelp::Module>, so a module name |
166
|
|
|
|
|
|
|
C<Redis> should live in C<Kelp::Module::Redis>. |
167
|
|
|
|
|
|
|
To use fully qualified modules that live outside of the C<Kelp::Module> namespace, |
168
|
|
|
|
|
|
|
prefix the name with a plus sign. |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
{ |
171
|
|
|
|
|
|
|
# Load a module that lives outside of Kelp::Module |
172
|
|
|
|
|
|
|
modules => ["+Fully::Qualified::Name"], |
173
|
|
|
|
|
|
|
modules_init => { |
174
|
|
|
|
|
|
|
"+Fully::Qualified::Name" => {...} |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
}; |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=head1 METHODS |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
=head2 build |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
C<build( %args )> |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
Each module must override this one in order to register new methods. The |
185
|
|
|
|
|
|
|
C<%args> hash will be taken from the configuration. |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
=head2 register |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
C<register( %items )> |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
Registers one or many methods into the web application. |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
$self->register( |
194
|
|
|
|
|
|
|
json => JSON->new, |
195
|
|
|
|
|
|
|
yaml => YAML->new |
196
|
|
|
|
|
|
|
); |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
=cut |