root/trunk/lib/Mungo.pm

Revision 49, 13.3 kB (checked in by clinton, 5 years ago)

Improve error handling further, and declare Mungo::Quiet ready for rollout

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