line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package CGI::Application::Plugin::Forward; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
|
4
|
6
|
|
|
6
|
|
485186
|
use warnings; |
|
6
|
|
|
|
|
18
|
|
|
6
|
|
|
|
|
205
|
|
5
|
6
|
|
|
6
|
|
30
|
use strict; |
|
6
|
|
|
|
|
14
|
|
|
6
|
|
|
|
|
182
|
|
6
|
6
|
|
|
6
|
|
34
|
use Carp; |
|
6
|
|
|
|
|
14
|
|
|
6
|
|
|
|
|
461
|
|
7
|
6
|
|
|
6
|
|
28
|
use vars qw(@ISA @EXPORT); |
|
6
|
|
|
|
|
13
|
|
|
6
|
|
|
|
|
553
|
|
8
|
|
|
|
|
|
|
@ISA = ('Exporter'); |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
@EXPORT = ('forward'); |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
=head1 NAME |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
CGI::Application::Plugin::Forward - Pass control from one run mode to another |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
=head1 VERSION |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
Version 1.06 |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
=cut |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
our $VERSION = '1.06'; |
23
|
|
|
|
|
|
|
|
24
|
6
|
|
|
6
|
|
1189
|
use CGI::Application; |
|
6
|
|
|
|
|
9396
|
|
|
6
|
|
|
|
|
1940
|
|
25
|
|
|
|
|
|
|
if (CGI::Application->can('new_hook')) { |
26
|
|
|
|
|
|
|
CGI::Application->new_hook('forward_prerun'); |
27
|
|
|
|
|
|
|
} |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
=head1 SYNOPSIS |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
use base 'CGI::Application'; |
32
|
|
|
|
|
|
|
use CGI::Application::Plugin::Forward; |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
sub setup { |
35
|
|
|
|
|
|
|
my $self = shift; |
36
|
|
|
|
|
|
|
$self->run_modes([qw( |
37
|
|
|
|
|
|
|
start |
38
|
|
|
|
|
|
|
second_runmode |
39
|
|
|
|
|
|
|
)]); |
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
sub start { |
42
|
|
|
|
|
|
|
my $self = shift; |
43
|
|
|
|
|
|
|
return $self->forward('second_runmode'); |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
sub second_runmode { |
46
|
|
|
|
|
|
|
my $self = shift; |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
my $rm = $self->get_current_runmode; # 'second_runmode' |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
=head1 DESCRIPTION |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
The forward method passes control to another run mode and returns its |
55
|
|
|
|
|
|
|
output. This is equivalent to calling C<< $self->$other_runmode >>, |
56
|
|
|
|
|
|
|
except that L's internal value of the current run mode |
57
|
|
|
|
|
|
|
is updated. |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
This means that calling C<< $self->get_current_runmode >> after calling |
60
|
|
|
|
|
|
|
C will return the name of the new run mode. This is useful for |
61
|
|
|
|
|
|
|
modules that depend on the name of the current run mode such as |
62
|
|
|
|
|
|
|
L. |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
For example, here's how to pass control to a run mode named C |
65
|
|
|
|
|
|
|
from C while updating the value of C: |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
sub setup { |
68
|
|
|
|
|
|
|
my $self = shift; |
69
|
|
|
|
|
|
|
$self->run_modes({ |
70
|
|
|
|
|
|
|
start => 'start', |
71
|
|
|
|
|
|
|
other_action => 'other_method', |
72
|
|
|
|
|
|
|
}); |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
sub start { |
75
|
|
|
|
|
|
|
my $self = shift; |
76
|
|
|
|
|
|
|
return $self->forward('other_action'); |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
sub other_method { |
79
|
|
|
|
|
|
|
my $self = shift; |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
my $rm = $self->get_current_runmode; # 'other_action' |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
Note that forward accepts the I of the run mode (in this case |
85
|
|
|
|
|
|
|
I<'other_action'>), which might not be the same as the name of the |
86
|
|
|
|
|
|
|
method that handles the run mode (in this case I<'other_method'>) |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
You can still call C<< $self->other_method >> directly, but |
90
|
|
|
|
|
|
|
C will not be updated: |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
sub setup { |
93
|
|
|
|
|
|
|
my $self = shift; |
94
|
|
|
|
|
|
|
$self->run_modes({ |
95
|
|
|
|
|
|
|
start => 'start', |
96
|
|
|
|
|
|
|
other_action => 'other_method', |
97
|
|
|
|
|
|
|
}); |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
sub start { |
100
|
|
|
|
|
|
|
my $self = shift; |
101
|
|
|
|
|
|
|
return $self->other_method; |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
sub other_method { |
104
|
|
|
|
|
|
|
my $self = shift; |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
my $rm = $self->get_current_runmode; # 'start' |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
Forward will work with coderef-based runmodes as well: |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
sub setup { |
113
|
|
|
|
|
|
|
my $self = shift; |
114
|
|
|
|
|
|
|
$self->run_modes({ |
115
|
|
|
|
|
|
|
start => 'start', |
116
|
|
|
|
|
|
|
anon_action => sub { |
117
|
|
|
|
|
|
|
my $self = shift; |
118
|
|
|
|
|
|
|
my $rm = $self->get_current_runmode; # 'anon_action' |
119
|
|
|
|
|
|
|
}, |
120
|
|
|
|
|
|
|
}); |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
sub start { |
123
|
|
|
|
|
|
|
my $self = shift; |
124
|
|
|
|
|
|
|
return $self->forward('anon_action'); |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
=head1 FORWARD vs. REDIRECT |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
Calling C changes the run mode of your application, but it |
130
|
|
|
|
|
|
|
stays within the same HTTP request. |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
To redirect to a new runmode using a completely new web request, you |
133
|
|
|
|
|
|
|
might consider using the C method provided by |
134
|
|
|
|
|
|
|
L. |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
The advantage of using an external redirect as opposed to an internal |
137
|
|
|
|
|
|
|
forward is that it provides a 'clean break' between pages. |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
For instance, in a typical BREAD application (Browse, Read, Edit, Add, |
140
|
|
|
|
|
|
|
Delete), after the user completes an action, you usually return the user |
141
|
|
|
|
|
|
|
to the Browse list. For instance, when the user adds a new record |
142
|
|
|
|
|
|
|
via a POST form, and your app returns them to the list of records. |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
If you use C, then you are still in the same request as the |
145
|
|
|
|
|
|
|
original I. The user might hit I, expecting to |
146
|
|
|
|
|
|
|
refresh the list of records. But in fact, I will attempt to |
147
|
|
|
|
|
|
|
repost the I form. The user's browser might present a |
148
|
|
|
|
|
|
|
warning about reposting the same data. The browser may refuse to |
149
|
|
|
|
|
|
|
redisplay the page, due for caching reasons. |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
So in this case, it may make more sense to do a fresh HTTP redirect back |
152
|
|
|
|
|
|
|
to the Browse list. |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
=head1 METHODS |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
=head2 forward |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
Runs another run mode passing any parameters you supply. Returns the |
159
|
|
|
|
|
|
|
output of the new run mode. |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
return $self->forward('run_mode_name', @run_mode_params); |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
=cut |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
sub forward { |
166
|
13
|
|
|
13
|
1
|
167656
|
my $self = shift; |
167
|
13
|
|
|
|
|
41
|
my $run_mode = shift; |
168
|
|
|
|
|
|
|
|
169
|
13
|
100
|
|
|
|
48
|
if ($CGI::Application::Plugin::AutoRunmode::VERSION) { |
170
|
3
|
50
|
|
|
|
39
|
if (CGI::Application::Plugin::AutoRunmode->can('is_auto_runmode')) { |
171
|
3
|
100
|
|
|
|
14
|
if (CGI::Application::Plugin::AutoRunmode::is_auto_runmode($self, $run_mode)) { |
172
|
1
|
|
|
|
|
27
|
$self->run_modes( $run_mode => $run_mode); |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
|
177
|
13
|
|
|
|
|
339
|
my %rm_map = $self->run_modes; |
178
|
13
|
100
|
|
|
|
251
|
if (not exists $rm_map{$run_mode}) { |
179
|
4
|
|
|
|
|
827
|
croak "CAP::Forward: run mode $run_mode does not exist"; |
180
|
|
|
|
|
|
|
} |
181
|
9
|
|
|
|
|
24
|
my $method = $rm_map{$run_mode}; |
182
|
|
|
|
|
|
|
|
183
|
9
|
100
|
100
|
|
|
121
|
if ($self->can($method) or ref $method eq 'CODE') { |
184
|
7
|
|
|
|
|
21
|
$self->{__CURRENT_RUNMODE} = $run_mode; |
185
|
7
|
50
|
|
|
|
34
|
if ($self->can('call_hook')) { |
186
|
7
|
|
|
|
|
24
|
$self->call_hook('forward_prerun'); |
187
|
|
|
|
|
|
|
} |
188
|
7
|
|
|
|
|
221
|
return $self->$method(@_); |
189
|
|
|
|
|
|
|
} |
190
|
|
|
|
|
|
|
else { |
191
|
2
|
|
|
|
|
288
|
croak "CAP::Forward: target method $method of run mode $run_mode does not exist"; |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
=head1 HOOKS |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
Before the forwarded run mode is called, the C hook is |
199
|
|
|
|
|
|
|
called. You can use this hook to do any prep work that you want to do |
200
|
|
|
|
|
|
|
before any new run mode gains control. |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
This is similar to L's built in C |
203
|
|
|
|
|
|
|
method, but it is called each time you call L; not just the |
204
|
|
|
|
|
|
|
when your application starts. |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
sub setup { |
207
|
|
|
|
|
|
|
my $self = shift; |
208
|
|
|
|
|
|
|
$self->add_callback('forward_prerun' => \&prepare_rm_stuff); |
209
|
|
|
|
|
|
|
} |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
sub prepare_rm_stuff { |
212
|
|
|
|
|
|
|
my $self = shift; |
213
|
|
|
|
|
|
|
# do any necessary prep work here.... |
214
|
|
|
|
|
|
|
} |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
Note that your hooked method will only be called when you call |
217
|
|
|
|
|
|
|
L. If you never call C, the hook will not be called. |
218
|
|
|
|
|
|
|
In particuar, the hook will not be called for your application's |
219
|
|
|
|
|
|
|
C. For that, you still use C. |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
If you want to have a method run for every run mode I the |
222
|
|
|
|
|
|
|
C, then you can call the hook directly from |
223
|
|
|
|
|
|
|
C. |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
sub setup { |
226
|
|
|
|
|
|
|
my $self = shift; |
227
|
|
|
|
|
|
|
$self->add_callback('forward_prerun' => \&prepare_rm_stuff); |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
sub cgiapp_prerun { |
230
|
|
|
|
|
|
|
my $self = shift; |
231
|
|
|
|
|
|
|
$self->prepare_rm_stuff; |
232
|
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
sub prepare_rm_stuff { |
235
|
|
|
|
|
|
|
my $self = shift; |
236
|
|
|
|
|
|
|
# do any necessary prep work here.... |
237
|
|
|
|
|
|
|
} |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
Alternately, you can hook C to the C |
240
|
|
|
|
|
|
|
hook: |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
sub setup { |
243
|
|
|
|
|
|
|
my $self = shift; |
244
|
|
|
|
|
|
|
$self->add_callback('forward_prerun' => \&cgiapp_prerun); |
245
|
|
|
|
|
|
|
} |
246
|
|
|
|
|
|
|
sub cgiapp_prerun { |
247
|
|
|
|
|
|
|
my $self = shift; |
248
|
|
|
|
|
|
|
# do any necessary prep work here.... |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
This is a less flexible solution, since certain things that can be done |
252
|
|
|
|
|
|
|
in C (like setting C) won't work when the |
253
|
|
|
|
|
|
|
method is called from the C hook. |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
=head1 AUTHOR |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
Michael Graham, C<< >> |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
=head1 BUGS |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
Please report any bugs or feature requests to |
262
|
|
|
|
|
|
|
C, or through the web interface at |
263
|
|
|
|
|
|
|
L. I will be notified, and then you'll automatically |
264
|
|
|
|
|
|
|
be notified of progress on your bug as I make changes. |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
Thanks to Mark Stosberg for the idea and...well...the implementation as |
269
|
|
|
|
|
|
|
well. |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
Copyright 2005 Michael Graham, All Rights Reserved. |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
276
|
|
|
|
|
|
|
under the same terms as Perl itself. |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
=cut |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
1; # End of CGI::Application::Plugin::Forward |