Mungo.pm

Revision 82, 15.8 kB (checked in by clinton, 3 years ago)
Document Buffer feature, tid10737 tid10892
Property svn:keywords set to `Revision`

Line
1	package Mungo;
2
3	=head1 NAME
4
5	Mungo - An Apache::ASP inspired lightweight ASP framework
6
7	=head1 SYNOPSIS
8
9	# In your httpd.conf:
10	<FilesMatch "\.asp$">
11	SetHandler perl-script
12
13	PerlHandler Mungo
14
15	# This is optional, see PREAMBLE SUPPORT below
16	PerlSetVar MungoPreamble My::PreambleHandler
17
18	# Optionally enable output buffering
19	# see Mungo::Response - OUTPUT BUFFERING section
20	PerlSetVar MungoBuffer 1
21
22	</FilesMatch>
23
24	# In asp pages:
25	<html>
26	<%= 1 + 1; %><!-- Output: 2 -->
27	<% 1 + 1; %><!-- No Output -->
28
29	<!-- Variable scope extends across tags -->
30	<% my $pet = 'pony'; %>
31	<%= $pet %><!-- you get a pony! -->
32
33	<!-- Can embed control structures into pages -->
34	<% if ($prefer_daisies) { %>
35	<h2>Here are your daisies!</h2>
36	<% } else { %>
37	<h2>Brown-Eyed Susans, Just For You!</h2>
38	<% } %>
39
40	<!-- For, foreach, while loops, too -->
41	<% foreach my $beer_num (0..99) { %>
42	<p><%= 99 - $beer_num %> bottles of beer on the wall</p>
43	<% } %>
44
45	<%
46	# Write arbitrary amounts of Perl here
47
48	# you can use modules
49	# (just don't define subroutines or change packages)
50	use Some::Module;
51
52	# Access info about the request
53	# TODO - DOCS
54	# $Request->
55
56	# Access info about the server
57	# TODO - DOCS
58	# $Server->
59
60
61	# Redirect to somewhere else...
62	if ($want_to_redirect) {
63	$Response->Redirect($url);
64	# Never reach here
65	}
66
67	# Abort further processing and close outout stream
68	if ($want_to_end) {
69	$Response->End;
70	# Never reach here
71	}
72	%>
73
74	<!-- Can also include other pages or fragments -->
75	<% $Response->Include($filesystem_path); %>
76
77	<!-- may also include args -->
78	<% $Response->Include($filesystem_path, @args); %>
79
80	<!-- If args are passed to an ASP page (or page fragment) access them via @_ -->
81	<%
82	# In included file
83	my $arg1 = shift;
84	%>
85
86	<!-- What if you want to grab that output instead of sending to the browser? -->
87	<% my $output = $Response->TrapInclude($filesystem_path, @args); %>
88
89	<!-- You can also send a string of ASP code instead of using a file -->
90	<%
91	# Use a scalar reference!
92	$Response->Include(\$asp, @args);
93	%>
94
95	<!-- Cookie facilities -->
96	<%
97	# Read cookie
98	$single_value = $Request->Cookies($cookie_name);
99	$hashref = $Request->Cookies($cookie_name);
100
101	# Set cookie
102	$Response->Cookies($cookie_name, $single_value);
103	$Response->Cookies($cookie_name, $hash_ref);
104	%>
105
106	</html>
107
108
109	=head1 DESCRIPTION
110
111	=head2 What is Mungo?
112
113	Mungo is a mod_perl 1 or 2 PerlHandler module. It allows you to
114	embed Perl code directly into HTML files, using <% %> tags.
115
116	Mungo also provides Request and Response objects, similar to many ASP
117	environments. These facilities are aimed at applications needing simple,
118	lightweight features.
119
120	=head2 What Mungo does:
121
122	=over 4
123
124	=item *
125
126	Allows perl to be embedded in web pages with <% %> tags.
127
128	=item *
129
130	Provides simplistic access to various aspects of the client request via a Mungo::Request object.
131
132	=item *
133
134	Provides simplistic manipulation of the response via a Mungo::Response object.
135
136	=item *
137
138	Handles query strings, post forms (urlencoded and multipart) as well as cookies.
139
140	=back
141
142	=head2 What Mungo does not do:
143
144	=over 4
145
146	=item *
147
148	Manage sessions
149
150	=item *
151
152	XML/XSLT/etc
153
154	=back
155
156	=head2 Implementation Goals
157
158	Mungo was originally developed as a simpler, non-GPL'd Apache::ASP with far
159	fewer CPAN dependencies. It is somewhat compatible with Apache::ASP, but
160	there are enough differences to warrant close attention to the docs here.
161
162	While Mungo is very simple and has a very small fetureset, the object APIs it
163	does implement adhere closely to those present in Apache::ASP. So, assuming you
164	are not using sessions or the XML features, you should find few obstacles
165	in making your application run under Mungo (it could be as simple as
166	setting PerlHandler Mungo in your httpd.conf file).
167
168
169	=head2 Preamble Support
170
171	In addition to normal Apache stacked handlers, Mungo also supports a
172	mechanism for inserting code to execute before every Mungo request is
173	processed, while still having access to the Mungo environment.
174
175	To use this mechanism, define a Perl module as follows:
176
177	package My::PreambleHandler;
178	use strict;
179	use warnings;
180
181	use Apache2::Const qw ( OK DECLINED ); # Others as needed by your code
182
183	sub handler {
184	my $class = shift;
185	my $apache_request = shift;
186	my $mungo_request = shift;
187	my $mungo_response = shift;
188	my $mungo_server = shift;
189
190	# Determine what to do with the request, if anything
191
192	if ( ... ) {
193	# Continue normal Mungo processing
194	return Apache2::Const::DECLINED;
195
196	} elsif ( ... ) {
197	# If handled entirely within the preamble, skip further Mungo work
198	return Apache2::Const::OK;
199
200	} elsif ( ... ) {
201	# Returning anything other than DECLINED will
202	# skip further Mungo work - but should be informative
203	# for example, if the user's credentials are bad...
204	return Apache2::Const::NOT_AUTHORIZED;
205	}
206
207	}
208
209	With your preamble code in hand, you may now register this code to run on a per-location, directory, or file basis:
210
211	<Location /restricted>
212	SetHandler perl-script
213	PerlSetVar MungoPreamble My::AuthorizationCheckingPreamble
214	PerlHandler Mungo
215	</location>
216
217	=head3 Limitations of Preambles
218
219	=over
220
221	=item Limit of one Preamble per location/file/directory stanza
222
223	If you require more flexibility, Apache stacked handlers are likely a better solution for you (though you will not have the Mungo environment setup in your stacked handler).
224
225	=item Preambles Modules will not be automatically loaded
226
227	You can add a PerlRequire directive to httpd.conf, or 'use' your preamble class in your startup.pl
228
229	=back
230
231	=cut
232
233
234
235	#=============================================================================#
236	# Implementation Notes
237	#=============================================================================#
238	# - public methods are CamelCase
239	#
240	#=============================================================================#
241
242	use strict;
243	use IO::File;
244	eval "
245	use Apache2::RequestRec;
246	use Apache2::RequestUtil;
247	use Apache2::Const qw ( OK NOT_FOUND DECLINED );
248	";
249	if($@) {
250	print STDERR "mod_perl2 not found: $@";
251	eval "
252	use Apache;
253	use Apache::Constants qw( OK NOT_FOUND );
254	";
255	die $@ if $@;
256	}
257	use MIME::Base64 qw/encode_base64 decode_base64/;
258	use Data::Dumper;
259	use Digest::MD5 qw/md5_hex/;
260	use Mungo::Request;
261	use Mungo::Response;
262	use Mungo::Error;
263	use HTML::Entities;
264	use Encode;
265
266	use vars qw/$VERSION
267	$DEFAULT_POST_BLOCK_SIZE $DEFAULT_POST_MAX_SIZE
268	$DEFAULT_POST_MAX_PART $DEFAULT_POST_MAX_IN_MEMORY/;
269
270	my $SVN_VERSION = 0;
271	$SVN_VERSION = $1 if(q$Revision$ =~ /(\d+)/);
272	$VERSION = "1.0.0.${SVN_VERSION}";
273
274	$DEFAULT_POST_BLOCK_SIZE = 1024*32; # 32k
275	$DEFAULT_POST_MAX_SIZE = 0; # unlimited post size
276	$DEFAULT_POST_MAX_PART = 0; # and part size
277	$DEFAULT_POST_MAX_IN_MEMORY = 1024*128; # 128k
278
279	=head1 MODPERL HANDLER
280
281	PerlHandler Mungo
282
283	When Mungo is the registered handler for a URL, it first locates the file (if
284	not found, apache's 404 response mechanism is triggered). Global objects
285	describing the transaction are created: $Request, $Server, and $Response
286	(see Mungo::Response, etc. for details) Next, the file is parsed and
287	evaluated, and the results are sent to the browser. This happens using $Request->Include().
288
289	=cut
290
291	sub handler($$) {
292	my ($self, $r) = @_;
293	if (ref $self eq 'Apache2::RequestRec') {
294	$r = $self;
295	$self = __PACKAGE__;
296	}
297	my $preamble_class = $r->dir_config('MungoPreamble');
298	# Short circuit if we can't find the file.
299	return NOT_FOUND() if(! -r $r->filename);
300
301	$self = $self->new($r) unless(ref $self);
302	$self->Response()->start();
303	local $SIG{__DIE__} = \&Mungo::wrapErrorsInObjects;
304	eval {
305	my $doit = Apache2::Const::DECLINED();
306	$main::Request = $self->Request();
307	$main::Response = $self->Response();
308	$main::Server = $self->Server();
309	if($preamble_class) {
310	$doit = $preamble_class->handler($r, $self->Request(),
311	$self->Response(), $self->Server());
312	}
313	$self->Response()->Include($r->filename)
314	if($doit == Apache2::Const::DECLINED());
315	};
316	if($@) {
317	# print out the error to the logs
318	print STDERR $@ if($@);
319	# If it isn't too late, make this an internal server error
320	eval { $self->Response()->{Status} = 500; };
321	}
322
323	# gotos come here from:
324	# $Response->End()
325	MUNGO_HANDLER_FINISH:
326	$self->Response()->finish();
327
328	$self->cleanse();
329	undef $main::Request;
330	undef $main::Response;
331	undef $main::Server;
332	undef $self;
333	return &OK;
334	}
335
336
337	sub wrapErrorsInObjects {
338	my $i = 0;
339	my @callstack;
340	while(my @callinfo = caller($i++)) {
341	push @callstack, \@callinfo;
342	}
343	die Mungo::Error->new({ error => shift, callstack => \@callstack });
344	}
345
346	=for private_developer_docs
347
348	=head2 $mungo = Mungo->new($req);
349
350	Given an Apache2::RequestRec or Apache request object,
351	return the Mungo context, which is a Singleton.
352
353	Called from the modperl handler.
354
355	=cut
356
357	sub new {
358	my ($class, $r) = @_;
359	my $self = $r->pnotes(__PACKAGE__);
360	return $self if($self);
361	$self = bless {
362	'Apache::Request' => $r,
363	}, $class;
364	$r->pnotes(__PACKAGE__, $self);
365	return $self;
366	}
367
368	sub DESTROY { }
369
370	=for private_developer_docs
371
372	=head2 $mungo->cleanse();
373
374	Releases resources at the end of a request.
375
376	=cut
377
378	sub cleanse {
379	my $self = shift;
380	$self->Response()->cleanse();
381	$self->Request()->cleanse();
382	delete $self->{'Apache::Request'};
383	}
384
385	# Axiomatic "I am myself"
386	sub Server { return $_[0]; }
387	sub Request { return Mungo::Request->new($_[0]); }
388	sub Response { return Mungo::Response->new($_[0]); }
389
390	=head2 $encoded = $mungo->URLEncode($string);
391
392	=head2 $encoded = Mungo->URLEncode($string);
393
394	Encodes a string to escape characters that are not permitted in a URL.
395
396	=cut
397
398	sub URLEncode {
399	my $self = shift;
400	my $s = shift;
401	$s =~ s/([^a-zA-Z0-9])/sprintf("%%%02x", ord($1))/eg;
402	return $s;
403	}
404
405	=head2 $string = $mungo->URLDecode($encoded);
406
407	=head2 $string = Mungo->URLDecode($encoded);
408
409	Decodes a string to unescape characters that are not permitted in a URL.
410
411	=cut
412
413	sub URLDecode {
414	my $self = shift;
415	my $s = shift;
416	$s =~ s/%([a-fA-F0-9]{2})/chr(hex($1))/eg;
417	return $s;
418	}
419	sub HTMLEncode {
420	my $self = shift;
421	my $s = shift;
422	return HTML::Entities::encode_entities( $s );
423	}
424	sub HTMLDecode {
425	my $self = shift;
426	my $s = shift;
427	return HTML::Entities::decode_entities( $s );
428	}
429
430
431	# Private?
432	sub demangle_name {
433	my $self = shift;
434	my $name = shift;
435	if($name =~ /Mungo::FilePage::([^:]+)::__content/) {
436	my $filename = decode_base64($1);
437	my $r = $self->{'Apache::Request'};
438	if(UNIVERSAL::can($r, 'document_root')) {
439	my $base = $r->document_root();
440	$filename =~ s/^$base//;
441	}
442	$name = "Mungo::FilePage($filename)";
443	}
444	elsif($name =~ /Mungo::MemPage::([^:]+)::__content/) {
445	$name = 'Mungo::MemPage(ANON)';
446	}
447	return $name;
448	}
449
450	# Private?
451	sub filename2packagename {
452	my ($self, $filename) = @_;
453	my $type = ref $self;
454	$type =~ s/::(?:File\|Mem)Page::[^:]+$//;
455	my $pkg = $type . "::FilePage::" . encode_base64($filename);
456	$pkg =~ s/(\s\|=*$)//gs;
457	return $pkg;
458	}
459	sub contents2packagename {
460	my($self, $contents) = @_;
461	my $type = ref $self;
462	$type =~ s/::(?:File\|Mem)Page::[^:]+$//;
463	return $type . "::MemPage::" . md5_hex( encode_utf8($$contents) );
464	}
465
466
467	# $output = $mungo->include_mem(
468	#
469	sub include_mem {
470	my $self = shift;
471	my $contents = shift;
472	my $pkg = $self->contents2packagename($contents);
473
474	unless(UNIVERSAL::can($pkg, 'content')) {
475	return unless $self->packagize($pkg, $contents);
476	# The packagize was successful, make content do __content
477	eval "*".$pkg."::content = \\&".$pkg."::__content;";
478	}
479	my %copy = %$self;
480	my $page = bless \%copy, $pkg;
481	$page->content(@_);
482	}
483	# Private?
484	sub include_file {
485	my $self = shift;
486	my $filename = shift;
487	if($filename !~ /^\//) {
488	my $dir = $self->{'Apache::Request'}->filename;
489	$dir =~ s/[^\/]+$//;
490	$filename = "$dir$filename";
491	}
492	my $pkg = $self->filename2packagename($filename);
493	my ($inode, $mtime);
494	if($self->{'Apache::Request'}->dir_config('StatINC')) {
495	($inode, $mtime) = (stat($filename))[1,9];
496	}
497	unless(UNIVERSAL::can($pkg, 'content') &&
498	$inode == eval "\$${pkg}::Mungo_inode" &&
499	$mtime == eval "\$${pkg}::Mungo_mtime") {
500	my $contents;
501	my $ifile = IO::File->new("<$filename");
502	die "$!: $filename" unless $ifile;
503	{
504	local $/ = undef;
505	$contents = <$ifile>;
506	}
507	return unless $self->packagize($pkg, \$contents, $filename);
508	# The packagize was successful, make content do __content
509	eval "*${pkg}::content = \\&${pkg}::__content";
510	# Track what we just compiled
511	eval "\$${pkg}::Mungo_inode = $inode";
512	eval "\$${pkg}::Mungo_mtime = $mtime";
513	}
514	my %copy = %$self;
515	my $page = bless \%copy, $pkg;
516	$page->content(@_);
517	}
518	# Private?
519	sub packagize {
520	my $self = shift;
521	my $pkg = shift;
522	my $contents = shift;
523	my $filename_hint = shift \|\| '(unknown location)';
524	my $expr = convertStringToExpression($contents);
525	my $type = ref $self;
526	$type =~ s/::(?:File\|Mem)Page::[^:]+$//;
527
528	# We build a package with a __content method. Why?
529	# If this fails miserably, there is still a possibility that
530	# UNIVERSAL::can($pkg, 'content') will be true, so we make __content
531	# and if it all works out, we *$pkg::content = \&$pkg::__content
532
533	my $preamble = "package $pkg;" . q^
534	use vars qw/@ISA $Mungo_inode $Mungo_mtime/;
535	@ISA = qw/^. $type . q^/;
536	sub __content {
537	my $self = shift;
538	my $Request = $self->Request();
539	my $Response = $self->Response();
540	my $Server = $self->Server();
541	^;
542	my $postamble = q^
543	}
544	1;
545	^;
546
547	# Set these before we attempt to compile so that if there is an error,
548	# we can get access to the code from somewhere else.
549	eval "\$${pkg}::Mungo_preamble = \$preamble;";
550	eval "\$${pkg}::Mungo_postamble = \$postamble;";
551	eval "\$${pkg}::Mungo_contents = \$contents;";
552
553	eval $preamble . $expr . $postamble;
554	if($@) {
555	my $error = $@;
556	if(ref $error ne 'HASH') {
557	my $i = 0;
558	my @callstack;
559	while(my @callinfo = caller($i++)) {
560	push @callstack, \@callinfo;
561	}
562	$error = { error => $error, callstack => \@callstack };
563	}
564	my ($line) = ($error->{error} =~ /line (\d+)/m);
565	unshift @{$error->{callstack}},
566	[
567	$pkg, $filename_hint, $line, '(ASP include)'
568	];
569	local $SIG{__DIE__} = undef;
570	die $error;
571	}
572	return 1;
573	}
574
575
576	sub convertStringToExpression {
577	my $string_ref = shift;
578	my $string = $$string_ref;
579	sub __string_as_i18n {
580	return '' unless(length($_[0]));
581	my $s = Dumper($_[0]);
582	substr($s, 0, 7) = '<%= $main::Response->i18n(';
583	substr($s, -2, 2) = ') %>';
584	return $s;
585	}
586	sub __string_as_print {
587	return '' unless(length($_[0]));
588	my $s = Dumper($_[0]);
589	substr($s, 0, 7) = 'print';
590	return $s;
591	}
592	$string =~ s/I\[\[(.*?)\]\]/__string_as_i18n($1)/seg;
593	$string =~ s/^(.*?)(?=<%\|$)/__string_as_print($1)/se;
594	# Replace non-code
595	$string =~ s/(?<=%>)(?!<%)(.*?)(?=<%\|$)/__string_as_print($1)/seg;
596	# fixup code
597	$string =~ s/
598	<%(=?)(.*?)%>
599	/
600	$1 ?
601	"print $2;" : # This is <%= ... %>
602	"$2;" # This is <% ... %>
603	/sexg;
604	return $string;
605	}
606
607	=head1 LIMITATIONS/BUGS
608
609	=over 4
610
611	=item *
612
613	Cannot define subroutines in ASP pages. Bad things will happen.
614
615	=item *
616
617	Documentation is spotty. This is being worked on.
618
619	=back
620
621	=head1 LICENSE INFORMATION
622
623	Copyright (c) 2007 OmniTI Computer Consulting, Inc. All rights reserved.
624	For information on licensing see:
625
626	https://labs.omniti.com/mungo/trunk/LICENSE
627
628	=head1 PROJECT WEBSITE
629
630	https://labs.omniti.com/trac/mungo/
631
632	=head1 AUTHOR
633
634	Theo Schlossnagle (code)
635
636	Clinton Wolfe (docs)
637
638	=cut
639
640
641	1;

Note: See TracBrowser for help on using the browser.

root/trunk/lib/Mungo.pm

Download in other formats: