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