1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
|
package Apache::RegistryLoader;
use 5.003_97;
use mod_perl 1.01;
use strict;
use Apache::Registry ();
use Apache::Constants qw(OPT_EXECCGI);
@Apache::RegistryLoader::ISA = qw(Apache::Registry);
$Apache::RegistryLoader::VERSION = '1.90';
sub new {
my $class = shift;
bless {@_} => $class;
}
sub handler {
my($self, $uri, $filename) = @_;
unless($filename) {
if(my $func = $self->{trans}) {
no strict 'refs';
$filename = &{$func}($uri);
}
}
#warn "RegistryLoader: uri=$uri, filename=$filename\n";
(my $guess = $uri) =~ s,^/,,;
my $r = bless {
uri => $uri,
filename => Apache->server_root_relative($filename || $guess),
} => ref($self) || $self;
$r->SUPER::handler;
}
#override Apache class methods called by Apache::Registry
#normally only available at request-time via blessed request_rec pointer
sub slurp_filename {
my $r = shift;
my $filename = $r->filename;
my $fh = Apache::gensym(__PACKAGE__);
open $fh, $filename;
local $/;
my $code = <$fh>;
return \$code;
}
sub get_server_name {}
sub filename { shift->{filename} }
sub uri { shift->{uri} }
sub status {200}
sub path_info {}
sub log_error { shift; die @_ if $@; warn @_; }
*log_reason = \&log_error;
sub allow_options { OPT_EXECCGI } #will be checked again at run-time
sub clear_rgy_endav {}
sub stash_rgy_endav {}
sub request {}
sub seqno {0}
sub server { shift }
sub is_virtual {0}
sub header_out {""}
sub chdir_file {
my($r, $file) = @_;
$file ||= $r->filename;
Apache::chdir_file(undef, $file);
}
1;
__END__
=head1 NAME
Apache::RegistryLoader - Compile Apache::Registry scripts at server startup
=head1 SYNOPSIS
#in PerlScript
use Apache::RegistryLoader ();
my $r = Apache::RegistryLoader->new;
$r->handler($uri, $filename);
=head1 DESCRIPTION
This modules allows compilation of B<Apache::Registry> scripts at
server startup. The script's handler routine is compiled by the
parent server, of which children get a copy.
The Apache::RegistryLoader C<handler> method takes arguments of C<uri>
and the C<filename>. URI to filename translation normally doesn't
happen until HTTP request time, so we're forced to roll our own
translation.
If filename is omitted and a C<trans> routine was not
defined, the loader will try using the B<uri> relative to
B<ServerRoot>. Example:
#in httpd.conf
ServerRoot /opt/www/apache
Alias /perl/ /opt/www/apache/perl
#in PerlScript
use Apache::RegistryLoader ();
#/opt/www/apache/perl/test.pl
#is the script loaded from disk here:
Apache::RegistryLoader->new->handler("/perl/test.pl");
To make the loader smarter about the uri->filename translation, you may
provide the C<new> method with a C<trans> function to translate the
uri to filename.
The following example will pre-load all files ending with C<.pl> in the
B<perl-scripts/> directory relative to B<ServerRoot>.
The example code assumes the Location URI C</perl> is an B<Alias> to
this directory.
{
use Cwd ();
use Apache::RegistryLoader ();
use DirHandle ();
use strict;
my $dir = Apache->server_root_relative("perl-scripts/");
my $rl = Apache::RegistryLoader->new(trans => sub {
my $uri = shift;
$uri =~ s:^/perl/:/perl-scripts/:;
return Apache->server_root_relative($uri);
});
my $dh = DirHandle->new($dir) or die $!;
for my $file ($dh->read) {
next unless $file =~ /\.pl$/;
$rl->handler("/perl/$file");
}
}
=head1 AUTHOR
Doug MacEachern
=head1 SEE ALSO
Apache::Registry(3), Apache(3), mod_perl(3)
|
