You are viewing a plain text version of this content. The canonical link for it is here.
Posted to modperl-cvs@perl.apache.org by do...@hyperreal.org on 1998/07/17 22:48:43 UTC
cvs commit: modperl/t/net/perl uri.pl
dougm 98/07/17 13:48:43
Modified: . Changes MANIFEST Makefile.PL ToDo
apache-modlist.html
Apache typemap
src/modules/perl Apache.xs
Added: URI .cvsignore Makefile.PL URI.pm
src/modules/perl URI.xs
t/modules uri.t
t/net/perl uri.pl
Log:
added Apache::URI module (enable with PERL_URI_API=1 or EVERYTHING=1)
Revision Changes Path
1.78 +3 -1 modperl/Changes
Index: Changes
===================================================================
RCS file: /export/home/cvs/modperl/Changes,v
retrieving revision 1.77
retrieving revision 1.78
diff -u -r1.77 -r1.78
--- Changes 1998/07/17 15:23:02 1.77
+++ Changes 1998/07/17 20:48:34 1.78
@@ -7,7 +7,9 @@
=over 3
=item 1.13_01-dev
-
+
+added Apache::URI module (enable with PERL_URI_API=1 or EVERYTHING=1)
+
register_cleanup to SvREFCNT_dec handler stacks, otherwise we leak
during kill -USR1 when configuration is re-read
1.26 +5 -0 modperl/MANIFEST
Index: MANIFEST
===================================================================
RCS file: /export/home/cvs/modperl/MANIFEST,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -r1.25 -r1.26
--- MANIFEST 1998/07/14 14:57:05 1.25
+++ MANIFEST 1998/07/17 20:48:35 1.26
@@ -5,6 +5,8 @@
ModuleConfig/Makefile.PL
Log/Makefile.PL
Log/Log.pm
+URI/Makefile.PL
+URI/URI.pm
CREDITS
INSTALL
INSTALL.apaci
@@ -60,6 +62,7 @@
src/modules/perl/Apache.xs
src/modules/perl/ModuleConfig.xs
src/modules/perl/Log.xs
+src/modules/perl/URI.xs
src/modules/perl/Tie.xs
src/modules/perl/ldopts
src/modules/perl/mod_perl.c
@@ -87,6 +90,7 @@
t/modules/embperl.t
t/modules/httpdconf.t
t/modules/log.t
+t/modules/uri.t
t/modules/psections.t
t/modules/perlrun.t
t/modules/include.t
@@ -111,6 +115,7 @@
t/internal/taint.t
t/internal/tie.t
t/net/perl/log.pl
+t/net/perl/uri.pl
t/net/perl/file_upload.cgi
t/net/perl/tie_table.pl
t/net/perl/qredirect.pl
1.66 +17 -8 modperl/Makefile.PL
Index: Makefile.PL
===================================================================
RCS file: /export/home/cvs/modperl/Makefile.PL,v
retrieving revision 1.65
retrieving revision 1.66
diff -u -r1.65 -r1.66
--- Makefile.PL 1998/07/15 15:05:13 1.65
+++ Makefile.PL 1998/07/17 20:48:35 1.66
@@ -149,6 +149,7 @@
$PERL_DIRECTIVE_HANDLERS = 0;
$PERL_TIE_TABLES = 0;
$PERL_LOG_API = 0;
+$PERL_URI_API = 0;
my %experimental = map { $_,1 } qw{
PERL_GET_SET_HANDLERS
PERL_MARK_WHERE
@@ -191,6 +192,7 @@
PERL_DIRECTIVE_HANDLERS
PERL_TIE_TABLES
PERL_LOG_API
+ PERL_URI_API
};
$callback_alias{PERL_INIT} = "PERL_HEADER_PARSER";
@@ -267,7 +269,7 @@
if($EVERYTHING) {
@callback_hooks{qw(PERL_STACKED_HANDLERS PERL_METHOD_HANDLERS)} = (1) x 2;
- for(qw(ALL_HOOKS PERL_SSI PERL_SECTIONS PERL_TIE_TABLES PERL_DIRECTIVE_HANDLERS PERL_LOG_API)) {
+ for(qw(ALL_HOOKS PERL_SSI PERL_SECTIONS PERL_TIE_TABLES PERL_DIRECTIVE_HANDLERS PERL_LOG_API PERL_URI_API)) {
$$_ = 1;
}
}
@@ -281,7 +283,8 @@
}
if($DYNAMIC) {
- $PERL_DIRECTIVE_HANDLERS = $PERL_TIE_TABLES = $PERL_LOG_API = 1;
+ $PERL_DIRECTIVE_HANDLERS = $PERL_TIE_TABLES =
+ $PERL_LOG_API = $PERL_URI_API = 1;
}
my @xs_modules = qw(Apache Apache::Constants);
@@ -355,9 +358,11 @@
$USE_APACI = $USE_DSO = 0;
}
- if(($mmn < MMN_130) and $PERL_LOG_API) { #1.3.0
- $PERL_LOG_API = 0;
- $cant_hook{PERL_LOG_API} = "(need 1.3.0 or higher)";
+ for (qw(PERL_LOG_API PERL_URI_API)) {
+ if(($mmn < MMN_130) and $$_) { #1.3.0
+ $$_ = 0;
+ $cant_hook{$_} = "(need 1.3.0 or higher)";
+ }
}
unless ($DO_HTTPD or $NO_HTTPD) {
$ans = _prompt("Shall I build httpd in $adir for you?", "y");
@@ -497,9 +502,13 @@
push @xs_modules, "Apache::Tie";
$callback_hooks{PERL_TIE_TABLES} = 1;
}
-if($PERL_LOG_API) {
- push @xs_modules, "Apache::Log";
- $callback_hooks{PERL_LOG_API} = 1;
+
+for (qw(Log URI)) {
+ my $s = "PERL_".uc($_)."_API";
+ if($$s) {
+ push @xs_modules, "Apache::$_";
+ $callback_hooks{$s} = 1;
+ }
}
my @xs_mod_snames = map { (my $s = $_) =~ s/.*:://; $s } @xs_modules;
1.45 +0 -2 modperl/ToDo
Index: ToDo
===================================================================
RCS file: /export/home/cvs/modperl/ToDo,v
retrieving revision 1.44
retrieving revision 1.45
diff -u -r1.44 -r1.45
--- ToDo 1998/07/17 14:01:23 1.44
+++ ToDo 1998/07/17 20:48:35 1.45
@@ -133,8 +133,6 @@
from http_main.c)
Doug Bagley <do...@dejanews.com>
-- Apache::URI interface to uri_components structure
-
- provide namespace protection when 'use Foo' might be two different modules
i.e. re-visit Apache::Safe
1.27 +2 -1 modperl/apache-modlist.html
Index: apache-modlist.html
===================================================================
RCS file: /export/home/cvs/modperl/apache-modlist.html,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -r1.26 -r1.27
--- apache-modlist.html 1998/07/17 19:32:25 1.26
+++ apache-modlist.html 1998/07/17 20:48:35 1.27
@@ -7,7 +7,7 @@
<h1>The Apache/Perl Module List</h1>
Maintained by <a href="mailto:dougm@pobox.com">Doug MacEachern</a>,
-<br><i> $Revision: 1.26 $ $Date: 1998/07/17 19:32:25 $</i>
+<br><i> $Revision: 1.27 $ $Date: 1998/07/17 20:48:35 $</i>
<h3>Contents</h3>
<a href="#intro">Introduction</a><br>
@@ -178,6 +178,7 @@
Servlet ampO Interface to the Java Servlet engine IKLUFT
Sfio cmcO Interface to r->connection->client->sf* DOUGM
Tie bmcO Tie interfaces to Apache structures APML
+URI bmfO URI component parsing and unparsing APML
Util cmcf Interface to Apache's util*.c functions APML
* Development and Debug tools
1.7 +1 -0 modperl/Apache/typemap
Index: typemap
===================================================================
RCS file: /export/home/cvs/modperl/Apache/typemap,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- typemap 1998/06/07 17:58:47 1.6
+++ typemap 1998/07/17 20:48:37 1.7
@@ -9,6 +9,7 @@
Apache::TieHashTable T_TABLEOBJ
pid_t T_IV
Apache::Scoreboard O_HvRV
+Apache::URI T_PTROBJ
# "perlobject.map" Dean Roehrich, version 19960302
#
1.1 modperl/URI/.cvsignore
Index: .cvsignore
===================================================================
Makefile
pm_to_blib
1.1 modperl/URI/Makefile.PL
Index: Makefile.PL
===================================================================
use ExtUtils::MakeMaker;
use Config;
$apache_1_3_inc = join ' ', map {
join '', ' -I../$(APACHE_SRC)/', $_, ' -I$(APACHE_SRC)/', $_;
} qw(include main os/unix);
WriteMakefile(
NAME => "Apache::URI",
VERSION_FROM => "URI.pm",
INC => '-I../src -I../src/modules/perl -I$(APACHE_SRC) -I../$(APACHE_SRC) '.$apache_1_3_inc,
);
1.1 modperl/URI/URI.pm
Index: URI.pm
===================================================================
package Apache::URI;
use strict;
use DynaLoader ();
@Apache::URI::ISA = qw(DynaLoader);
$Apache::URI::VERSION = '1.00';
if ($ENV{MOD_PERL}) {
bootstrap Apache::URI $Apache::URI::VERSION;
}
1;
__END__
=head1 NAME
Apache::URI - URI component parsing and unparsing
=head1 SYNOPSIS
use Apache::URI ();
my $uri = $r->parsed_uri;
my $uri = Apache::URI->parse($r, "http://perl.apache.org/");
=head1 DESCRIPTION
This module provides an interface to the Apache I<util_uri> module and
the I<uri_components> structure.
=head1 METHODS
=over 4
=item Apache::parsed_uri
Apache will have already parsed the requested uri components, which can
be obtained via the I<parsed_uri> method defined in the I<Apache> class.
This method returns an object blessed into the I<Apache::URI> class.
my $uri = $r->parsed_uri;
=item parse
This method will parse a URI string into uri components which are stashed
in the I<Apache::URI> object it returns.
my $uri = Apache::URI->parse($r, "http://www.foo.com/path/file.html?query+string");
This method is considerably faster than using I<URI::URL>:
timethese(5000, {
C => sub { Apache::URI->parse($r, $test_uri) },
Perl => sub { URI::URL->new($test_uri) },
});
Benchmark: timing 5000 iterations of C, Perl...
C: 1 secs ( 0.62 usr 0.04 sys = 0.66 cpu)
Perl: 6 secs ( 6.21 usr 0.08 sys = 6.29 cpu)
=item unparse
This method will join the uri components back into a string version.
my $string = $uri->unparse;
=item scheme
my $scheme = $uri->scheme;
=item hostinfo
my $hostinfo = $uri->hostinfo;
=item user
my $user = $uri->user;
=item password
my $password = $uri->password;
=item hostname
my $hostname = $uri->hostname;
=item port
my $port = $uri->port;
=item path
my $path = $uri->path;
=item rpath
Returns the I<path> minus I<path_info>.
my $path = $uri->rpath;
=item query
my $query = $uri->query;
=item fragment
my $fragment = $uri->fragment;
=back
=head1 AUTHOR
Doug MacEachern
=head1 SEE ALSO
perl(1).
=cut
1.42 +4 -2 modperl/src/modules/perl/Apache.xs
Index: Apache.xs
===================================================================
RCS file: /export/home/cvs/modperl/src/modules/perl/Apache.xs,v
retrieving revision 1.41
retrieving revision 1.42
diff -u -r1.41 -r1.42
--- Apache.xs 1998/07/17 14:01:25 1.41
+++ Apache.xs 1998/07/17 20:48:39 1.42
@@ -1032,7 +1032,8 @@
}
if(sent < 0) {
mod_perl_debug(r->server, "mod_perl: rwrite returned -1");
- break;
+ if(r->connection->aborted) break;
+ else continue;
}
len -= sent;
RETVAL += sent;
@@ -1040,7 +1041,8 @@
#else
if((sent = rwrite(buffer, len, r)) < 0) {
mod_perl_debug(r->server, "mod_perl: rwrite returned -1");
- break;
+ if(r->connection->aborted) break;
+ else continue;
}
RETVAL += sent;
#endif
1.1 modperl/src/modules/perl/URI.xs
Index: URI.xs
===================================================================
#ifdef MOD_PERL
#include "mod_perl.h"
#else
#include "modules/perl/mod_perl.h"
#endif
typedef struct {
uri_components uri;
pool *pool;
request_rec *r;
char *path_info;
} XS_Apache__URI;
typedef XS_Apache__URI * Apache__URI;
MODULE = Apache::URI PACKAGE = Apache
PROTOTYPES: DISABLE
BOOT:
items = items; /*avoid warning*/
Apache::URI
parsed_uri(r)
Apache r
CODE:
RETVAL = (Apache__URI)safemalloc(sizeof(XS_Apache__URI));
RETVAL->uri = r->parsed_uri;
RETVAL->pool = r->pool;
RETVAL->r = r;
RETVAL->path_info = r->path_info;
OUTPUT:
RETVAL
MODULE = Apache::URI PACKAGE = Apache::URI
void
DESTROY(uri)
Apache::URI uri
CODE:
safefree(uri);
Apache::URI
parse(self, r, uri)
SV *self
Apache r
const char *uri
CODE:
self = self; /* -Wall */
RETVAL = (Apache__URI)safemalloc(sizeof(XS_Apache__URI));
(void)ap_parse_uri_components(r->pool, uri, &RETVAL->uri);
RETVAL->pool = r->pool;
RETVAL->r = r;
RETVAL->path_info = NULL;
OUTPUT:
RETVAL
char *
unparse(uri, flags=UNP_OMITPASSWORD)
Apache::URI uri
unsigned flags
CODE:
RETVAL = ap_unparse_uri_components(uri->pool, &uri->uri, flags);
OUTPUT:
RETVAL
SV *
rpath(uri)
Apache::URI uri
CODE:
if(uri->path_info) {
int uri_len = strlen(uri->uri.path);
int n = strlen(uri->path_info);
int set = uri_len - n;
if(set > 0)
RETVAL = newSVpv(uri->uri.path, set);
}
else
RETVAL = newSVpv(uri->uri.path, 0);
OUTPUT:
RETVAL
char *
scheme(uri, set=Nullsv)
Apache::URI uri
SV *set
CODE:
RETVAL = uri->uri.scheme;
if(set)
uri->uri.scheme = SvPV(set,na);
OUTPUT:
RETVAL
char *
hostinfo(uri, set=Nullsv)
Apache::URI uri
SV *set
CODE:
RETVAL = uri->uri.hostinfo;
if(set)
uri->uri.hostinfo = SvPV(set,na);
OUTPUT:
RETVAL
char *
user(uri, set=Nullsv)
Apache::URI uri
SV *set
CODE:
RETVAL = uri->uri.user;
if(set)
uri->uri.user = SvPV(set,na);
OUTPUT:
RETVAL
char *
password(uri, set=Nullsv)
Apache::URI uri
SV *set
CODE:
RETVAL = uri->uri.password;
if(set)
uri->uri.password = SvPV(set,na);
OUTPUT:
RETVAL
char *
hostname(uri, set=Nullsv)
Apache::URI uri
SV *set
CODE:
RETVAL = uri->uri.hostname;
if(set)
uri->uri.hostname = SvPV(set,na);
OUTPUT:
RETVAL
char *
path(uri, set=Nullsv)
Apache::URI uri
SV *set
CODE:
RETVAL = uri->uri.path;
if(set)
uri->uri.path = SvPV(set,na);
OUTPUT:
RETVAL
char *
query(uri, set=Nullsv)
Apache::URI uri
SV *set
CODE:
RETVAL = uri->uri.query;
if(set)
uri->uri.query = SvPV(set,na);
OUTPUT:
RETVAL
char *
fragment(uri, set=Nullsv)
Apache::URI uri
SV *set
CODE:
RETVAL = uri->uri.fragment;
if(set)
uri->uri.fragment = SvPV(set,na);
OUTPUT:
RETVAL
char *
port(uri, set=Nullsv)
Apache::URI uri
SV *set
CODE:
RETVAL = uri->uri.port_str;
if(set)
uri->uri.port_str = SvPV(set,na);
OUTPUT:
RETVAL
char *
path_info(uri, set=Nullsv)
Apache::URI uri
SV *set
CODE:
RETVAL = uri->path_info;
if(set)
uri->path_info = SvPV(set,na);
OUTPUT:
RETVAL
1.1 modperl/t/modules/uri.t
Index: uri.t
===================================================================
use Apache::test;
print fetch "http://$net::httpserver$net::perldir/uri.pl";
1.1 modperl/t/net/perl/uri.pl
Index: uri.pl
===================================================================
use strict;
use Apache::test;
$|++;
my $i = 0;
my $r = shift;
$r->send_http_header('text/plain');
eval {
require Apache::URI;
};
if($@) {
print "$@\n";
print "1..0\n";
return;
}
my (@methods) = qw{
scheme
hostinfo
user
password
hostname
path
rpath
query
fragment
port
unparse
};
my $tests = (@methods * 2) * 2;
print "1..$tests\n";
my $test_uri = "http://perl.apache.org:80/dist/apache-modlist.html";
for (1,2) {
for my $uri ($r->parsed_uri, Apache::URI->parse($r, $test_uri)) {
print "URI=", $uri->unparse, "\n";
for my $meth (@methods) {
my $val = $uri->$meth();
test ++$i, $val || 1;
$val ||= "";
print "$meth = `$val'\n";
}
}
}