root/trunk/lib/Mungo.pm

Revision 35, 13.2 kB (checked in by clinton, 6 years ago)

Updated docs to include Cookie docs

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
192 use vars qw/$VERSION
193             $DEFAULT_POST_BLOCK $DEFAULT_POST_MAX_SIZE
194             $DEFAULT_POST_MAX_PART $DEFAULT_POST_MAX_IN_MEMORY/;
195
196 my $SVN_VERSION = 0;
197 $SVN_VERSION = $1 if(q$LastChangedRevision: 301 $ =~ /(\d+)/);
198 $VERSION = "1.0.0.${SVN_VERSION}";
199
200 $DEFAULT_POST_BLOCK = 1024*32;          # 32k
201 $DEFAULT_POST_MAX_SIZE = 0;             # unlimited post size
202 $DEFAULT_POST_MAX_PART = 0;             # and part size
203 $DEFAULT_POST_MAX_IN_MEMORY = 1024*128; # 128k
204
205 =head1 MODPERL HANDLER
206
207   PerlHandler Mungo
208
209 When Mungo is the registered handler for a URL, it first locates the file (if
210 not found, apache's 404 response mechanism is triggered).  Global objects
211 describing the transaction are created: $Request, $Server, and $Response
212 (see Mungo::Response, etc. for details) Next, the file is parsed and
213 evaluated, and the results are sent to the browser. This happens using $Request->Include().
214
215 =cut
216
217 sub handler($$) {
218   my ($self, $r) = @_;
219   if (ref $self eq 'Apache2::RequestRec') {
220     $r = $self;
221     $self = __PACKAGE__;
222   }
223   # Short circuit if we can't find the file.
224   return NOT_FOUND() if(! -r $r->filename);
225
226   $self = $self->new($r) unless(ref $self);
227   $self->Response()->start();
228   $main::Request = $self->Request();
229   $main::Response = $self->Response();
230   $main::Server = $self->Server();
231   local $SIG{__DIE__} = \&Mungo::MungoDie;
232   eval {
233     $self->Response()->Include($r->filename);
234   };
235   if($@) {
236     # print out the error to the logs
237     print STDERR $@ if($@);
238     # If it isn't too late, make this an internal server error
239     eval { $self->Response()->{Status} = 500; };
240   }
241
242   # gotos come here from:
243   #   $Response->End()
244  MUNGO_HANDLER_FINISH:
245   $self->Response()->finish();
246
247   $self->cleanse();
248   undef $main::Request;
249   undef $main::Response;
250   undef $main::Server;
251   undef $self;
252   return &OK;
253 }
254
255
256 sub MungoDie {
257   my $i = 0;
258   my @callstack;
259   while(my @callinfo = caller($i++)) {
260     push @callstack, \@callinfo;
261   }
262   die Mungo::Error->new({ error => shift, callstack => \@callstack });
263 }
264
265 =for private_developer_docs
266
267 =head2 $mungo = Mungo->new($req);
268
269 Given an Apache2::RequestRec or Apache request object,
270 return the Mungo context, which is a Singleton.
271
272 Called from the modperl handler.
273
274 =cut
275
276 sub new {
277   my ($class, $r) = @_;
278   my $self = $r->pnotes(__PACKAGE__);
279   return $self if($self);
280   $self = bless {
281     'Apache::Request' => $r,
282   }, $class;
283   $r->pnotes(__PACKAGE__, $self);
284   return $self;
285 }
286
287 sub DESTROY { }
288
289 =for private_developer_docs
290
291 =head2 $mungo->cleanse();
292
293 Releases resources at the end of a request.
294
295 =cut
296
297 sub cleanse {
298   my $self = shift;
299   $self->Response()->cleanse();
300   $self->Request()->cleanse();
301   delete $self->{'Apache::Request'};
302 }
303
304 # Axiomatic "I am myself"
305 sub Server { return $_[0]; }
306 sub Request { return Mungo::Request->new($_[0]); }
307 sub Response { return Mungo::Response->new($_[0]); }
308
309 =head2 $encoded = $mungo->URLEncode($string);
310
311 =head2 $encoded = Mungo->URLEncode($string);
312
313 Encodes a string to escape characters that are not permitted in a URL.
314
315 =cut
316
317 sub URLEncode {
318   my $self = shift;
319   my $s = shift;
320   $s =~ s/([^a-zA-Z0-9])/sprintf("%%%02x", ord($1))/eg;
321   return $s;
322 }
323
324 =head2 $string = $mungo->URLDecode($encoded);
325
326 =head2 $string = Mungo->URLDecode($encoded);
327
328 Decodes a string to unescape characters that are not permitted in a URL.
329
330 =cut
331
332 sub URLDecode {
333   my $self = shift;
334   my $s = shift;
335   $s =~ s/%([a-fA-F0-9]{2})/chr(hex($1))/eg;
336   return $s;
337 }
338 sub HTMLEncode {
339   my $self = shift;
340   my $s = shift;
341   return HTML::Entities::encode_entities( $s );
342 }
343 sub HTMLDecode {
344   my $self = shift;
345   my $s = shift;
346   return HTML::Entities::decode_entities( $s );
347 }
348
349
350 # Private?
351 sub demangle_name {
352   my $self = shift;
353   my $name = shift;
354   if($name =~ /Mungo::FilePage::([^:]+)::__content/) {
355     my $filename = decode_base64($1);
356     my $r = $self->{'Apache::Request'};
357     if(UNIVERSAL::can($r, 'document_root')) {
358       my $base = $r->document_root();
359       $filename =~ s/^$base//;
360     }
361     $name = "Mungo::FilePage($filename)";
362   }
363   elsif($name =~ /Mungo::MemPage::([^:]+)::__content/) {
364     $name = 'Mungo::MemPage(ANON)';
365   }
366   return $name;
367 }
368
369 # Private?
370 sub filename2packagename {
371   my ($self, $filename) = @_;
372   my $type = ref $self;
373   $type =~ s/::(?:File|Mem)Page::[^:]+$//;
374   my $pkg = $type . "::FilePage::" . encode_base64($filename);
375   $pkg =~ s/(\s|=*$)//gs;
376   return $pkg;
377 }
378 sub contents2packagename {
379   my($self, $contents) = @_;
380   my $type = ref $self;
381   $type =~ s/::(?:File|Mem)Page::[^:]+$//;
382   return $type . "::MemPage::" . md5_hex($$contents);
383 }
384
385
386 # $output = $mungo->include_mem(
387 #
388 sub include_mem {
389   my $self = shift;
390   my $contents = shift;
391   my $pkg = $self->contents2packagename($contents);
392
393   unless(UNIVERSAL::can($pkg, 'content')) {
394     return unless $self->packagize($pkg, $contents);
395     # The packagize was successful, make content do __content
396     eval "*".$pkg."::content = \\&".$pkg."::__content;";
397   }
398   my %copy = %$self;
399   my $page = bless \%copy, $pkg;
400   $page->content(@_);
401 }
402 # Private?
403 sub include_file {
404   my $self = shift;
405   my $filename = shift;
406   if($filename !~ /^\//) {
407     my $dir = $self->{'Apache::Request'}->filename;
408     $dir =~ s/[^\/]+$//;
409     $filename = "$dir$filename";
410   }
411   my $pkg = $self->filename2packagename($filename);
412   my ($inode, $mtime);
413   if($self->{'Apache::Request'}->dir_config('StatINC')) {
414     ($inode, $mtime) = (stat($filename))[1,9];
415   }
416   unless(UNIVERSAL::can($pkg, 'content') &&
417          $inode == eval "\$${pkg}::Mungo_inode" &&
418          $mtime == eval "\$${pkg}::Mungo_mtime") {
419     my $contents;
420     my $ifile = IO::File->new("<$filename");
421     die "$!: $filename" unless $ifile;
422     {
423       local $/ = undef;
424       $contents = <$ifile>;
425     }
426     return unless $self->packagize($pkg, \$contents);
427     # The packagize was successful, make content do __content
428     eval "*${pkg}::content = \\&${pkg}::__content";
429     # Track what we just compiled
430     eval "\$${pkg}::Mungo_inode = $inode";
431     eval "\$${pkg}::Mungo_mtime = $mtime";
432   }
433   my %copy = %$self;
434   my $page = bless \%copy, $pkg;
435   $page->content(@_);
436 }
437 # Private?
438 sub packagize {
439   my $self = shift;
440   my $pkg = shift;
441   my $contents = shift;
442   my $expr = convertStringToExpression($contents);
443   my $type = ref $self;
444   $type =~ s/::(?:File|Mem)Page::[^:]+$//;
445
446   # We build a package with a __content method.  Why?
447   # If this fails miserably, there is still a possibility that
448   # UNIVERSAL::can($pkg, 'content') will be true, so we make __content
449   # and if it all works out, we *$pkg::content = \&$pkg::__content
450
451   my $preamble = "package $pkg;" . q^
452     use vars qw/@ISA $Mungo_inode $Mungo_mtime/;
453     @ISA = qw/^. $type . q^/;
454     sub __content {
455       my $self = shift;
456       my $Request = $self->Request();
457       my $Response = $self->Response();
458       my $Server = $self->Server();
459 ^;
460   my $postamble = q^
461     }
462     1;
463     ^;
464
465   # Set these before we attempt to compile so that if there is an error,
466   # we can get access to the code from somewhere else.
467   eval "\$${pkg}::Mungo_preamble = \$preamble;";
468   eval "\$${pkg}::Mungo_postamble = \$postamble;";
469   eval "\$${pkg}::Mungo_contents = \$contents;";
470
471   eval $preamble . $expr . $postamble;
472   if($@) {
473     my $error = $@;
474     if(ref $error ne 'HASH') {
475       my $i = 0;
476       my @callstack;
477       while(my @callinfo = caller($i++)) {
478         push @callstack, \@callinfo;
479       }
480       $error = { error => $error, callstack => \@callstack };
481     }
482     my ($line) = ($error->{error} =~ /line (\d+)/m);
483     unshift @{$error->{callstack}},
484       [
485         $pkg, '(ASP include)', $line
486       ];
487     local $SIG{__DIE__} = undef;
488     die $error;
489   }
490   return 1;
491 }
492
493
494 sub convertStringToExpression {
495   my $string_ref = shift;
496   my $string = $$string_ref;
497   sub __string_as_print {
498     return '' unless(length($_[0]));
499     my $s = Dumper($_[0]);
500     substr($s, 0, 7) = 'print';
501     return $s;
502   }
503   # The first is needed b/c variable with look-behind assertions don't work
504   my $tmp;
505   ($tmp = $string) =~ s/^/# /mg;
506   $string =~ s/^(.*?)(?=<%|$)/__string_as_print($1)/se;
507   # Replace non-code
508   $string =~ s/(?<=%>)(?!<%)(.*?)(?=<%|$)/__string_as_print($1)/seg;
509   # fixup code
510   $string =~ s/
511                 <%(=?)(.*?)%>
512               /
513               $1 ?
514                 "print $2;" :           # This is <%= ... %>
515                 "$2;"                   # This is <% ... %>
516               /sexg;
517   return $string;
518 }
519
520 =head1 LIMITATIONS/BUGS
521
522 =over 4
523
524 =item *
525
526 Cannot define subroutines in ASP pages.  Bad things will happen.
527
528 =item *
529
530 Documentation is spotty.  This is being worked on.
531
532 =back
533
534 =head1 LICENSE INFORMATION
535
536 Copyright (c) 2007 OmniTI Computer Consulting, Inc. All rights reserved.
537 For information on licensing see:
538
539 https://labs.omniti.com/mungo/trunk/LICENSE
540
541 =head1 PROJECT WEBSITE
542
543 https://labs.omniti.com/trac/mungo/
544
545 =head1 AUTHOR
546
547 Theo Schlossnagle (code)
548
549 Clinton Wolfe (docs)
550
551 =cut
552
553
554 1;
Note: See TracBrowser for help on using the browser.