root/trunk/lib/Mungo.pm

Revision 82, 15.8 kB (checked in by clinton, 4 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.