view release on metacpan or  search on metacpan

lib/Apache/Handlers.pm  view on Meta::CPAN

package Apache::Handlers;

# $Id: Handlers.pm,v 1.2 2002/01/07 15:28:35 jgsmith Exp $

use strict;
use Carp;
use Apache::Constants qw(OK SERVER_ERROR DECLINED);
use Perl::WhichPhase qw: in_BEGIN :;
use vars qw:$VERSION @EXPORT_OK @ISA:;

my $has_mod_perl = defined $INC{'Apache'};

eval {
  use Apache::Log ();
  Apache::ModuleConfig -> has_srv_config;
} if $has_mod_perl;

$VERSION = "0.02";
@ISA = qw!Exporter!;

my %code = ( );

sub dump {
  eval {
    use Data::Dumper;
    return Data::Dumper -> Dump([\%code]);
  };
}

my %phases = qw:
  CHILDINIT       PerlChildInitHandler
  POSTREADREQUEST PerlPostReadRequestHandler
  CHILDEXIT       PerlChildExitHandler
  CLEANUP         PerlCleanupHandler
  LOG             PerlLogHandler
  CONTENT         PerlHandler
  FIXUP           PerlFixupHandler
  TYPE            PerlTypeHandler
  AUTHZ           PerlAuthzHandler
  AUTHEN          PerlAuthenHandler
  ACCESS          PerlAccessHandler
  HEADERPARSER    PerlHeaderParserHandler
  TRANS           PerlTransHandler
  RESTART         PerlRestartHandler
:;

@EXPORT_OK = (qw:run_phase:, keys %phases);

my %sigil = qw:
  CODE   &
  ARRAY  @
  SCALAR $
  HASH   %
:;

sub _do_handler {
  my($method, $referent, $data) = @_;
  my($rsig, $dsig);

  foreach my $s (keys %sigil) {
    $rsig = $sigil{$s} if(UNIVERSAL::isa($referent, $s));
    $dsig = $sigil{$s} if(UNIVERSAL::isa($data, $s));
  }

  croak "Unknown referent type" if !defined $rsig;

  if(UNIVERSAL::isa($referent, 'CODE')) {
    $method->($referent);
  } elsif(!defined $data) {
    $method->(eval "sub { undef $rsig\$referent; }");
  } elsif(!defined $dsig and $rsig eq q+$+) {
    $method->(sub { $$referent = $data; });
  } else {
    croak "Potential referent and data mismatch" if !defined $dsig;
    if($dsig eq '&') {
      $method -> (eval "sub { $rsig\$referent = &\$data(\$referent); }");
    } else {
      $method -> (eval "sub { $rsig\$referent = $dsig\$data; }");
    }
  }
}

foreach my $p (keys %phases) {
  my($code, $keeper, $pusher);

  if($p eq 'ACCESS' || $p eq 'AUTHEN' || $p eq 'AUTHZ') {

lib/Apache/Handlers.pm  view on Meta::CPAN

 my $something  = sub : PerlChildExitHandler {
   print "We did it!\n";
 };

 sub something : PerlChildExitHandler {
   print "We did it!\n";
 };

When an attribute is applied to a subroutine, the argument is ignored.

When the attribute argument is itself a CODE reference, the referent (the
variable the attribute applies to) is passed as a reference:

 my $global : PerlChildInitHandler(sub { print "global: $$_[0]\n" });

This will print the value of $global and set it equal to 1 (or the value of
the print statement).

=over 4

=item PerlAccessHandler

=item PerlAuthenHandler

=item PerlAuthzHandler

=item PerlChildInitHandler

=item PerlChildExitHandler

=item PerlCleanupHandler

=item PerlFixupHandler

=item PerlHandler

=item PerlHeaderParserHandler

=item PerlLogHandler

=item PerlPostReadRequestHandler

=item PerlRestartHandler

=item PerlTransHandler

=item PerlTypeHandler

=back 4



=head2 Other Methods

=over 4

=item dump

This will dump the current set of code references and return the string.
This uses L<Data::Dumper|Data::Dumper>.

=item reset

This will clear out all previously set code.  This should only be used in
the C<startup.pl> or equivalent so that code doesn't get run twice during a
request (when it should only be run once).  This will also run any RESET
blocks that have been defined.

=item run_phase

Given a list of phases (using the names for the block constructs above),
this will run through the code for that phase, C<die>ing (outside mod_perl)
or logging (if in mod_perl) if there is an error.  For example,

  run_phase( qw: CONTENT LOG CLEANUP : );

will run any code associated with the CONTENT, LOG, and CLEANUP phases.

=back 4


=head1 CAVEATS

Caveats are things that at first glance might be bugs, but end up
potentially useful.  So I am going to make this section into a kind of
cookbook for non-obvious uses for these potential bugs.

=head2 Authentication and Authorization

Be aware that these two phases only run if Apache has reason to believe
they are needed.  This can be a bit handy since the following snippet
should tell you if the authentication phase was run.  Of course, if an
authentication handler runs before this and returns OK, then this may not
run.

  my $authentication_ran : PerlTransHandler(0) PerlAuthenHandler(1);

  LOG {
    if($authentication_ran) {
      # log something special
    }
  };

=head2 Errors

If code causes an error (such that an eval would set $@), then the request
will throw a SERVER_ERROR and write $@ to either STDERR (if not in mod_perl
and there is no C<die> handler, such as the L<Error|Error> module) or to
the Apache error log with a log level of debug.

=head2 C<Use>ing modules

Any of the block constructs or attributes provided by this module that are
used in the body of a module that is brought in via the C<use> keyword will
be considered to take place before the child is spawned.  This means that
any code designated to run during a particular phase will be run at the
appropriate time as if the module had been loaded during the server
startup.

Modules can now rest assured that using a CLEANUP block in their file will
mean that code is run at the end of every request, even if the module was
loaded in the child process and not during server startup.

This is done by looking for code run during the BEGIN phase.

=head1 BUGS

Unlike caveats, bugs are features that are undesirable and/or get in the
way of doing something useful.  I'm sure there are some.  Please let me
know when you find them.

=head2 Security

There is no way (currently) to limit registration of code for later
processing during a particular phase.  Ideas are welcome for how this
should be designed.

=head1 SEE ALSO

L<Apache>,
L<Attribute::Handlers>,
L<Data::Dumper>.

=head1 AUTHOR

James G. Smith <jsmith@cpan.org>

=head1 COPYRIGHT

Copyright (C) 2002 Texas A&M University.  All Rights Reserved.

This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.