root/trunk/lib/Mungo.pm

Revision 54, 15.5 kB (checked in by clinton, 4 years ago)

Fix bareword error on DECLINED, tid10737

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