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/10/29 21:53:34 UTC
cvs commit: modperl/t/net/perl tie_table.pl
dougm 98/10/29 12:53:34
Modified: . Changes MANIFEST Makefile.PL ToDo
Apache typemap
src/modules/perl mod_perl.h perl_util.c
t/net/perl tie_table.pl
Added: Table Makefile.PL Table.pm
src/modules/perl Table.xs
Removed: Tie .cvsignore Makefile.PL Tie.pm
src/modules/perl Tie.xs
Log:
rename Apache::Tie/Apache::TieHashTable -> Apache::Table
Revision Changes Path
1.183 +2 -0 modperl/Changes
Index: Changes
===================================================================
RCS file: /export/home/cvs/modperl/Changes,v
retrieving revision 1.182
retrieving revision 1.183
diff -u -r1.182 -r1.183
--- Changes 1998/10/29 19:04:36 1.182
+++ Changes 1998/10/29 20:53:24 1.183
@@ -8,6 +8,8 @@
=item 1.16_01-dev
+rename Apache::Tie/Apache::TieHashTable -> Apache::Table
+
Apache::PerlRun::handler will explicitly undef subroutines before
"flushing" the namespace [Gunther Birznieks <gu...@nhgri.nih.gov>]
1.47 +4 -4 modperl/MANIFEST
Index: MANIFEST
===================================================================
RCS file: /export/home/cvs/modperl/MANIFEST,v
retrieving revision 1.46
retrieving revision 1.47
diff -u -r1.46 -r1.47
--- MANIFEST 1998/10/23 00:19:48 1.46
+++ MANIFEST 1998/10/29 20:53:24 1.47
@@ -79,7 +79,7 @@
src/modules/perl/Log.xs
src/modules/perl/URI.xs
src/modules/perl/Util.xs
-src/modules/perl/Tie.xs
+src/modules/perl/Table.xs
src/modules/perl/ldopts
src/modules/perl/mod_perl.c
src/modules/perl/mod_perl.h
@@ -137,8 +137,8 @@
t/internal/rwrite.t
t/internal/stacked.t
#t/internal/resolver.t
+t/internal/table.t
t/internal/taint.t
-t/internal/tie.t
t/net/perl/module.pl
t/net/perl/file.pl
t/net/perl/log.pl
@@ -202,8 +202,8 @@
faq/mod_perl_faq.pod
faq/mjtg-news.txt
htdocs/manual/mod/mod_perl.html
-Tie/Makefile.PL
-Tie/Tie.pm
+Table/Makefile.PL
+Table/Table.pm
apaci/Makefile.libdir
apaci/Makefile.tmpl
apaci/README
1.105 +1 -1 modperl/Makefile.PL
Index: Makefile.PL
===================================================================
RCS file: /export/home/cvs/modperl/Makefile.PL,v
retrieving revision 1.104
retrieving revision 1.105
diff -u -r1.104 -r1.105
--- Makefile.PL 1998/10/29 19:04:36 1.104
+++ Makefile.PL 1998/10/29 20:53:24 1.105
@@ -592,7 +592,7 @@
$callback_hooks{PERL_DIRECTIVE_HANDLERS} = 1;
}
if($PERL_TABLE_API) {
- push @xs_modules, "Apache::Tie";
+ push @xs_modules, "Apache::Table";
$callback_hooks{PERL_TABLE_API} = 1;
}
if($PERL_RUN_XS or $experimental{PERL_RUN_XS} > 1) {
1.109 +0 -2 modperl/ToDo
Index: ToDo
===================================================================
RCS file: /export/home/cvs/modperl/ToDo,v
retrieving revision 1.108
retrieving revision 1.109
diff -u -r1.108 -r1.109
--- ToDo 1998/10/29 19:04:37 1.108
+++ ToDo 1998/10/29 20:53:24 1.109
@@ -5,8 +5,6 @@
- top-level PerlSetEnv isn't set for PerlChildInitHandler w/ 5.005_02
-- rename Apache::Tie/Apache::TieHashTable -> Apache::Table
-
- looks like we need a per-server configuration merge routine
- Andrew Ford's Apache::FakeRequest patch
1.9 +2 -2 modperl/Apache/typemap
Index: typemap
===================================================================
RCS file: /export/home/cvs/modperl/Apache/typemap,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- typemap 1998/08/29 01:11:48 1.8
+++ typemap 1998/10/29 20:53:27 1.9
@@ -5,11 +5,11 @@
Apache::Connection T_PTROBJ
Apache::Server T_PTROBJ
Apache::ModuleConfig T_PTROBJ
-Apache::Table T_PTROBJ
Apache::Module T_PTROBJ
Apache::Handler T_PTROBJ
Apache::Command T_PTROBJ
-Apache::TieHashTable T_TABLEOBJ
+Apache::Table T_TABLEOBJ
+Apache::table T_PTROBJ
pid_t T_IV
Apache::Scoreboard O_HvRV
Apache::URI T_PTROBJ
1.1 modperl/Table/Makefile.PL
Index: Makefile.PL
===================================================================
use ExtUtils::MakeMaker;
use lib qw(../lib);
use Apache::src ();
my $src = Apache::src->new;
WriteMakefile(
'NAME' => 'Apache::Table',
'VERSION_FROM' => 'Table.pm',
'INC' => $src->inc,
'TYPEMAPS' => $src->typemaps,
);
1.1 modperl/Table/Table.pm
Index: Table.pm
===================================================================
package Apache::Table;
use strict;
use DynaLoader ();
use vars qw(@ISA $VERSION);
@ISA = qw(DynaLoader);
$VERSION = '0.01';
if($ENV{MOD_PERL}) {
__PACKAGE__->bootstrap($VERSION);
}
*DESTROY = \&destroy; #avoid weird xsubpp bug
1;
__END__
=head1 NAME
Apache::Table - Perl interface to the Apache table structure
=head1 SYNOPSIS
my $headers_out = $r->headers_out;
while(my($key,$val) = each %$headers_out) {
...
}
my $table = $r->headers_out;
$table->set(From => 'dougm@perl.apache.org');
mod_perl needs to be compiled with at least one of the following options:
DYNAMIC=1
PERL_TABLE_API=1
EVERYTHING=1
=head1 DESCRIPTION
This module provides tied interfaces to Apache data structures.
=head2 CLASSES
=over 4
=item Apache::Table
The I<Apache::Table> class provides methods for interfacing
with the Apache C<table> structure.
The following I<Apache> class methods, when called in a scalar context
with no "key" argument, will return a I<HASH> reference blessed into the
I<Apache::Table> class and where I<HASH> is tied to
I<Apache::Table>:
headers_in
headers_out
err_headers_out
notes
dir_config
subprocess_env
=head2 METHODS
=over 4
=item get
Corresponds to the C<ap_table_get> function.
my $value = $table->get($key);
my $value = $headers_out->{$key};
=item set
Corresponds to the C<ap_table_set> function.
$table->set($key, $value);
$headers_out->{$key} = $value;
=item unset
Corresponds to the C<ap_table_unset> function.
$table->unset($key);
delete $headers_out->{$key};
=item clear
Corresponds to the C<ap_table_clear> function.
$table->clear;
%$headers_out = ();
=item add
Corresponds to the C<ap_table_add> function.
$table->add($key, $value);
=item merge
Corresponds to the C<ap_table_merge> function.
$table->merge($key, $value);
=back
=back
=head1 AUTHOR
Doug MacEachern
=head1 SEE ALSO
Apache(3), mod_perl(3)
=cut
1.56 +9 -1 modperl/src/modules/perl/mod_perl.h
Index: mod_perl.h
===================================================================
RCS file: /export/home/cvs/modperl/src/modules/perl/mod_perl.h,v
retrieving revision 1.55
retrieving revision 1.56
diff -u -r1.55 -r1.56
--- mod_perl.h 1998/10/29 19:04:38 1.55
+++ mod_perl.h 1998/10/29 20:53:31 1.56
@@ -182,12 +182,20 @@
#undef NO_PERL_RESTART
#endif
+typedef struct {
+ table *table;
+ array_header *arr;
+ table_entry *elts;
+ int ix;
+} TiedTable;
+
typedef request_rec * Apache;
typedef request_rec * Apache__SubRequest;
typedef conn_rec * Apache__Connection;
typedef server_rec * Apache__Server;
typedef cmd_parms * Apache__CmdParms;
-typedef table * Apache__Table;
+typedef TiedTable * Apache__Table;
+typedef table * Apache__table;
typedef module * Apache__Module;
typedef handler_rec * Apache__Handler;
typedef command_rec * Apache__Command;
1.19 +4 -4 modperl/src/modules/perl/perl_util.c
Index: perl_util.c
===================================================================
RCS file: /export/home/cvs/modperl/src/modules/perl/perl_util.c,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -r1.18 -r1.19
--- perl_util.c 1998/10/26 20:53:07 1.18
+++ perl_util.c 1998/10/29 20:53:31 1.19
@@ -217,11 +217,11 @@
HV *hv;
SV *sv = sv_newmortal();
iniHV(hv);
- sv_setref_pv(sv, "Apache::Table", (void*)t);
- perl_qrequire_module("Apache::Tie");
- perl_tie_hash(hv, "Apache::TieHashTable", sv);
+ sv_setref_pv(sv, "Apache::table", (void*)t);
+ perl_qrequire_module("Apache::Table");
+ perl_tie_hash(hv, "Apache::Table", sv);
return sv_bless(newRV_noinc((SV*)hv),
- gv_stashpv("Apache::TieHashTable", TRUE));
+ gv_stashpv("Apache::Table", TRUE));
}
SV *perl_hvrv_magic_obj(SV *rv)
1.1 modperl/src/modules/perl/Table.xs
Index: Table.xs
===================================================================
#include "mod_perl.h"
typedef struct {
SV *sv;
SV *cv;
HV *hv;
} TableDo;
static int Apache_table_do(TableDo *td, const char *key, const char *val)
{
int count=0, rv=1;
dSP;
if(td->hv && !hv_exists(td->hv, (char*)key, strlen(key)))
return 1;
ENTER;SAVETMPS;
PUSHMARK(sp);
if(td->sv && (td->sv != &sv_undef))
XPUSHs(td->sv);
XPUSHs(sv_2mortal(newSVpv((char *)key,0)));
XPUSHs(sv_2mortal(newSVpv((char *)val,0)));
PUTBACK;
count = perl_call_sv(td->cv, G_SCALAR);
SPAGAIN;
if(count == 1)
rv = POPi;
PUTBACK;
FREETMPS;LEAVE;
return rv;
}
static void table_modify(TiedTable *self, const char *key, SV *sv,
void (*tabfunc) (table *, const char *, const char *))
{
const char *val;
if(!self->table) return;
if(SvROK(sv) && (SvTYPE(SvRV(sv)) == SVt_PVAV)) {
I32 i;
AV *av = (AV*)SvRV(sv);
for(i=0; i<=AvFILL(av); i++) {
val = (const char *)SvPV(*av_fetch(av, i, FALSE),na);
(*tabfunc)(self->table, key, val);
}
}
else {
val = (const char *)SvPV(sv,na);
(*tabfunc)(self->table, key, val);
}
}
MODULE = Apache::Table PACKAGE = Apache::Table
PROTOTYPES: DISABLE
BOOT:
items = items; /*avoid warning*/
Apache::Table
TIEHASH(class, table)
SV *class
Apache::table table
CODE:
if(!class) XSRETURN_UNDEF;
RETVAL = (Apache__Table)safemalloc(sizeof(TiedTable));
RETVAL->table = table;
RETVAL->ix = 0;
RETVAL->elts = NULL;
RETVAL->arr = NULL;
OUTPUT:
RETVAL
void
destroy(self)
Apache::Table self
CODE:
safefree(self);
void
FETCH(self, key)
Apache::Table self
const char *key
ALIAS:
get = 1
PPCODE:
ix = ix; /*avoid warning*/
if(!self->table) XSRETURN_UNDEF;
if(GIMME == G_SCALAR) {
const char *val = table_get(self->table, key);
if (val) XPUSHs(sv_2mortal(newSVpv((char*)val,0)));
else XSRETURN_UNDEF;
}
else {
int i;
array_header *arr = table_elts(self->table);
table_entry *elts = (table_entry *)arr->elts;
for (i = 0; i < arr->nelts; ++i) {
if (!elts[i].key || strcasecmp(elts[i].key, key)) continue;
XPUSHs(sv_2mortal(newSVpv(elts[i].val,0)));
}
}
bool
EXISTS(self, key)
Apache::Table self
const char *key
CODE:
if(!self->table) XSRETURN_UNDEF;
RETVAL = table_get(self->table, key) ? TRUE : FALSE;
OUTPUT:
RETVAL
const char*
DELETE(self, key)
Apache::Table self
const char *key
ALIAS:
unset = 1
PREINIT:
I32 gimme = GIMME_V;
CODE:
ix = ix;
if(!self->table) XSRETURN_UNDEF;
RETVAL = NULL;
if(gimme != G_VOID)
RETVAL = table_get(self->table, key);
table_unset(self->table, key);
if(!RETVAL) XSRETURN_UNDEF;
OUTPUT:
RETVAL
void
STORE(self, key, val)
Apache::Table self
const char *key
const char *val
ALIAS:
set = 1
CODE:
ix = ix; /*avoid warning*/
if(!self->table) XSRETURN_UNDEF;
table_set(self->table, key, val);
void
CLEAR(self)
Apache::Table self
ALIAS:
clear = 1
CODE:
ix = ix; /*avoid warning*/
if(!self->table) XSRETURN_UNDEF;
clear_table(self->table);
const char *
NEXTKEY(self, lastkey=Nullsv)
Apache::Table self
SV *lastkey
CODE:
if(self->ix >= self->arr->nelts) XSRETURN_UNDEF;
RETVAL = self->elts[self->ix++].key;
OUTPUT:
RETVAL
const char *
FIRSTKEY(self)
Apache::Table self
CODE:
if(!self->table) XSRETURN_UNDEF;
self->arr = table_elts(self->table);
if(!self->arr->nelts) XSRETURN_UNDEF;
self->elts = (table_entry *)self->arr->elts;
self->ix = 0;
RETVAL = self->elts[self->ix++].key;
OUTPUT:
RETVAL
void
add(self, key, sv)
Apache::Table self
const char *key
SV *sv;
CODE:
table_modify(self, key, sv, table_add);
void
merge(self, key, sv)
Apache::Table self
const char *key
SV *sv
CODE:
table_modify(self, key, sv, table_merge);
void
do(self, cv, sv=Nullsv, ...)
Apache::Table self
SV *cv
SV *sv
PREINIT:
TableDo td;
HV *hv = Nullhv;
CODE:
if(items > 3) {
int i;
STRLEN len;
hv = newHV();
for(i=3; ; i++) {
char *key = SvPV(ST(i),len);
hv_store(hv, key, len, newSViv(1), FALSE);
if(i == (items - 1)) break;
}
}
td.sv = sv;
td.cv = cv;
td.hv = hv;
table_do((int (*) (void *, const char *, const char *)) Apache_table_do,
(void *) &td, self->table, NULL);
if(hv) SvREFCNT_dec(hv);
1.7 +2 -2 modperl/t/net/perl/tie_table.pl
Index: tie_table.pl
===================================================================
RCS file: /export/home/cvs/modperl/t/net/perl/tie_table.pl,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- tie_table.pl 1998/09/01 20:03:38 1.6
+++ tie_table.pl 1998/10/29 20:53:33 1.7
@@ -13,7 +13,7 @@
my $table = tied %$headers_in;
test ++$i, UNIVERSAL::isa($headers_in, 'HASH');
-test ++$i, $table->isa('Apache::TieHashTable');
+test ++$i, $table->isa('Apache::Table');
test ++$i, $table->get('User-Agent');
test ++$i, $r->headers_in->get('User-Agent');
test ++$i, $headers_in->{'User-Agent'};
@@ -119,5 +119,5 @@
print "TOTAL: ", scalar keys %$hash_ref, "\n\n";
test ++$i, UNIVERSAL::isa($hash_ref, 'HASH');
- test ++$i, $tab->isa('Apache::TieHashTable');
+ test ++$i, $tab->isa('Apache::Table');
}