home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / HeavyCGI.pm < prev    next >
Encoding:
Perl POD Document  |  2001-07-13  |  32.1 KB  |  936 lines

  1. package Apache::HeavyCGI;
  2. use 5.005; # for fields support and package-named exceptions
  3. use Apache::Constants qw(:common);
  4. use Apache::HeavyCGI::Date;
  5. use Apache::HeavyCGI::Exception;
  6. use strict;
  7. use vars qw(%FIELDS $VERSION $DEBUG);
  8.  
  9. $VERSION = sprintf "0.%02d%02d", q$Revision: 1.33 $ =~ /(\d+)\.(\d+)/;
  10.  
  11. use fields qw[
  12.  
  13. CAN_GZIP
  14. CAN_PNG
  15. CAN_UTF8
  16. CGI
  17. CHARSET
  18. CONTENT
  19. DOCUMENT_ROOT
  20. DONE
  21. ERROR
  22. ERRORS_TO_BROWSER
  23. EXECUTION_PLAN
  24. EXPIRES
  25. HANDLER
  26. LAST_MODIFIED
  27. MYURL
  28. R
  29. REFERER
  30. SERVERROOT_URL
  31. SERVER_ADMIN
  32. TIME
  33. TODAY
  34.  
  35. ];
  36.  
  37. sub can_gzip {
  38.   my Apache::HeavyCGI $self = shift;
  39.   return $self->{CAN_GZIP} if defined $self->{CAN_GZIP};
  40.   my $acce = $self->{R}->header_in('Accept-Encoding') || "";
  41.   return $self->{CAN_GZIP} = 0 unless $acce;
  42.   $self->{CAN_GZIP} = $acce =~ /\bgzip\b/;
  43. }
  44.  
  45. sub can_png {
  46.   my Apache::HeavyCGI $self = shift;
  47.   return $self->{CAN_PNG} if defined $self->{CAN_PNG};
  48.   my $acce = $self->{R}->header_in("Accept") || "";
  49.   return $self->{CAN_PNG} = 0 unless $acce;
  50.   $self->{CAN_PNG} = $acce =~ m|image/png|i;
  51. }
  52.  
  53. sub can_utf8 {
  54.   my Apache::HeavyCGI $self = shift;
  55.   return $self->{CAN_UTF8} if defined $self->{CAN_UTF8};
  56.  
  57.   # From chapter 14.2. HTTP/1.1
  58.  
  59.   ##   If no Accept-Charset header is present, the default is that any
  60.   ##   character set is acceptable. If an Accept-Charset header is present,
  61.   ##   and if the server cannot send a response which is acceptable
  62.   ##   according to the Accept-Charset header, then the server SHOULD send
  63.   ##   an error response with the 406 (not acceptable) status code, though
  64.   ##   the sending of an unacceptable response is also allowed.
  65.  
  66.   my $acce = $self->{R}->header_in("Accept-Charset") || "";
  67.   if (defined $acce){
  68.     if ($acce =~ m|\butf-8\b|i){
  69.       $self->{CAN_UTF8} = 1;
  70.     } else {
  71.       $self->{CAN_UTF8} = 0;
  72.     }
  73.     return $self->{CAN_UTF8};
  74.   }
  75.   my $protocol = $self->{R}->protocol || "";
  76.   my($major,$minor) = $protocol =~ m|HTTP/(\d+)\.(\d+)|;
  77.   $self->{CAN_UTF8} = $major >= 1 && $minor >= 1;
  78. }
  79.  
  80. sub deliver {
  81.   my Apache::HeavyCGI $self = shift;
  82.   my $r = $self->{R};
  83.   # warn "Going to send_http_header";
  84.   $r->send_http_header;
  85.   return OK if $r->method eq "HEAD";
  86.   # warn "Going to print content";
  87.   $r->print($self->{CONTENT});
  88.   DONE; # we've sent the headers and the body, apache shouldn't talk
  89.         # to the browser anymore
  90. }
  91.  
  92. sub handler {
  93.   warn "The handler of the request hasn't defined a handler subroutine.";
  94.   __PACKAGE__->new( R => shift )->dispatch;
  95. }
  96.  
  97. sub dispatch {
  98.   my Apache::HeavyCGI $self = shift;
  99.   $self->init;
  100.   eval { $self->prepare; };
  101.   if ($@) {
  102.     if (UNIVERSAL::isa($@,"Apache::HeavyCGI::Exception")) {
  103.       if ($@->{ERROR}) {
  104.     warn "\$\@ ERROR[$@->{ERROR}]";
  105.     $@->{ERROR} = [ $@->{ERROR} ] unless ref $@->{ERROR};
  106.     warn "\$\@ ERROR[$@->{ERROR}]";
  107.     push @{$self->{ERROR}}, @{$@->{ERROR}};
  108.     warn "self ERROR[$self->{ERROR}]";
  109.       } elsif ($@->{HTTP_STATUS}) {
  110.     return $@->{HTTP_STATUS};
  111.       }
  112.     } else {
  113.       # this is not a known error type, we need to handle it anon
  114.       if ($self->{ERRORS_TO_BROWSER}) {
  115.     push @{$self->{ERROR}}, " ", $@;
  116.       } else {
  117.     $self->{R}->log_error($@);
  118.     return SERVER_ERROR;
  119.       }
  120.     }
  121.   }
  122.   return $self->{DONE} if $self->{DONE}; # backwards comp now, will go away
  123.   $self->{CONTENT} = $self->layout->as_string($self);
  124.   $self->finish;
  125.   $self->deliver;
  126. }
  127.  
  128. sub expires {
  129.   my Apache::HeavyCGI $self = shift;
  130.   my($set) = @_;
  131.   $set = Apache::HeavyCGI::Date->new(unix => $set)
  132.       if defined($set) and not ref($set); # allow setting to a number
  133.   $self->{EXPIRES} = $set if defined $set;
  134.   return $self->{EXPIRES}; # even if not defined $self->{EXPIRES};
  135. }
  136.  
  137. sub finish {
  138.   my Apache::HeavyCGI $self = shift;
  139.  
  140.   my $r = $self->{R};
  141.   my $content_type = "text/html";
  142.   $content_type .= "; charset=$self->{CHARSET}" if defined $self->{CHARSET};
  143.   $r->content_type($content_type);
  144.  
  145.   eval { require Compress::Zlib; };
  146.   $self->{CAN_GZIP} = 0 if $@; # we cannot compress anyway :-)
  147.  
  148.   if ($self->can_gzip) {
  149.     $r->header_out('Content-Encoding', 'gzip');
  150.     $self->{CONTENT} = Compress::Zlib::memGzip($self->{CONTENT});
  151.   }
  152.  
  153.   $r->header_out('Vary', join ", ", 'accept-encoding');
  154.   $r->header_out('Expires', $self->expires->http) if $self->expires;
  155.   $r->header_out('Last-Modified',$self->last_modified->http);
  156.   $r->header_out('Content-Length', length($self->{CONTENT}));
  157. }
  158.  
  159. sub init {
  160.   return;
  161. }
  162.  
  163. sub instance_of {
  164.   my($self,$class) = @_;
  165.   return $class->instance if $class->can("instance");
  166.   my $requirefile = $class;
  167.   $requirefile =~ s/::/\//g;
  168.   $requirefile .= ".pm";
  169.   # warn "requiring[$requirefile]";
  170.   require $requirefile;
  171.   $class->instance;
  172. }
  173.  
  174. sub layout {
  175.   my Apache::HeavyCGI $self = shift;
  176.   require Apache::HeavyCGI::Layout;
  177.   my @l;
  178.   push @l, qq{<html><head><title>Apache::HeavyCGI default page</title>
  179. </head><body><pre>};
  180.   push @l, $self->instance_of("Apache::HeavyCGI::Debug");
  181.   push @l, qq{</pre></body></html>};
  182.   Apache::HeavyCGI::Layout->new(@l);
  183. }
  184.  
  185. sub last_modified {
  186.   my Apache::HeavyCGI $self = shift;
  187.   my($set) = @_;
  188.   $set = Apache::HeavyCGI::Date->new(unix => $set)
  189.       if defined($set) and not ref($set); # allow setting to a number
  190.   $self->{LAST_MODIFIED} = $set if defined $set;
  191.   return $self->{LAST_MODIFIED} if defined $self->{LAST_MODIFIED};
  192.   $self->{LAST_MODIFIED} =
  193.       Apache::HeavyCGI::Date->new(unix => $self->time);
  194. }
  195.  
  196. sub myurl {
  197.   my Apache::HeavyCGI $self = shift;
  198.   return $self->{MYURL} if defined $self->{MYURL};
  199.   require URI::URL;
  200.   my $r = $self->{R} or
  201.       return URI::URL->new("http://localhost");
  202.   my $script_name = substr(
  203.                $r->uri,
  204.                0,
  205.                length($r->uri)-length($r->path_info)
  206.               );
  207.   my $port = $r->server->port || 80;
  208.   my $protocol = $port == 443 ? "https" : "http";
  209.   my $explicit_port = ($port == 80 || $port == 443) ? "" : ":$port";
  210.   $self->{MYURL} = URI::URL->new(
  211.                  "$protocol://" .
  212.                  $r->server->server_hostname .
  213.                  $explicit_port .
  214.                  $script_name);
  215. }
  216.  
  217. sub new {
  218.   my($class,%opt) = @_;
  219.   no strict "refs";
  220.   my $self = bless [\%{"$class\::FIELDS"}], $class;
  221.   while (my($k,$v) = each %opt) {
  222.     eval {$self->{$k} = $v;};
  223.     if ($@) {
  224.       if ($@ =~ /No such array field/i) {
  225.     warn "ignoring unknown key[$k]";
  226.       } else {
  227.     die $@;
  228.       }
  229.     }
  230.   }
  231.   $self;
  232. }
  233.  
  234. sub prepare {
  235.   my Apache::HeavyCGI $self = shift;
  236.   if (my $ep = $self->{EXECUTION_PLAN}) {
  237.     $ep->walk($self);
  238.   } else {
  239.     die "No execution plan!";
  240.   }
  241. }
  242.  
  243. sub serverroot_url {
  244.   my Apache::HeavyCGI $self = shift;
  245.   return $self->{SERVERROOT_URL} if $self->{SERVERROOT_URL};
  246.   require URI::URL;
  247.   my $r = $self->{R} or
  248.       return URI::URL->new("http://localhost");
  249.   my $host   = $r->server->server_hostname;
  250.   my $port = $r->server->port || 80;
  251.   my $protocol = $port == 443 ? "https" : "http";
  252.   my $explicit_port = ($port == 80 || $port == 443) ? "" : ":$port";
  253.   $self->{SERVERROOT_URL} = URI::URL->new(
  254.                    "$protocol\://" .
  255.                    $host .
  256.                    $explicit_port .
  257.                    "/"
  258.                   );
  259. }
  260.  
  261. sub time {
  262.   my Apache::HeavyCGI $self = shift;
  263.   $self->{TIME} ||= time;
  264. }
  265.  
  266. sub today {
  267.   my Apache::HeavyCGI $self = shift;
  268.   return $self->{TODAY} if defined $self->{TODAY};
  269.   my(@time) = localtime($self->time);
  270.   $time[4]++;
  271.   $time[5] += 1900;
  272.   $self->{TODAY} = sprintf "%04d-%02d-%02d", @time[5,4,3];
  273. }
  274.  
  275. # CGI form handling
  276.  
  277. sub checkbox {
  278.   my($self,%arg) = @_;
  279.  
  280.   my $name = $arg{name};
  281.   my $value;
  282.   defined($value = $arg{value}) or ($value = "on");
  283.   my $checked;
  284.   my @sel = $self->{CGI}->param($name);
  285.   if (@sel) {
  286.     for my $s (@sel) {
  287.       if ($s eq $value) {
  288.     $checked = 1;
  289.     last;
  290.       }
  291.     }
  292.   } else {
  293.     $checked = $arg{checked};
  294.   }
  295.   sprintf(qq{<input type="checkbox" name="%s" value="%s"%s />},
  296.       $self->escapeHTML($name),
  297.       $self->escapeHTML($value),
  298.       $checked ? qq{ checked="checked"} : ""
  299.      );
  300. }
  301.  
  302. # pause_1999::main
  303. sub checkbox_group {
  304.   my($self,%arg) = @_;
  305.  
  306.   my $name = $arg{name};
  307.   my @sel = $self->{CGI}->param($name);
  308.   unless (@sel) {
  309.     if (exists $arg{default}) {
  310.       my $default = $arg{default};
  311.       @sel = ref $default ? @$default : $default;
  312.     }
  313.   }
  314.  
  315.   my %sel;
  316.   @sel{@sel} = ();
  317.   my @m;
  318.  
  319.   $name = $self->escapeHTML($name);
  320.  
  321.   my $haslabels = exists $arg{labels};
  322.   my $linebreak = $arg{linebreak} ? "<br />" : "";
  323.  
  324.   for my $v (@{$arg{values} || []}) {
  325.     push(@m,
  326.      sprintf(
  327.          qq{<input type="checkbox" name="%s" value="%s"%s />%s%s},
  328.          $name,
  329.          $self->escapeHTML($v),
  330.          exists $sel{$v} ? qq{ checked="checked"} : "",
  331.          $haslabels ? $arg{labels}{$v} : $self->escapeHTML($v),
  332.          $linebreak,
  333.         )
  334.     );
  335.   }
  336.   join "", @m;
  337. }
  338.  
  339. sub escapeHTML {
  340.   my($self, $what) = @_;
  341.   return unless defined $what;
  342.   my %escapes = qw(& & " " > > < <);
  343.   $what =~ s[ ([&"<>]) ][$escapes{$1}]xg; # ]] cperl-mode comment
  344.   $what;
  345. }
  346.  
  347. sub file_field {
  348.   my($self) = shift;
  349.   $self->text_pw_field(FIELDTYPE=>"file", @_);
  350. }
  351.  
  352. sub hidden_field {
  353.   my($self) = shift;
  354.   $self->text_pw_field(FIELDTYPE=>"hidden", @_);
  355. }
  356.  
  357. sub password_field {
  358.   my($self) = shift;
  359.   $self->text_pw_field(FIELDTYPE=>"password", @_);
  360. }
  361.  
  362. # pause_1999::main
  363. sub radio_group {
  364.   my($self,%arg) = @_;
  365.   my $name = $arg{name};
  366.   my $value;
  367.   my $checked;
  368.   my $sel = $self->{CGI}->param($name);
  369.   my $haslabels = exists $arg{labels};
  370.   my $values = $arg{values} or Carp::croak "radio_group called without values";
  371.   defined($checked = $arg{checked})
  372.       or defined($checked = $sel)
  373.       or defined($checked = $arg{default})
  374.           or $checked = "";
  375.   # some people like to check the first item anyway:
  376.   #      or ($checked = $values->[0]);
  377.   my $escname=$self->escapeHTML($name);
  378.   my $linebreak = $arg{linebreak} ? "<br />" : "";
  379.   my @m;
  380.   for my $v (@$values) {
  381.     my $escv = $self->escapeHTML($v);
  382.     if ($DEBUG) {
  383.       warn "escname undef" unless defined $escname;
  384.       warn "escv undef" unless defined $escv;
  385.       warn "v undef" unless defined $v;
  386.       warn "\$arg{labels}{\$v} undef" unless defined $arg{labels}{$v};
  387.       warn "checked undef" unless defined $checked;
  388.       warn "haslabels undef" unless defined $haslabels;
  389.       warn "linebreak undef" unless defined $linebreak;
  390.     }
  391.     push(@m,
  392.      sprintf(
  393.          qq{<input type="radio" name="%s" value="%s"%s />%s%s},
  394.          $escname,
  395.          $escv,
  396.          $v eq $checked ? qq{ checked="checked"} : "",
  397.          $haslabels ? $arg{labels}{$v} : $escv,
  398.          $linebreak,
  399.         ));
  400.   }
  401.   join "", @m;
  402. }
  403.  
  404. # pause_1999::main
  405. sub scrolling_list {
  406.   my($self, %arg) = @_;
  407.   # name values size labels
  408.   my $size = $arg{size} ? qq{ size="$arg{size}"} : "";
  409.   my $multiple = $arg{multiple} ? q{ multiple="multiple"} : "";
  410.   my $haslabels = exists $arg{labels};
  411.   my $name = $arg{name};
  412.   my @sel = $self->{CGI}->param($name);
  413.   if (!@sel && exists $arg{default} && defined $arg{default}) {
  414.     my $d = $arg{default};
  415.     @sel = ref $d ? @$d : $d;
  416.   }
  417.   my %sel;
  418.   @sel{@sel} = ();
  419.   my @m;
  420.   push @m, sprintf qq{<select name="%s"%s%s>}, $name, $size, $multiple;
  421.   $arg{values} = [$arg{value}] unless exists $arg{values};
  422.   for my $v (@{$arg{values} || []}) {
  423.     my $escv = $self->escapeHTML($v);
  424.     push @m, sprintf qq{<option%s value="%s">%s</option>\n},
  425.     exists $sel{$v} ? q{ selected="selected"} : "",
  426.         $escv,
  427.         $haslabels ? $self->escapeHTML($arg{labels}{$v}) : $escv;
  428.   }
  429.   push @m, "</select>";
  430.   join "", @m;
  431. }
  432.  
  433. # pause_1999::main
  434. sub submit {
  435.   my($self,%arg) = @_;
  436.   my $name = $arg{name} || "";
  437.   my $val  = $arg{value} || $name;
  438.   sprintf qq{<input type="submit" name="%s" value="%s" />},
  439.       $self->escapeHTML($name),
  440.       $self->escapeHTML($val);
  441. }
  442.  
  443. # pause_1999::main
  444. sub textarea {
  445.   my($self,%arg) = @_;
  446.   my $req = $self->{CGI};
  447.   my $name = $arg{name} || "";
  448.   my $val  = $req->param($name) || $arg{default} || $arg{value} || "";
  449.   my($r)   = exists $arg{rows} ? qq{ rows="$arg{rows}"} : '';
  450.   my($c)   = exists $arg{cols} ? qq{ cols="$arg{cols}"} : '';
  451.   my($wrap)= exists $arg{wrap} ? qq{ wrap="$arg{wrap}"} : '';
  452.   sprintf qq{<textarea name="%s"%s%s%s>%s</textarea>},
  453.       $self->escapeHTML($name),
  454.       $r, $c, $wrap, $self->escapeHTML($val);
  455. }
  456.  
  457. # pause_1999::main
  458. sub textfield {
  459.   my($self) = shift;
  460.   $self->text_pw_field(FIELDTYPE=>"text", @_);
  461. }
  462.  
  463. sub text_pw_field {
  464.   my($self, %arg) = @_;
  465.   my $name = $arg{name} || "";
  466.   my $fieldtype = $arg{FIELDTYPE};
  467.  
  468.   my $req = $self->{CGI};
  469.   my $val;
  470.   if ($fieldtype eq "FILE") {
  471.     if ($req->can("upload")) {
  472.       if ($req->upload($name)) {
  473.     $val = $req->upload($name);
  474.       } else {
  475.     $val = $req->param($name);
  476.       }
  477.     } else {
  478.       $val = $req->param($name);
  479.     }
  480.   } else {
  481.     $val = $req->param($name);
  482.   }
  483.   defined $val or
  484.       defined($val = $arg{value}) or
  485.       defined($val = $arg{default}) or
  486.           ($val = "");
  487.  
  488.   sprintf qq{<input type="$fieldtype"
  489.  name="%s" value="%s"%s%s />},
  490.       $self->escapeHTML($name),
  491.        $self->escapeHTML($val),
  492.            exists $arg{size} ? " size=\"$arg{size}\"" : "",
  493.            exists $arg{maxlength} ? " maxlength=\"$arg{maxlength}\"" : "";
  494. }
  495.  
  496. sub uri_escape {
  497.   my Apache::HeavyCGI $self = shift;
  498.   my $string = shift;
  499.   return "" unless defined $string;
  500.   require URI::Escape;
  501.   my $s = URI::Escape::uri_escape($string, '^\w ');
  502.   $s =~ s/ /+/g;
  503.   $s;
  504. }
  505.  
  506. sub uri_escape_light {
  507.   my Apache::HeavyCGI $self = shift;
  508.   require URI::Escape;
  509.   URI::Escape::uri_escape(shift,q{<>#%"; \/\?:&=+,\$}); #"
  510. }
  511.  
  512. 1;
  513.  
  514. =head1 NAME
  515.  
  516. Apache::HeavyCGI - Framework to run complex CGI tasks on an Apache server
  517.  
  518. =head1 SYNOPSIS
  519.  
  520.  use Apache::HeavyCGI; # see eg/ directory of the distribution
  521.                        # for a complete example/template
  522.  
  523. =head1 WARNING UNSUPPORTED ALPHA CODE RELEASED FOR DEMO ONLY
  524.  
  525. The release of this software is only for evaluation purposes to people
  526. who are actively writing code that deals with Web Application
  527. Frameworks. This package is probably just another Web Application
  528. Framework and may be worth using or may not be worth using. As of this
  529. writing (July 1999) it is by no means clear if this software will be
  530. developed further in the future. The author has written it over many
  531. years and is deploying it in several places, e.g.
  532. http://www.stadtplandienst.de, http://netlexikon.akademie.de and
  533. really soon on http://pause.perl.org too. It has turned out to be
  534. useful for him. YMMV.
  535.  
  536. There is no official support for this software. If you find it useful
  537. or even if you find it useless, please mail the author directly.
  538.  
  539. But please make sure you remember: THE RELEASE IS FOR DEMONSTRATION
  540. PURPOSES ONLY.
  541.  
  542. =head1 DESCRIPTION
  543.  
  544. The Apache::HeavyCGI framework is intended to provide a couple of
  545. simple tricks that make it easier to write complex CGI solutions. It
  546. has been developed on a site that runs all requests through a single
  547. mod_perl handler that in turn uses CGI.pm or Apache::Request as the
  548. query interface. So Apache::HeavyCGI is -- as the name implies -- not
  549. merely for multi-page CGI scripts (for which there are other
  550. solutions), but it is for the integration of many different pages into
  551. a single solution. The many different pages can then conveniently
  552. share common tasks.
  553.  
  554. The approach taken by Apache::HeavyCGI is a components-driven one with
  555. all components being pure perl. So if you're not looking for yet
  556. another embedded perl solution, and aren't intimidated by perl, please
  557. read on.
  558.  
  559. =head2 Stacked handlers suck
  560.  
  561. If you have had a look at stacked handlers, you might have noticed
  562. that the model for stacking handlers often is too primitive. The model
  563. supposes that the final form of a document can be found by running
  564. several passes over a single entity, each pass refining the entity,
  565. manipulating some headers, maybe even passing some notes to the next
  566. handler, and in the most advanced form passing pnotes between
  567. handlers. A lot of Web pages may fit into that model, even complex
  568. ones, but it doesn't scale well for pages that result out of a
  569. structure that's more complicated than adjacent items. The more
  570. complexity you add to a page, the more overhead is generated by the
  571. model, because for every handler you push onto the stack, the whole
  572. document has to be parsed and recomposed again and headers have to be
  573. re-examined and possibly changed.
  574.  
  575. =head2 Why not subclass Apache
  576.  
  577. Inheritance provokes namespace conflicts. Besides this, I see little
  578. reason why one should favor inheritance over a B<using> relationship.
  579. The current implementation of Apache::HeavyCGI is very closely coupled
  580. with the Apache class anyway, so we could do inheritance too. No big
  581. deal I suppose. The downside of the current way of doing it is that we
  582. have to write
  583.  
  584.     my $r = $obj->{R};
  585.  
  586. very often, but that's about it. The upside is, that we know which
  587. manpage to read for the different methods provided by C<$obj->{R}>,
  588. C<$obj->{CGI}>, and C<$obj> itself.
  589.  
  590. =head2 Composing applications
  591.  
  592. Apache::HeavyCGI takes an approach that is more ambitious for handling
  593. complex tasks. The underlying model for the production of a document
  594. is that of a puzzle. An HTML (or XML or SGML or whatever) page is
  595. regarded as a sequence of static and dynamic parts, each of which has
  596. some influence on the final output. Typically, in today's Webpages,
  597. the dynamic parts are filled into table cells, i.e. contents between
  598. some C<< <TD></TD> >> tokens. But this is not necessarily so. The
  599. static parts in between typically are some HTML markup, but this also
  600. isn't forced by the model. The model simply expects a sequence of
  601. static and dynamic parts. Static and dynamic parts can appear in
  602. random order. In the extreme case of a picture you would only have one
  603. part, either static or dynamic. HeavyCGI could handle this, but I
  604. don't see a particular advantage of HeavyCGI over a simple single
  605. handler.
  606.  
  607. In addition to the task of generating the contents of the page, there
  608. is the other task of producing correct headers. Header composition is
  609. an often neglected task in the CGI world. Because pages are generated
  610. dynamically, people believe that pages without a Last-Modified header
  611. are fine, and that an If-Modified-Since header in the browser's
  612. request can go by unnoticed. This laissez-faire principle gets in the
  613. way when you try to establish a server that is entirely driven by
  614. dynamic components and the number of hits is significant.
  615.  
  616. =head2 Header Composition, Parameter Processing, and Content Creation
  617.  
  618. The three big tasks a CGI script has to master are Headers, Parameters
  619. and the Content. In general one can say, content creation SHOULD not
  620. start before all parameters are processed. In complex scenarios you
  621. MUST expect that the whole layout may depend on one parameter.
  622. Additionally we can say that some header related data SHOULD be
  623. processed very early because they might result in a shortcut that
  624. saves us a lot of processing.
  625.  
  626. Consequently, Apache::HeavyCGI divides the tasks to be done for a
  627. request into four phases and distributes the four phases among an
  628. arbitrary number of modules. Which modules are participating in the
  629. creation of a page is the design decision of the programmer.
  630.  
  631. The perl model that maps (at least IMHO) ideally to this task
  632. description is an object oriented approach that identifies a couple of
  633. phases by method names and a couple of components by class names. To
  634. create an application with Apache::HeavyCGI, the programmer specifies
  635. the names of all classes that are involved. All classes are singleton
  636. classes, i.e. they have no identity of their own but can be used to do
  637. something useful by working on an object that is passed to them.
  638. Singletons have an @ISA relation to L<Class::Singleton> which can be
  639. found on CPAN. As such, the classes can only have a single instance
  640. which can be found by calling the C<< CLASS->instance >> method. We'll
  641. call these objects after the mod_perl convention I<handlers>.
  642.  
  643. Every request maps to exactly one Apache::HeavyCGI object. The
  644. programmer uses the methods of this object by subclassing. The
  645. HeavyCGI constructor creates objects of the AVHV type (pseudo-hashes).
  646. If the inheriting class needs its own constructor, this needs to be an
  647. AVHV compatible constructor. A description of AVHV can be found in
  648. L<fields>. An Apache::HeavyCGI object usually is constructed with the
  649. C<new> method and after that the programmer calls the C<dispatch>
  650. method on this object. HeavyCGI will then perform various
  651. initializations and then ask all nominated handlers in turn to perform
  652. the I<header> method and in a second round to perform the I<parameter>
  653. method. In most cases it will be the case that the availability of a
  654. method can be determined at compile time of the handler. If this is
  655. true, it is possible to create an execution plan at compile time that
  656. determines the sequence of calls such that no runtime is lost to check
  657. method availability. Such an execution plan can be created with the
  658. L<Apache::HeavyCGI::ExePlan> module. All of the called methods will
  659. get the HeavyCGI request object passed as the second parameter.
  660.  
  661. There are no fixed rules as to what has to happen within the C<header>
  662. and C<parameter> method. As a rule of thumb it is recommended to
  663. determine and set the object attributes LAST_MODIFIED and EXPIRES (see
  664. below) within the header() method. It is also recommended to inject
  665. the L<Apache::HeavyCGI::IfModified> module as the last header handler,
  666. so that the application can abort early with an Not Modified header. I
  667. would recommend that in the header phase you do as little as possible
  668. parameter processing except for those parameters that are related to
  669. the last modification date of the generated page.
  670.  
  671. =head2 Terminating the handler calls or triggering errors.
  672.  
  673. Sometimes you want to stop calling the handlers, because you think
  674. that processing the request is already done. In that case you can do a
  675.  
  676.  die Apache::HeavyCGI::Exception->new(HTTP_STATUS => status);
  677.  
  678. at any point within prepare() and the specified status will be
  679. returned to the Apache handler. This is useful for example for the
  680. Apache::HeavyCGI::IfModified module which sends the response headers
  681. and then dies with HTTP_STATUS set to Apache::Constants::DONE.
  682. Redirectors presumably would set up their headers and set it to
  683. Apache::Constants::HTTP_MOVED_TEMPORARILY.
  684.  
  685. Another task for Perl exceptions are errors: In case of an error
  686. within the prepare loop, all you need to do is
  687.  
  688.  die Apache::HeavyCGI::Exception->new(ERROR=>[array_of_error_messages]);
  689.  
  690. The error is caught at the end of the prepare loop and the anonymous
  691. array that is being passed to $@ will then be appended to
  692. C<@{$self-E<gt>{ERROR}}>. You should check for $self->{ERROR} within
  693. your layout method to return an appropriate response to the client.
  694.  
  695. =head2 Layout and Text Composition
  696.  
  697. After the header and the parameter phase, the application should have
  698. set up the object that is able to characterize the complete
  699. application and its status. No changes to the object should happen
  700. from now on.
  701.  
  702. In the next phase Apache::HeavyCGI will ask this object to perform the
  703. C<layout> method that has the duty to generate an
  704. Apache::HeavyCGI::Layout (or compatible) object. Please read more
  705. about this object in L<Apache::HeavyCGI::Layout>. For our HeavyCGI
  706. object it is only relevant that this Layout object can compose itself
  707. as a string in the as_string() method. As a layout object can be
  708. composed as an abstraction of a layout and independent of
  709. request-specific contents, it is recommended to cache the most
  710. important layouts. This is part of the reponsibility of the
  711. programmer.
  712.  
  713. In the next step HeavyCGI stores a string representation of current
  714. request by calling the as_string() method on the layout object and
  715. passing itself to it as the first argument. By passing itself to the
  716. Layout object all the request-specific data get married to the
  717. layout-specific data and we reach the stage where stacked handlers
  718. usually start, we get at a composed content that is ready for
  719. shipping.
  720.  
  721. The last phase deals with setting up the yet unfinished headers,
  722. eventually compressing, recoding and measuring the content, and
  723. delivering the request to the browser. The two methods finish() and
  724. deliver() are responsible for that phase. The default deliver() method
  725. is pretty generic, it calls finish(), then sends the headers, and
  726. sends the content only if the request method wasn't a HEAD. It then
  727. returns Apache's constant DONE to the caller, so that Apache won't do
  728. anything except logging on this request. The method finish is more apt
  729. to being overridden. The default finish() method sets the content type
  730. to text/html, compresses the content if the browser understands
  731. compressed data and Compress::Zlib is available, it also sets the
  732. headers Vary, Expires, Last-Modified, and Content-Length. You most
  733. probably will want to override the finish method.
  734.  
  735. head2 Summing up
  736.                                         +-------------------+
  737.                                         | sub handler {...} |
  738.  +--------------------+                 | (sub init {...})  |
  739.  |Your::Class         |---defines------>|                   |
  740.  |ISA Apache::HeavyCGI|                 | sub layout {...}  |
  741.  +--------------------+                 | sub finish {...}  |
  742.                                         +-------------------+
  743.  
  744.                                         +-------------------+
  745.                                         | sub new {...}     |
  746.  +--------------------+                 | sub dispatch {...}|
  747.  |Apache::HeavyCGI    |---defines------>| sub prepare {...} |
  748.  +--------------------+                 | sub deliver {...} |
  749.                                         +-------------------+
  750.  
  751.  +----------------------+               +--------------------+
  752.  |Handler_1 .. Handler_N|               | sub header {...}   |
  753.  |ISA Class::Singleton  |---define----->| sub parameter {...}|
  754.  +----------------------+               +--------------------+
  755.  
  756.                                                                        +----+
  757.                                                                        |Your|
  758.                                                                        |Duty|
  759.  +----------------------------+----------------------------------------+----+
  760.  |Apache                      | calls Your::Class::handler()           |    |
  761.  +----------------------------+----------------------------------------+----+
  762.  |                            | nominates the handlers,                |    |
  763.  |Your::Class::handler()      | constructs $self,                      | ** |
  764.  |                            | and calls $self->dispatch              |    |
  765.  +----------------------------+----------------------------------------+----+
  766.  |                            |        $self->init     (does nothing)  | ?? |
  767.  |                            |        $self->prepare  (see below)     |    |
  768.  |Apache::HeavyCGI::dispatch()| calls  $self->layout   (sets up layout)| ** |
  769.  |                            |        $self->finish   (headers and    | ** |
  770.  |                            |                         gross content) |    |
  771.  |                            |        $self->deliver  (delivers)      | ?? |
  772.  +----------------------------+----------------------------------------+----+
  773.  |Apache::HeavyCGI::prepare() | calls HANDLER->instance->header($self) | ** |
  774.  |                            | and HANDLER->instance->parameter($self)| ** |
  775.  |                            | on all of your nominated handlers      |    |
  776.  +----------------------------+----------------------------------------+----+
  777.  
  778.  
  779. =head1 Object Attributes
  780.  
  781. As already mentioned, the HeavyCGI object is a pseudo-hash, i.e. can
  782. be treated like a HASH, but all attributes that are being used must be
  783. predeclared at compile time with a C<use fields> clause.
  784.  
  785. The convention regarding attributes is as simple as it can be:
  786. uppercase attributes are reserved for the Apache::HeavyCGI class, all
  787. other attribute names are at your disposition if you write a subclass.
  788.  
  789. The following attributes are currently defined. The module author's
  790. production environment has a couple of attributes more that seem to
  791. work well but most probably need more thought to be implemented in a
  792. generic way.
  793.  
  794. =over
  795.  
  796. =item CAN_GZIP
  797.  
  798. Set by the can_gzip method. True if client is able to handle gzipped
  799. data.
  800.  
  801. =item CAN_PNG
  802.  
  803. Set by the can_png method. True if client is able to handle PNG.
  804.  
  805. =item CAN_UTF8
  806.  
  807. Set by the can_utf8 method. True if client is able to handle UTF8
  808. endoded data.
  809.  
  810. =item CGI
  811.  
  812. An object that handles GET and POST parameters and offers the method
  813. param() and upload() in a manner compatible with Apache::Request.
  814. Needs to be constructed and set by the user typically in the
  815. contructor.
  816.  
  817. =item CHARSET
  818.  
  819. Optional attribute to denote the charset in which the outgoing data
  820. are being encoded. Only used within the finish method. If it is set,
  821. the finish() method will set the content type to text/html with this
  822. charset.
  823.  
  824. =item CONTENT
  825.  
  826. Scalar that contains the content that should be sent to the user
  827. uncompressed. During te finish() method the content may become
  828. compressed.
  829.  
  830. =item DOCUMENT_ROOT
  831.  
  832. Unused.
  833.  
  834. =item ERROR
  835.  
  836. Anonymous array that accumulates error messages. HeavyCGI doesn't
  837. handle the error though. It is left to the user to set up a proper
  838. response to the user.
  839.  
  840. =item EXECUTION_PLAN
  841.  
  842. Object of type L<Apache::HeavyCGI::ExePlan>. It is recommended to
  843. compute the object at startup time and always pass the same execution
  844. plan into the constructor.
  845.  
  846. =item EXPIRES
  847.  
  848. Optional Attribute set by the expires() method. If set, HeavyCGI will
  849. send an Expires header. The EXPIRES attribute needs to contain an
  850. L<Apache::HeavyCGI::Date> object.
  851.  
  852. =item HANDLER
  853.  
  854. If there is an EXECUTION_PLAN, this attribute is ignored. Without an
  855. EXECUTION_PLAN, it must be an array of package names. HeavyCGI treats
  856. the packages as Class::Singleton classes. During the prepare() method
  857. HeavyCGI calls HANDLER->instance->header($self) and
  858. HANDLER->instance->parameter($self) on all of your nominated handlers.
  859.  
  860. =item LAST_MODIFIED
  861.  
  862. Optional Attribute set by the last_modified() method. If set, HeavyCGI
  863. will send a Last-Modified header of the specified time, otherwise it
  864. sends a Last-Modified header of the current time. The attribute needs
  865. to contain an L<Apache::HeavyCGI::Date> object.
  866.  
  867. =item MYURL
  868.  
  869. The URL of the running request set by the myurl() method. Contains an
  870. URI::URL object.
  871.  
  872. =item R
  873.  
  874. The Apache Request object for the running request. Needs to be set up
  875. in the constructor by the user.
  876.  
  877. =item REFERER
  878.  
  879. Unused.
  880.  
  881. =item SERVERROOT_URL
  882.  
  883. The URL of the running request's server-root set by the
  884. serverroot_url() method. Contains an URI::URL object.
  885.  
  886. =item SERVER_ADMIN
  887.  
  888. Unused.
  889.  
  890. =item TIME
  891.  
  892. The time when this request started set by the time() method. Please
  893. note, that the time() system call is considerable faster than the
  894. method call to Apache::HeavyCGI::time. The advantage of calling using
  895. the TIME attribute is that it is self-consistent (remains the same
  896. during a request).
  897.  
  898. =item TODAY
  899.  
  900. Today's date in the format 9999-99-99 set by the today() method, based
  901. on the time() method.
  902.  
  903. =back
  904.  
  905.  
  906.  
  907. =head2 Performance
  908.  
  909. Don't expect Apache::HeavyCGI to serve 10 million page impressions a
  910. day. The server I have developed it for is a double processor machine
  911. with 233 MHz, and each request is handled by about 30 different
  912. handlers: a few trigonometric, database, formatting, and recoding
  913. routines. With this overhead each request takes about a tenth of a
  914. second which in many environments will be regarded as slow. On the
  915. other hand, the server is well respected for its excellent response
  916. times. YMMV.
  917.  
  918. =head1 BUGS
  919.  
  920. The fields pragma doesn't mix very well with Apache::StatINC. When
  921. working with HeavyCGI you have to restart your server quite often when
  922. you change your main class. I believe, this could be fixed in
  923. fields.pm, but I haven't tried. A workaround is to avoid changing the
  924. main class, e.g. by delegating the layout() method to a different
  925. class.
  926.  
  927. =head1 AUTHOR
  928.  
  929. Andreas Koenig <andreas.koenig@anima.de>. Thanks to Jochen Wiedmann
  930. for heavy debates about the code and crucial performance enhancement
  931. suggestions. The development of this code was sponsered by
  932. www.speed-link.de.
  933.  
  934. =cut
  935.  
  936.