line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package MojoX::Plugin::PHP; |
2
|
1
|
|
|
1
|
|
22146
|
use Mojo::Base 'Mojolicious::Plugin'; |
|
1
|
|
|
|
|
11020
|
|
|
1
|
|
|
|
|
5
|
|
3
|
|
|
|
|
|
|
|
4
|
1
|
|
|
1
|
|
1710
|
use MojoX::Template::PHP; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
use Mojo::Util qw(encode md5_sum); |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
use Data::Dumper; |
8
|
|
|
|
|
|
|
$Data::Dumper::Indent = 1; |
9
|
|
|
|
|
|
|
$Data::Dumper::Sortkeys = 1; |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
our $VERSION = '0.05'; |
12
|
|
|
|
|
|
|
my $php_req_handler_path = sprintf "/php-handler-%07x", 0x10000000 * rand(); |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
sub register { |
15
|
|
|
|
|
|
|
my ($self, $app, $config) = @_; |
16
|
|
|
|
|
|
|
$app->config( 'MojoX::Template::PHP' => $config, |
17
|
|
|
|
|
|
|
'MojoX::Plugin::PHP' => $config ); |
18
|
|
|
|
|
|
|
$app->types->type( php => "application/x-php" ); |
19
|
|
|
|
|
|
|
$app->renderer->add_handler( php => \&_php ); |
20
|
|
|
|
|
|
|
$app->routes->any( $php_req_handler_path, \&_php_controller ); |
21
|
|
|
|
|
|
|
$app->hook( before_dispatch => \&_before_dispatch_hook ); |
22
|
|
|
|
|
|
|
} |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
sub _rewrite_req_for_php_handler { |
25
|
|
|
|
|
|
|
my ($c, $path_to_restore, $path_to_request) = @_; |
26
|
|
|
|
|
|
|
$c->req->{__old_path} = $path_to_restore; |
27
|
|
|
|
|
|
|
$c->req->{__php_restore} = { path => $path_to_restore, |
28
|
|
|
|
|
|
|
template => $path_to_request }; |
29
|
|
|
|
|
|
|
$c->req->url->path( $php_req_handler_path ); |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
sub _path_contains_index_php { |
33
|
|
|
|
|
|
|
my ($path, $c) = @_; |
34
|
|
|
|
|
|
|
my $app = $c->app; |
35
|
|
|
|
|
|
|
foreach my $dir (@{$app->renderer->paths}, @{$app->static->paths}) { |
36
|
|
|
|
|
|
|
my $file = catfile( split('/', $dir), split('/',$path), 'index.php' ); |
37
|
|
|
|
|
|
|
if (-r $file) { |
38
|
|
|
|
|
|
|
return $file; |
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
return; |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
sub _before_dispatch_hook { |
45
|
|
|
|
|
|
|
my $c = shift; |
46
|
|
|
|
|
|
|
my $old_path = $c->req->url->path->to_string; |
47
|
|
|
|
|
|
|
if ($old_path =~ /\.php$/) { |
48
|
|
|
|
|
|
|
_rewrite_req_for_php_handler( $c, $old_path, substr($old_path,1) ); |
49
|
|
|
|
|
|
|
} else { |
50
|
|
|
|
|
|
|
my $use_index_php = |
51
|
|
|
|
|
|
|
$c->app->config->{'MojoX::Plugin::PHP'}{use_index_php}; |
52
|
|
|
|
|
|
|
if ($old_path =~ m{/$}) { |
53
|
|
|
|
|
|
|
if (defined $use_index_php && |
54
|
|
|
|
|
|
|
_path_contains_index_php($old_path,$c)) { |
55
|
|
|
|
|
|
|
_rewrite_req_for_php_handler($c, $old_path, |
56
|
|
|
|
|
|
|
substr($old_path,1).'index.php'); |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
} elsif ($use_index_php && _path_contains_index_php($old_path,$c)) { |
59
|
|
|
|
|
|
|
_rewrite_req_for_php_handler($c,$old_path, |
60
|
|
|
|
|
|
|
substr($old_path,1).'/index.php'); |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
sub _php_controller { |
66
|
|
|
|
|
|
|
my $self = shift; |
67
|
|
|
|
|
|
|
$self->req->url->path( $self->req->{__php_restore}{path} ); |
68
|
|
|
|
|
|
|
my $template = $self->req->{__php_restore}{template}; |
69
|
|
|
|
|
|
|
$self->render( template => $template, handler => 'php' ); |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
sub _template_path { |
73
|
|
|
|
|
|
|
use File::Spec::Functions 'catfile'; |
74
|
|
|
|
|
|
|
my ($renderer, $c, $options) = @_; |
75
|
|
|
|
|
|
|
my $name = $options->{template}; |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
foreach my $path (@{$renderer->paths}, @{$c->app->static->paths}) { |
78
|
|
|
|
|
|
|
my $file = catfile($path, split '/', $name); |
79
|
|
|
|
|
|
|
if (-r $file) { |
80
|
|
|
|
|
|
|
my @d = split '/', $file; |
81
|
|
|
|
|
|
|
pop @d; |
82
|
|
|
|
|
|
|
$c->stash( '__template_dir', join("/", @d) ); |
83
|
|
|
|
|
|
|
return $file; |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
my @d = split '/', $renderer->paths->[0]; |
87
|
|
|
|
|
|
|
pop @d; |
88
|
|
|
|
|
|
|
$c->stash( '__template_dir', join("/", @d) ); |
89
|
|
|
|
|
|
|
return catfile( $renderer->paths->[0], split '/', $name ); |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
sub _template_name { |
93
|
|
|
|
|
|
|
my ($renderer, $c, $options) = @_; |
94
|
|
|
|
|
|
|
my $name = $options->{template}; |
95
|
|
|
|
|
|
|
return $name; |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
sub _php { |
99
|
|
|
|
|
|
|
my ($renderer, $c, $output, $options) = @_; |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
# the PHP script should declare its own encoding in a Content-type header |
102
|
|
|
|
|
|
|
delete $options->{encoding}; |
103
|
|
|
|
|
|
|
my $inline = $options->{inline}; |
104
|
|
|
|
|
|
|
my $path = _template_path($renderer, $c, $options); |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
$path = md5_sum encode('UTF-8', $inline) if defined $inline; |
107
|
|
|
|
|
|
|
return undef unless defined $path; |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
my $mt = MojoX::Template::PHP->new; |
110
|
|
|
|
|
|
|
my $log = $c->app->log; |
111
|
|
|
|
|
|
|
if (defined $inline) { |
112
|
|
|
|
|
|
|
$log->debug('Rendering inline template.'); |
113
|
|
|
|
|
|
|
$$output = $mt->name('inline template')->render($inline, $c); |
114
|
|
|
|
|
|
|
} else { |
115
|
|
|
|
|
|
|
$mt->encoding( $renderer->encoding ) if $renderer->encoding; |
116
|
|
|
|
|
|
|
return undef unless my $t = _template_name($renderer, $c, $options); |
117
|
|
|
|
|
|
|
$mt->template($t); |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
if (-r $path) { |
120
|
|
|
|
|
|
|
use File::Tools qw(pushd popd); |
121
|
|
|
|
|
|
|
my $php_dir = $c->stash('__template_dir') || "."; |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
# XXX - need more consistent way of setting the include path |
124
|
|
|
|
|
|
|
$c->stash("__php_include_path", |
125
|
|
|
|
|
|
|
".:/usr/local/lib/php:$php_dir"); |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
pushd($php_dir); |
128
|
|
|
|
|
|
|
$log->debug("chdir to: $php_dir"); |
129
|
|
|
|
|
|
|
$log->debug( "Rendering template '$t'." ); |
130
|
|
|
|
|
|
|
$$output = $mt->name("template '$t'")->render_file($path,$c); |
131
|
|
|
|
|
|
|
popd(); |
132
|
|
|
|
|
|
|
$c->stash("__template_dir", undef); |
133
|
|
|
|
|
|
|
} elsif (my $d = $renderer->get_data_template($options)) { |
134
|
|
|
|
|
|
|
$log->debug( "Rendering template '$t' from DATA section" ); |
135
|
|
|
|
|
|
|
$$output = $mt->name("template '$t' from DATA section") |
136
|
|
|
|
|
|
|
->render($d,$c); |
137
|
|
|
|
|
|
|
} else { |
138
|
|
|
|
|
|
|
$log->debug("template '$t' not found."); |
139
|
|
|
|
|
|
|
return undef; |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
return ref $$output ? die $$output : 1; |
143
|
|
|
|
|
|
|
} |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
1; |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
=encoding UTF8 |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
=head1 NAME |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
MojoX::Plugin::PHP - use PHP as a templating system in Mojolicious |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
=head1 VERSION |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
0.05 |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
=head1 WTF |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
Keep reading. |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
=head1 SYNOPSIS |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
# MyApp.pl, using Mojolicious |
164
|
|
|
|
|
|
|
app->plugin('MojoX::Plugin::PHP'); |
165
|
|
|
|
|
|
|
app->plugin('MojoX::Plugin::PHP', { |
166
|
|
|
|
|
|
|
php_var_preprocessor => sub { my $params = shift; ... }, |
167
|
|
|
|
|
|
|
php_stderr_preprocessor => sub { my $msg = shift; ... }, |
168
|
|
|
|
|
|
|
php_header_processor => sub { my ($field,$value,$repl) = @_; ... }, |
169
|
|
|
|
|
|
|
php_output_processor => sub { my ($outref, $headers, $c) = @_; ... } |
170
|
|
|
|
|
|
|
} ); |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
# using Mojolicious::Lite |
173
|
|
|
|
|
|
|
plugin 'MojoX::Plugin::PHP'; |
174
|
|
|
|
|
|
|
plugin 'MojoX::Plugin::PHP', { |
175
|
|
|
|
|
|
|
php_var_preprocessor => sub { my $params = shift; ... }, |
176
|
|
|
|
|
|
|
php_stderr_preprocessor => sub { my $msg = shift; ... }, |
177
|
|
|
|
|
|
|
php_header_processor => sub { my ($field,$value,$repl) = @_; ... }, |
178
|
|
|
|
|
|
|
php_output_processor => sub { my ($outref, $headers, $c) = @_; ... } |
179
|
|
|
|
|
|
|
}; |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
=head1 DESCRIPTION |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
L establishes a PHP engine as the default |
186
|
|
|
|
|
|
|
handler for C files and templates in a Mojolicious application. |
187
|
|
|
|
|
|
|
This allows you to put |
188
|
|
|
|
|
|
|
a PHP template (say, called C under your Mojolicious |
189
|
|
|
|
|
|
|
application's C or C directory, make a |
190
|
|
|
|
|
|
|
request to |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
/foo/bar.php |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
and have a PHP interpreter process your file, and Mojolicious |
195
|
|
|
|
|
|
|
return a response as if it the request were processed in |
196
|
|
|
|
|
|
|
Apache with mod_php. |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
Why would anyone want to do this? Here are a couple of reasons I |
199
|
|
|
|
|
|
|
can think of: |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
=over 4 |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
=item * to put a Mojolicious wrapper around some decent PHP |
204
|
|
|
|
|
|
|
application (WordPress?). Then you could use Perl and any |
205
|
|
|
|
|
|
|
other state of your Mojolicious application to post process |
206
|
|
|
|
|
|
|
output and response headers. |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
=item * allow PHP developers on your project to keep |
209
|
|
|
|
|
|
|
prototyping in PHP, postponing the religious war about |
210
|
|
|
|
|
|
|
which appserver your project should use |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
=back |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
=head1 CONFIG |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
=over 4 |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
=item use_index_php |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
use_index_php => boolean | undef |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
Describes how the before_dispatch hook should handle requests |
223
|
|
|
|
|
|
|
for a path that contains a file called C. |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
If C is set to a defined value, then a request like |
226
|
|
|
|
|
|
|
C (with a trailing slash) will be routed to |
227
|
|
|
|
|
|
|
C if C would resolve to a valid |
228
|
|
|
|
|
|
|
PHP template. |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
If C is set to a true value, then a request like |
231
|
|
|
|
|
|
|
C (with or without a trailing slash) will be routed to |
232
|
|
|
|
|
|
|
C if C would resolve to a valid |
233
|
|
|
|
|
|
|
PHP template. |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
If C is not defined or set to C, then |
236
|
|
|
|
|
|
|
this module will not look for an C file related |
237
|
|
|
|
|
|
|
to any request. |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
=back |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
=head2 Callbacks during PHP processing |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
There are four hooks in the PHP template processing engine |
244
|
|
|
|
|
|
|
(L) where you can customize or extend |
245
|
|
|
|
|
|
|
the behavior of the PHP engine. In the plugin configuration, |
246
|
|
|
|
|
|
|
you can specify the code that should be run off each of these |
247
|
|
|
|
|
|
|
hooks. All of these configuration are optional. |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
=over 4 |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
=item php_var_preprocessor |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
php_var_preprocessor => sub { my $params = shift; ... } |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
L gathers several variables from Perl |
256
|
|
|
|
|
|
|
and sets them as global variables in the PHP environment. These |
257
|
|
|
|
|
|
|
include the standard C<$_GET>, C<$_POST>, C<$_REQUEST>, |
258
|
|
|
|
|
|
|
C<$_SERVER>, C<$_ENV>, C<$_COOKIE>, and C<$_FILES> variables, |
259
|
|
|
|
|
|
|
but also includes most of the stash variables. All of these |
260
|
|
|
|
|
|
|
variable values are gathered into a single hash reference. |
261
|
|
|
|
|
|
|
Right before all of the variables are assigned in PHP, the |
262
|
|
|
|
|
|
|
PHP engine will look for a C setting, |
263
|
|
|
|
|
|
|
and will invoke its code, passing that hash reference as an |
264
|
|
|
|
|
|
|
argument. In this callback, you can add, remove, or edit |
265
|
|
|
|
|
|
|
the set of variables that will be initialized in PHP. |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
=item php_stderr_processor |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
php_stderr_processor => sub { my $msg = shift; ... } |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
When the PHP interpreter writes a message to its standard error |
272
|
|
|
|
|
|
|
stream, a callback specified by the C |
273
|
|
|
|
|
|
|
config setting can be called with the text that PHP was trying |
274
|
|
|
|
|
|
|
to write to that stream. You can use this callback to log |
275
|
|
|
|
|
|
|
warnings and errors from PHP. |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
=item php_header_processor |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
php_header_processor => sub { |
280
|
|
|
|
|
|
|
my ($field,$value,$replace) = @_; |
281
|
|
|
|
|
|
|
... |
282
|
|
|
|
|
|
|
return $keep_header; |
283
|
|
|
|
|
|
|
} |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
When the PHP C function is invoked in the PHP interpreter, |
286
|
|
|
|
|
|
|
a callback specified by the C config setting |
287
|
|
|
|
|
|
|
can be called with the name and value of the header. If this callback |
288
|
|
|
|
|
|
|
returns a true value (or if there is no callback), the header from |
289
|
|
|
|
|
|
|
PHP will be included in the Mojolicious response headers. |
290
|
|
|
|
|
|
|
If this callback returns a false value, the header will not be |
291
|
|
|
|
|
|
|
returned with the Mojolicious response. |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
One powerful use of the header callback is as a communication |
294
|
|
|
|
|
|
|
channel between PHP and Perl. For example, the header processor |
295
|
|
|
|
|
|
|
can look for a specific header field. When it sees this header, |
296
|
|
|
|
|
|
|
the value can be a JSON-encoded payload which can be processed |
297
|
|
|
|
|
|
|
in Perl. Perl can return the results of the processing through |
298
|
|
|
|
|
|
|
a global PHP variable (again, possibly JSON encoded). The |
299
|
|
|
|
|
|
|
C test case in this distribution has a |
300
|
|
|
|
|
|
|
proof-of-concept of this kind of use of the header callback. |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
=item php_output_postprocessor |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
php_output_postprocessor => sub { |
305
|
|
|
|
|
|
|
my ($output_ref, $headers, $c) = @_; |
306
|
|
|
|
|
|
|
... |
307
|
|
|
|
|
|
|
} |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
When the PHP engine has finished processing a PHP template, and |
310
|
|
|
|
|
|
|
a callback has been specified with the C |
311
|
|
|
|
|
|
|
config setting, then that callback will be invoked with a |
312
|
|
|
|
|
|
|
I to the PHP output, the set of headers returned |
313
|
|
|
|
|
|
|
by PHP (probably in a L object), and the current |
314
|
|
|
|
|
|
|
controller/context object. You can use this |
315
|
|
|
|
|
|
|
callback for postprocessing the output or the set of headers |
316
|
|
|
|
|
|
|
that will be included in the Mojolicious response. |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
One thing that you might want to do in the output post-processing |
319
|
|
|
|
|
|
|
is to look for a C header, and determine if you |
320
|
|
|
|
|
|
|
want the application to follow it. |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
=back |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
=head1 METHODS |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
=head2 register |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
$plugin->register(Mojolicious->new); |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
Register the php renderer in L application. |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
=head1 COMMUNICATION BETWEEN PERL AND PHP |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
As mentioned in the L<"php_header_processor" documentation in the |
335
|
|
|
|
|
|
|
CONFIG section above|"php_header_processor">, |
336
|
|
|
|
|
|
|
it is possible to use the header callback mechanism to execute |
337
|
|
|
|
|
|
|
arbitrary Perl code from PHP and to establish a communication channel |
338
|
|
|
|
|
|
|
between your PHP scripts and your Mojolicious application. |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
Let's demonstrate with a simple example: |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
The Collatz conjecture states that the following algorithm: |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
Take any natural number n . If n is even, divide it by 2. |
345
|
|
|
|
|
|
|
If n is odd, multiply it by 3 and add 1 so the result is 3n + 1 . |
346
|
|
|
|
|
|
|
Repeat the process until you reach the number 1. |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
will always terminate in a finite number of steps. |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
Suppose we are interested in finding out, for a given numner I, |
351
|
|
|
|
|
|
|
how many steps of this algorithm are required to reach the number 1. |
352
|
|
|
|
|
|
|
We'll make a request to a path like: |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
CI |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
and return the number of steps in the response. Our C |
357
|
|
|
|
|
|
|
template looks like: |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
$nsteps = 0; |
361
|
|
|
|
|
|
|
$n = $_GET['n']; |
362
|
|
|
|
|
|
|
while ($n > 1) { |
363
|
|
|
|
|
|
|
if ($n % 2 == 0) { |
364
|
|
|
|
|
|
|
$n = divide_by_two($n); |
365
|
|
|
|
|
|
|
} else { |
366
|
|
|
|
|
|
|
$n = triple_plus_one($n); |
367
|
|
|
|
|
|
|
} |
368
|
|
|
|
|
|
|
$nsteps++; |
369
|
|
|
|
|
|
|
} |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
function divide_by_two($x) { |
372
|
|
|
|
|
|
|
return $x / 2; |
373
|
|
|
|
|
|
|
} |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
function triple_plus_one($x) { |
376
|
|
|
|
|
|
|
... |
377
|
|
|
|
|
|
|
} |
378
|
|
|
|
|
|
|
?> |
379
|
|
|
|
|
|
|
number of Collatz steps is |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
and we will implement the C function in Perl. |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
=head2 Components of the communication channel |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
The configuration for C can specify a callback |
386
|
|
|
|
|
|
|
function that will be invoked when PHP sends a response header. |
387
|
|
|
|
|
|
|
To use this channel to perform work in PHP, we need |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
=over 4 |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
=item 1. a C header callback function that |
392
|
|
|
|
|
|
|
listens for a specific header |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
=item 2. PHP code to produce that header |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
=item 3. an agreed upon global PHP variable, that Perl code |
397
|
|
|
|
|
|
|
can set (with L<< the C function|"assign_global"/PHP >>) |
398
|
|
|
|
|
|
|
with the result of its operation, and that PHP can read |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
=back |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
=head2 Perl code |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
In the Mojolicious application, we intercept a header of the form |
405
|
|
|
|
|
|
|
C<< X-collatz: >>I where I is the JSON-encoding |
406
|
|
|
|
|
|
|
of a hash that defines C, the number to operate on, and |
407
|
|
|
|
|
|
|
C, the name of the PHP variable to publish the results to. |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
JSON-encoding the header value is a convenient way to pass |
410
|
|
|
|
|
|
|
complicated, arbitrary data from PHP to Perl, including binary |
411
|
|
|
|
|
|
|
data or strings with newlines. For complex results, it is also |
412
|
|
|
|
|
|
|
convenient to assign a JSON-encoded value to a single PHP global |
413
|
|
|
|
|
|
|
variable. |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
... |
416
|
|
|
|
|
|
|
use Mojo::JSON; |
417
|
|
|
|
|
|
|
... |
418
|
|
|
|
|
|
|
app->plugin('MojoX::Plugin::PHP', |
419
|
|
|
|
|
|
|
{ php_header_processor => \&my_header_processor }; |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
sub my_header_processor { |
422
|
|
|
|
|
|
|
my ($field,$value,$replace) = @_; |
423
|
|
|
|
|
|
|
if ($field eq 'X-collatz') { |
424
|
|
|
|
|
|
|
my $payload = Mojo::JSON::decode_json($value); |
425
|
|
|
|
|
|
|
my $n = $payload->{n}; |
426
|
|
|
|
|
|
|
my $result_var = $payload->{result}; |
427
|
|
|
|
|
|
|
$n = 3 * $n + 1; |
428
|
|
|
|
|
|
|
PHP::assign_global( $result_var, $n ); |
429
|
|
|
|
|
|
|
return 0; # don't include this header in response |
430
|
|
|
|
|
|
|
} |
431
|
|
|
|
|
|
|
return 1; # do include this header in response |
432
|
|
|
|
|
|
|
} |
433
|
|
|
|
|
|
|
... |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
=head2 PHP code |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
The PHP code merely has to set a response header that looks like |
438
|
|
|
|
|
|
|
C<< X-collatz: >>I where I is a JSON-encoded |
439
|
|
|
|
|
|
|
associative array with the number to operate on the variable to |
440
|
|
|
|
|
|
|
receive the results in. Then it must read the result out of that |
441
|
|
|
|
|
|
|
variable. |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
... |
444
|
|
|
|
|
|
|
function triple_plus_one($x) { |
445
|
|
|
|
|
|
|
global $collatz_result; |
446
|
|
|
|
|
|
|
$payload = encode_json( // requires php >=v5.2.0 |
447
|
|
|
|
|
|
|
array( "n" => $x, "result" => "collatz_result") |
448
|
|
|
|
|
|
|
); |
449
|
|
|
|
|
|
|
header("X-collatz: $payload"); |
450
|
|
|
|
|
|
|
return $collatz_result; |
451
|
|
|
|
|
|
|
} |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
Now we can not only run PHP scripts in Mojolicious, our PHP |
454
|
|
|
|
|
|
|
templates can execute code in Perl. |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
$ perl our_app.pl get /collatz.php?n=5 |
457
|
|
|
|
|
|
|
number of Collatz steps is 5 |
458
|
|
|
|
|
|
|
$ perl our_app.pl get /collatz.php?n=42 |
459
|
|
|
|
|
|
|
number of Collatz steps is 8 |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
=head2 Other possible uses |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
Other ways you might use this feature include: |
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
=over 4 |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
=item * have PHP execute functions or use modules that are hard to |
468
|
|
|
|
|
|
|
implement in Perl or only available in Perl |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
=item * have PHP manipulate data in your app's Perl model |
471
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
=item * perform authentication or other function in PHP that changes |
473
|
|
|
|
|
|
|
the state on the Perl side of your application |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
=back |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
=head1 SEE ALSO |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
L, L, |
480
|
|
|
|
|
|
|
L, |
481
|
|
|
|
|
|
|
L, L, L. |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
=head1 AUTHOR |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
Marty O'Brien Emob@cpan.orgE |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
=head1 COPYRIGHT |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
Copyright 2013-2015, Marty O'Brien. All rights reserved. |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify it |
492
|
|
|
|
|
|
|
under the terms of either: the GNU General Public License as published |
493
|
|
|
|
|
|
|
by the Free Sortware Foundation; or the Artistic License. |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
See http://dev.perl.org/licenses for more information. |
496
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
=cut |