O Nameless One,
S>Were testing some modperl code and some of the modules are dependant
S>apon a request object to get data from... I looked into
S>Apache::FakeRequest and it appears that It just returns the sub name as
S>the data for the sub which doesn't provide true input.
I have a script "apr" that I use for this purpose. I have attached it
here. It fakes out an Apache request object and, more usefully, fakes out
Apache::Request too. It behaves not unlike CGI.pm in that if it detects
that it is being run interactively, it prompts for name/value pairs.
Sounds like this is what you want.
I was going to add basic HTTP request parsing to this module (I have all
the bits for that from other scripts I've written anyway) so you could
pass in a "real" looking HTTP request as well, and maybe release it if
anybody else found it useful.
Of course, this isn't the same as using Apache itself--but it's super
useful to be able to run things from the command line from time to time.
I think it'd be good to have something like this in the main mod_perl
distribution.
Humbly,
Andrew
----------------------------------------------------------------------
Andrew Ho http://www.tellme.com/ [EMAIL PROTECTED]
Engineer [EMAIL PROTECTED] Voice 650-930-9062
Tellme Networks, Inc. 1-800-555-TELL Fax 650-930-9101
----------------------------------------------------------------------
#!/usr/local/bin/perl -w
# ========================================================================
# apr - fake an Apache request object
# Andrew Ho ([EMAIL PROTECTED])
#
# Copyright (c) 2001 Tellme Networks, Inc.
# All rights reserved.
#
# Last modified March 20, 2001
# ========================================================================
use strict;
package Apache;
require 5.6.0;
use Tie::IxHash;
use vars qw($VERSION);
$VERSION = 1.0;
sub access_or_mutate {
my $self = shift;
my $key = shift;
my $value = shift;
$self->{$key} = $value if $value;
return $self->{$key};
}
sub request {
my $class = shift;
my $self = {};
$self->{headers_in} = {};
tie %{$self->{headers_in}}, 'Tie::IxHash';
$self->{headers_out} = {};
tie %{$self->{headers_out}}, 'Tie::IxHash';
$self->{headers_out}->{Server} = 'Schmapache 1.0';
$self->{apr_param} = {};
$self->{apr_cookie} = {};
if(-t STDIN && -t STDOUT) {
print "(offline mode: enter name=value pairs on standard input)\n";
while(<STDIN>) {
chomp if defined $_;
s/^[\?&]+//;
while($_ && s/^([^&]+)\&*//) {
my($key, $value) = split(/=/, $1, 2);
if(defined($key) && defined($value)) {
$self->{apr_param}->{$key} = $value;
} elsif($1) {
$self->{apr_param}->{$1} = undef;
}
}
}
}
return bless $self, $class;
}
sub as_string {
my $self = shift;
print "as_string()\n";
}
sub main { undef }
sub prev { undef }
sub next { undef }
sub last { undef }
sub is_main { 1 }
sub is_initial_req { 1 }
sub method { shift->access_or_mutate(@_) }
sub header_only { return }
sub protocol { 'HTTP/1.0' }
sub print {
my $self = shift;
CORE::print @_ if @_;
}
sub header_out {
my $self = shift;
my($key, $value) = @_;
die 'usage: $r->header_out($key => $value)' unless $key && $value;
$self->{headers_out}->{$key} = $value;
}
sub send_http_header {
my $self = shift;
while(my($key, $value) = each %{$self->{headers_out}}) {
print $key, ': ', $value, "\n";
}
print "\n";
}
sub content_type { shift->header_out( 'Content-Type' => shift ) }
sub content_encoding { shift->header_out( 'Content-Encoding' => shift ) }
# ------------------------------------------------------------------------
# Fake out Apache::Request as well
package Apache::Request;
use Apache::Constants qw(:common);
use vars qw(@ISA);
@ISA = qw(Apache);
sub new {
my $class = shift;
my $r = shift;
$r->{apr_param} = {} unless exists $r->{apr_param};
return bless $r, $class;
}
sub instance { &new }
sub parse { OK }
sub param {
my $self = shift;
my $key = shift;
my $value = shift;
if($value) {
$self->{apr_param}->{$key} = $value;
}
if(exists $self->{apr_param}->{$key}) {
return $self->{apr_param}->{$key};
} else {
return;
}
}
# ------------------------------------------------------------------------
# Fake out Apache::Cookie, too
package Apache::Cookie;
use CGI::Cookie;
sub new {
my $class = shift;
my $r = shift;
my $cookie = CGI::Cookie->new(@_);
bless [ $r, $cookie ], $class;
}
sub fetch {
my $self = shift;
return ();
}
sub bake {
my $self = shift;
$self->[0]->header_out('Set-Cookie' => $self->[1]->as_string);
}
# ------------------------------------------------------------------------
# Run a file, or STDIN
package main;
$0 = @ARGV ? $ARGV[0] : 'stdin'; # Fake out $0 for error rporting
my $code;
{
local $/ = undef;
$code = <>;
}
if($code) {
# Prevent real modules from being loaded by setting
# a fake "location" in %INC
$INC{'Apache'} = 'eval';
$INC{'Apache.pm'} = 'eval';
$INC{'Apache/Request'} = 'eval';
$INC{'Apache/Request.pm'} = 'eval';
$INC{'Apache/Cookie'} = 'eval';
$INC{'Apache/Cookie.pm'} = 'eval';
eval "$code";
die $@ if $@;
}
exit 0;
# ========================================================================
