Hier finden Sie die an mod_perl-2.0.0-RC5 angepassten Beispiele zu meinem Mod_perl2 Workshop aus dem Linux-Magazin 5/2005 und 6/2005
Beispiele aus Teil1 (5/2005)
Listing 1:
<Perl>
package My::VersionComponent;
use Apache2::Directive ();
sub add {
$_[3]->add_version_component
( 'User/'.Apache2::Directive::conftree()->lookup('User') );
}
</Perl>
PerlPostConfigHandler My::VersionComponent::add
ServerTokens Full
Die Änderung gegenüber der zu MP2-Versionen vor RC5 passenden Variante betrifft nur
die Namensänderung von Apache:: zu Apache2::.
Listing 2:
<Perl>
package My::Location;
sub postreadrequest {
my $r=shift;
warn "PostReadRequest: Location=".$r->dir_config('Location')."\n";
return Apache2::Const::DECLINED;
}
sub trans {
my $r=shift;
if( $r->uri eq '/L1' ) {
$r->uri('/L2');
}
warn "Trans: Location=".$r->dir_config('Location')."\n";
return Apache2::Const::DECLINED;
}
sub headerparser {
my $r=shift;
warn "HeaderParser: Location=".$r->dir_config('Location')."\n";;
return Apache2::Const::DECLINED;
}
</Perl>
PerlPostReadRequestHandler My::Location::postreadrequest
PerlHeaderParserHandler My::Location::headerparser
PerlSetVar Location 0
<Location /L1>
PerlSetVar Location 1
</Location>
<Location /L2>
PerlSetVar Location 2
</Location>Hier wurde Apache:: in Apache2::Const:: geändert.
Und zu guter Letzt noch der loopup Alias, um Methoden zu finden:
alias lookup='perl -MModPerl::MethodLookup -e print_method'Hier ist -MApache2 weggefallen. Dieses Modul war nötig zur Anpassung
des @INC Arrays in früheren Versionen. Mit der Umbenennung in den
Apache2:: Namensraum wurde es überflüssig.
Beispiele aus Teil2 (6/2005)
Im 2. Teil des Artikels wurde ein konkretes Modul entwickelt. Auch hier beschränken sich die Änderungen auf Umbenennungen. Zur Verdeutlichung wurde das Modul selbst auch umbenannt:
package Apache2::ClickPath;
use 5.008;
use strict;
use Apache2::RequestRec ();
use Apache2::RequestUtil ();
use Apache2::RequestIO ();
use Apache2::Filter ();
use Apache2::Const -compile => qw(DECLINED OK);
our $VERSION='0.02';
our $tag='-';
sub handler {
my $r=shift; # das Anfrage-Objekt
my $uri=$r->uri;
unless( $r->is_initial_req ) {
# sub-request or internal redirect
my $pr = $r->main # sub-request
|| $r->prev; # internal redirect
$r->subprocess_env( SESSION=>$pr->subprocess_env('SESSION') );
$r->pnotes( newsession=>$pr->pnotes( 'newsession' ) );
return Apache2::Const::DECLINED
}
if( $uri=~s!^/+ \Q$tag\E ( [^/]+ ) /!/!x ) {
my $session=$1;
$r->uri( $uri );
$r->subprocess_env( SESSION=>$session );
} else {
my $session=$r->subprocess_env('UNIQUE_ID');
$r->subprocess_env( SESSION=>$session );
$r->pnotes( newsession=>1 );
}
return Apache2::Const::DECLINED
}
sub OutputFilter {
my $f=shift; # das Filter Objekt
my $sess;
my $host;
my $context;
my ($re, $re1, $the_request);
unless ($f->ctx) { # Initialisierung
my $r=$f->r; # hier finden wir das Anfrage-Objekt wieder
$sess='/'.$tag.$r->subprocess_env('SESSION');
$host=$r->headers_in->{Host};
if( $r->pnotes( 'newsession' ) ) {
$the_request=$r->the_request;
$the_request=~s/^\s*\w+\s+//;
$the_request=~s![^/]*[\s?].*$!!;
my $re=qr,^(https?://\Q$host\E)?(?!\w+:)(.),i;
$r->headers_out->{Location}=~s!$re!$2 eq '/'
? $1.$sess.$2
: $1.$sess.$the_request.$2
!e
if( exists $r->headers_out->{Location} );
} else {
$the_request="";
my $re=qr!^(https?://\Q$host\E)?/!i;
$r->headers_out->{Location}=~s!$re!$1$sess/!
if( exists $r->headers_out->{Location} );
}
# Nur Dokumente des Typs text/html dürfen gepatcht werden
#
unless( $r->content_type =~ m!text/html!i ) {
$f->remove;
return Apache2::Const::DECLINED;
}
if( $r->pnotes( 'newsession' ) ) {
# Wenn die Session neu ist, dann müssen auch relative Links
# geändert werden.
# Relative Links beginnen nicht mit einem Slash (/) oder
# Hash (# (Anker in der selben Seite)), aber auch nicht mit
# http:, mailto: javascript:, o.ä.
$re1=qr,( # $1 start
<\s*a(?:rea)?\s+ # <a> oder <area> start
.*? # evtl. target=...
\bhref\s*=\s* # href=
(["']) # " oder ': Das ist $2 oder \2 (siehe unten)
(?:https?://\Q$host\E)? # evtl. Host
) # Das alles ist in $1
(?:/+\Q$tag\E[^/]+)?
( # $3 start
(?!(?:\w+:|\043)).*? # ein beliebiger nicht mit http:// o.ä.
# beginnender String (moeglichst kurz)
\2 # das schließende Quote: $2
) # $3 ende
,xi;
} else {
$re1=qr,( # $1 start
<\s*a(?:rea)?\s+ # <a> oder <area> start
.*? # evtl. target=...
\bhref\s*=\s* # href=
(["']) # " oder ': Das ist $2 oder \2 (siehe unten)
(?:https?://\Q$host\E)? # evtl. Host
) # Das alles ist in $1
(?:/+\Q$tag\E[^/]+)?
( # $3 start
/.*? # ein beliebiger mit /
# beginnender String (moeglichst kurz)
\2 # das schließende Quote: $2
) # $3 ende
,xi;
}
# store the configuration
$f->ctx( +{
extra => '',
sess => $sess,
req => $the_request,
re => qr/(<[^>]*)$/,
re1 => $re1,
} );
# der Output Filter ändert die Länge der Antwort. Daher muss der
# vorher berechnete Content-Length Header gelöscht werden. Apache
# benutzt dann Transfer-Encoding: chunked
$r->headers_out->unset('Content-Length');
}
# hole den Filter Kontext
$context=$f->ctx;
$sess=$context->{sess};
$re1=$context->{re1};
$re=$context->{re};
$the_request=$context->{req};
# jetzt wird der Datenstrom bearbeitet
while( $f->read(my $buffer, 1024) ) {
# Beim letzten Aufruf könnte ein halbes HTML Tag im Buffer
# übrig geblieben sein. Das wird hier vor den neuen Datenblock
# gehängt.
$buffer=$context->{extra}.$buffer if( length $context->{extra} );
# Wenn unser aktueller Datenblock mit einem halben HTML Tag endet,
# wird es abgeschnitten und im Filterkontext zwischengespeichert,
# bis der nächste Datenblock kommt.
if (($context->{extra}) = $buffer =~ m/$re/) {
$buffer=substr( $buffer, 0, -length($context->{extra}) );
}
if( length $the_request ) {
$buffer=~s!$re1!(substr($3, 0, 1) eq '/')
? $1.$sess.$3
: $1.$sess.$the_request.$3
!ge;
} else {
$buffer=~s!$re1!$1$sess$3!g;
}
$f->print( $buffer );
}
if( $f->seen_eos ) {
# das war's. Wir haben keine Daten mehr zu verarbeiten.
# Hier muss keine Ersetzung durchgeführt werden, da $context->{extra}
# für richtige HTML Dokumente leer sein muss.
# trotzdem geben wir es aus.
$f->print( $context->{extra} ) if( length $context->{extra} );
}
return Apache2::Const::OK;
}
1;
... noch ein dazu passender Ausschnitt aus der httpd.conf. In Zeile 1
muss PERLLIB noch gegen einen Pfad ersetzt werden, so dass Perl
das Modul Apache2::ClickPath auch findet:
PerlSwitches -I PERLLIB
<Perl>
package Test;
use Apache2::RequestIO ();
use Apache2::Const -compile => qw(OK);
use strict;
sub handler {
my $r=shift;
$r->content_type( 'text/plain' );
$r->print( "SESSION=".$r->subprocess_env( 'SESSION' )."\n" );
return Apache2::Const::OK;
}
</Perl>
PerlModule Apache2::ClickPath
PerlTransHandler Apache2::ClickPath
PerlOutputFilterHandler Apache2::ClickPath::OutputFilter
<Location /Test>
SetHandler modperl
PerlResponseHandler Test
</Location>
Weiter mit Unteranfragen und internen Weiterleitungen