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 |