You are viewing a plain text version of this content. The canonical link for it is here.
Posted to dev@perl.apache.org by Geoffrey Young <ge...@modperlcookbook.org> on 2003/05/09 16:28:59 UTC
Re: DECLINE_CMD (take 3)
ok, here's take 3.
re:
if ($name eq 'DECLINE_CMD' || $name eq 'DIR_MAGIC_TYPE') {
print $c_fh <<EOF;
return newSVpv($alias{$name}, 0);
EOF
I think it's proper to use newSVpv instead of newSVpvn - because the length in question is
the length of the constant (not the name), presupposing we know the length of DECLINE_CMD
beforehand seems wrong (if we knew the value of the constants then why have a lookup
function :). it also allows us to simplify logic in Code.pm and add to the list of
exceptional string cases if they arise in the future.
anyway, here's the latest version. I hope I got the threading stuff right :)
--Geoff
Index: Changes
===================================================================
RCS file: /home/cvspublic/modperl-2.0/Changes,v
retrieving revision 1.184
diff -u -r1.184 Changes
--- Changes 9 May 2003 03:33:02 -0000 1.184
+++ Changes 9 May 2003 14:26:25 -0000
@@ -12,6 +12,9 @@
=item 1.99_10-dev
+implement DECLINE_CMD and DIR_MAGIC_TYPE constants
+[Geoffrey Young]
+
allow init filter handlers to call other methods than just $f->ctx [Stas]
Fix Apache::Reload to gracefully handle the case with empty Touchfiles
Index: lib/Apache/ParseSource.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/lib/Apache/ParseSource.pm,v
retrieving revision 1.42
diff -u -r1.42 ParseSource.pm
--- lib/Apache/ParseSource.pm 15 Apr 2003 02:22:41 -0000 1.42
+++ lib/Apache/ParseSource.pm 9 May 2003 14:26:25 -0000
@@ -156,8 +156,8 @@
satisfy => [qw{SATISFY_}],
remotehost => [qw{REMOTE_}],
http => [qw{HTTP_}],
-# config => [qw{DECLINE_CMD}],
-# types => [qw{DIR_MAGIC_TYPE}],
+ config => [qw{DECLINE_CMD}],
+ types => [qw{DIR_MAGIC_TYPE}],
override => [qw{OR_ ACCESS_CONF RSRC_CONF}],
log => [qw(APLOG_)],
},
Index: lib/ModPerl/Code.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/lib/ModPerl/Code.pm,v
retrieving revision 1.96
diff -u -r1.96 Code.pm
--- lib/ModPerl/Code.pm 24 Apr 2003 01:51:37 -0000 1.96
+++ lib/ModPerl/Code.pm 9 May 2003 14:26:25 -0000
@@ -769,7 +769,7 @@
my $package_len = length $package;
my $func = canon_func(qw(constants lookup), $postfix);
- my $proto = "int $func(const char *name)";
+ my $proto = "SV \*$func(pTHX_ const char *name)";
print $h_fh "$proto;\n";
@@ -804,7 +804,20 @@
print $c_fh <<EOF;
$ifdef[0]
if (strEQ(name, "$name")) {
- return $alias{$name};
+EOF
+
+ if ($name eq 'DECLINE_CMD' || $name eq 'DIR_MAGIC_TYPE') {
+ print $c_fh <<EOF;
+ return newSVpv($alias{$name}, 0);
+EOF
+ }
+ else {
+ print $c_fh <<EOF;
+ return newSViv($alias{$name});
+EOF
+ }
+
+ print $c_fh <<EOF;
}
$ifdef[1]
EOF
@@ -815,7 +828,7 @@
print $c_fh <<EOF
};
Perl_croak_nocontext("unknown constant %s", name);
- return MP_ENOCONST;
+ return newSViv(MP_ENOCONST);
}
EOF
}
Index: src/modules/perl/modperl_const.c
===================================================================
RCS file: /home/cvspublic/modperl-2.0/src/modules/perl/modperl_const.c,v
retrieving revision 1.8
diff -u -r1.8 modperl_const.c
--- src/modules/perl/modperl_const.c 22 Oct 2001 05:42:23 -0000 1.8
+++ src/modules/perl/modperl_const.c 9 May 2003 14:26:25 -0000
@@ -1,27 +1,27 @@
#include "mod_perl.h"
#include "modperl_const.h"
-typedef int (*constants_lookup)(const char *);
+typedef SV *(*constants_lookup)(pTHX_ const char *);
typedef const char ** (*constants_group_lookup)(const char *);
-static int new_constsub(pTHX_ constants_lookup lookup,
+static SV *new_constsub(pTHX_ constants_lookup lookup,
HV *caller_stash, HV *stash,
const char *name)
{
int name_len = strlen(name);
GV **gvp = (GV **)hv_fetch(stash, name, name_len, TRUE);
- int val;
+ SV *val;
/* dont redefine */
if (!isGV(*gvp) || !GvCV(*gvp)) {
- val = (*lookup)(name);
+ val = (*lookup)(aTHX_ name);
#if 0
fprintf(stderr, "newCONSTSUB(%s, %s, %d)\n",
HvNAME(stash), name, val);
#endif
- newCONSTSUB(stash, (char *)name, newSViv(val));
+ newCONSTSUB(stash, (char *)name, val);
#ifdef GvSHARED
GvSHARED_on(*gvp);
#endif
Index: src/modules/perl/modperl_module.c
===================================================================
RCS file: /home/cvspublic/modperl-2.0/src/modules/perl/modperl_module.c,v
retrieving revision 1.12
diff -u -r1.12 modperl_module.c
--- src/modules/perl/modperl_module.c 14 Apr 2003 06:38:50 -0000 1.12
+++ src/modules/perl/modperl_module.c 9 May 2003 14:26:25 -0000
@@ -669,7 +669,7 @@
}
else {
cmd->args_how =
- modperl_constants_lookup_apache(SvPV(val, len));
+ SvIV(modperl_constants_lookup_apache(aTHX_ SvPV(val, len)));
}
}
@@ -695,7 +695,7 @@
}
else {
cmd->req_override =
- modperl_constants_lookup_apache(SvPV(val, len));
+ SvIV(modperl_constants_lookup_apache(aTHX_ SvPV(val, len)));
}
}
Index: t/apache/constants.t
===================================================================
RCS file: /home/cvspublic/modperl-2.0/t/apache/constants.t,v
retrieving revision 1.5
diff -u -r1.5 constants.t
--- t/apache/constants.t 18 May 2002 02:29:44 -0000 1.5
+++ t/apache/constants.t 9 May 2003 14:26:25 -0000
@@ -5,10 +5,11 @@
use Test;
use Apache2 ();
-use Apache::Const -compile => qw(DECLINED :http :common TAKE23 &OPT_EXECCGI);
+use Apache::Const -compile => qw(DECLINED :http :common TAKE23 &OPT_EXECCGI
+ DECLINE_CMD DIR_MAGIC_TYPE);
use Apache::Const; #defaults to :common
-plan tests => 13;
+plan tests => 15;
ok REDIRECT == 302;
ok AUTH_REQUIRED == 401;
@@ -17,6 +18,8 @@
ok Apache::DECLINED == -1;
ok Apache::HTTP_GONE == 410;
ok Apache::OPT_EXECCGI;
+ok Apache::DECLINE_CMD eq "\x07\x08";
+ok Apache::DIR_MAGIC_TYPE eq "httpd/unix-directory";
ok ! defined &M_GET;
Apache::Const->import('M_GET');
Index: xs/tables/current/Apache/ConstantsTable.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/tables/current/Apache/ConstantsTable.pm,v
retrieving revision 1.27
diff -u -r1.27 ConstantsTable.pm
--- xs/tables/current/Apache/ConstantsTable.pm 24 Aug 2002 17:14:39 -0000 1.27
+++ xs/tables/current/Apache/ConstantsTable.pm 9 May 2003 14:26:26 -0000
@@ -143,6 +143,12 @@
'HTTP_INSUFFICIENT_STORAGE',
'HTTP_NOT_EXTENDED'
],
+ 'config' => [
+ 'DECLINE_CMD'
+ ],
+ 'types' => [
+ 'DIR_MAGIC_TYPE'
+ ],
'filter_type' => [
'AP_FTYPE_RESOURCE',
'AP_FTYPE_CONTENT_SET',
Index: xs/tables/current/ModPerl/FunctionTable.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v
retrieving revision 1.113
diff -u -r1.113 FunctionTable.pm
--- xs/tables/current/ModPerl/FunctionTable.pm 9 May 2003 03:33:02 -0000 1.113
+++ xs/tables/current/ModPerl/FunctionTable.pm 9 May 2003 14:26:27 -0000
@@ -1473,7 +1473,7 @@
]
},
{
- 'return_type' => 'int',
+ 'return_type' => 'SV *',
'name' => 'modperl_constants_lookup_apache',
'args' => [
{
@@ -1483,7 +1483,7 @@
]
},
{
- 'return_type' => 'int',
+ 'return_type' => 'SV *',
'name' => 'modperl_constants_lookup_apr',
'args' => [
{
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: DECLINE_CMD (take 3)
Posted by Geoffrey Young <ge...@modperlcookbook.org>.
> Looks right to me, just can't apply your patch, Mozilla must have ate
> it...
here it is as an attachment.
good to hear from you again :)
--Geoff
Re: DECLINE_CMD (take 3)
Posted by "Philippe M. Chiasson" <go...@cpan.org>.
On Fri, 2003-05-09 at 22:28, Geoffrey Young wrote:
> ok, here's take 3.
>
> re:
>
> if ($name eq 'DECLINE_CMD' || $name eq 'DIR_MAGIC_TYPE') {
> print $c_fh <<EOF;
> return newSVpv($alias{$name}, 0);
> EOF
>
> I think it's proper to use newSVpv instead of newSVpvn - because the length in question is
> the length of the constant (not the name), presupposing we know the length of DECLINE_CMD
> beforehand seems wrong (if we knew the value of the constants then why have a lookup
> function :). it also allows us to simplify logic in Code.pm and add to the list of
> exceptional string cases if they arise in the future.
I think so too.
> anyway, here's the latest version. I hope I got the threading stuff right :)
Looks right to me, just can't apply your patch, Mozilla must have ate
it...
patching file Changes
1 out of 1 hunk FAILED
[...]
patching file xs/tables/current/ModPerl/FunctionTable.pm
[...]
2 out of 2 hunks FAILED
> --Geoff
>
> Index: Changes
> ===================================================================
> RCS file: /home/cvspublic/modperl-2.0/Changes,v
> retrieving revision 1.184
> diff -u -r1.184 Changes
> --- Changes 9 May 2003 03:33:02 -0000 1.184
> +++ Changes 9 May 2003 14:26:25 -0000
> @@ -12,6 +12,9 @@
>
> =item 1.99_10-dev
>
> +implement DECLINE_CMD and DIR_MAGIC_TYPE constants
> +[Geoffrey Young]
> +
> allow init filter handlers to call other methods than just $f->ctx [Stas]
>
> Fix Apache::Reload to gracefully handle the case with empty Touchfiles
> Index: lib/Apache/ParseSource.pm
> ===================================================================
> RCS file: /home/cvspublic/modperl-2.0/lib/Apache/ParseSource.pm,v
> retrieving revision 1.42
> diff -u -r1.42 ParseSource.pm
> --- lib/Apache/ParseSource.pm 15 Apr 2003 02:22:41 -0000 1.42
> +++ lib/Apache/ParseSource.pm 9 May 2003 14:26:25 -0000
> @@ -156,8 +156,8 @@
> satisfy => [qw{SATISFY_}],
> remotehost => [qw{REMOTE_}],
> http => [qw{HTTP_}],
> -# config => [qw{DECLINE_CMD}],
> -# types => [qw{DIR_MAGIC_TYPE}],
> + config => [qw{DECLINE_CMD}],
> + types => [qw{DIR_MAGIC_TYPE}],
> override => [qw{OR_ ACCESS_CONF RSRC_CONF}],
> log => [qw(APLOG_)],
> },
> Index: lib/ModPerl/Code.pm
> ===================================================================
> RCS file: /home/cvspublic/modperl-2.0/lib/ModPerl/Code.pm,v
> retrieving revision 1.96
> diff -u -r1.96 Code.pm
> --- lib/ModPerl/Code.pm 24 Apr 2003 01:51:37 -0000 1.96
> +++ lib/ModPerl/Code.pm 9 May 2003 14:26:25 -0000
> @@ -769,7 +769,7 @@
> my $package_len = length $package;
>
> my $func = canon_func(qw(constants lookup), $postfix);
> - my $proto = "int $func(const char *name)";
> + my $proto = "SV \*$func(pTHX_ const char *name)";
>
> print $h_fh "$proto;\n";
>
> @@ -804,7 +804,20 @@
> print $c_fh <<EOF;
> $ifdef[0]
> if (strEQ(name, "$name")) {
> - return $alias{$name};
> +EOF
> +
> + if ($name eq 'DECLINE_CMD' || $name eq 'DIR_MAGIC_TYPE') {
> + print $c_fh <<EOF;
> + return newSVpv($alias{$name}, 0);
> +EOF
> + }
> + else {
> + print $c_fh <<EOF;
> + return newSViv($alias{$name});
> +EOF
> + }
> +
> + print $c_fh <<EOF;
> }
> $ifdef[1]
> EOF
> @@ -815,7 +828,7 @@
> print $c_fh <<EOF
> };
> Perl_croak_nocontext("unknown constant %s", name);
> - return MP_ENOCONST;
> + return newSViv(MP_ENOCONST);
> }
> EOF
> }
> Index: src/modules/perl/modperl_const.c
> ===================================================================
> RCS file: /home/cvspublic/modperl-2.0/src/modules/perl/modperl_const.c,v
> retrieving revision 1.8
> diff -u -r1.8 modperl_const.c
> --- src/modules/perl/modperl_const.c 22 Oct 2001 05:42:23 -0000 1.8
> +++ src/modules/perl/modperl_const.c 9 May 2003 14:26:25 -0000
> @@ -1,27 +1,27 @@
> #include "mod_perl.h"
> #include "modperl_const.h"
>
> -typedef int (*constants_lookup)(const char *);
> +typedef SV *(*constants_lookup)(pTHX_ const char *);
> typedef const char ** (*constants_group_lookup)(const char *);
>
> -static int new_constsub(pTHX_ constants_lookup lookup,
> +static SV *new_constsub(pTHX_ constants_lookup lookup,
> HV *caller_stash, HV *stash,
> const char *name)
> {
> int name_len = strlen(name);
> GV **gvp = (GV **)hv_fetch(stash, name, name_len, TRUE);
> - int val;
> + SV *val;
>
> /* dont redefine */
> if (!isGV(*gvp) || !GvCV(*gvp)) {
> - val = (*lookup)(name);
> + val = (*lookup)(aTHX_ name);
>
> #if 0
> fprintf(stderr, "newCONSTSUB(%s, %s, %d)\n",
> HvNAME(stash), name, val);
> #endif
>
> - newCONSTSUB(stash, (char *)name, newSViv(val));
> + newCONSTSUB(stash, (char *)name, val);
> #ifdef GvSHARED
> GvSHARED_on(*gvp);
> #endif
> Index: src/modules/perl/modperl_module.c
> ===================================================================
> RCS file: /home/cvspublic/modperl-2.0/src/modules/perl/modperl_module.c,v
> retrieving revision 1.12
> diff -u -r1.12 modperl_module.c
> --- src/modules/perl/modperl_module.c 14 Apr 2003 06:38:50 -0000 1.12
> +++ src/modules/perl/modperl_module.c 9 May 2003 14:26:25 -0000
> @@ -669,7 +669,7 @@
> }
> else {
> cmd->args_how =
> - modperl_constants_lookup_apache(SvPV(val, len));
> + SvIV(modperl_constants_lookup_apache(aTHX_ SvPV(val, len)));
> }
> }
>
> @@ -695,7 +695,7 @@
> }
> else {
> cmd->req_override =
> - modperl_constants_lookup_apache(SvPV(val, len));
> + SvIV(modperl_constants_lookup_apache(aTHX_ SvPV(val, len)));
> }
> }
>
> Index: t/apache/constants.t
> ===================================================================
> RCS file: /home/cvspublic/modperl-2.0/t/apache/constants.t,v
> retrieving revision 1.5
> diff -u -r1.5 constants.t
> --- t/apache/constants.t 18 May 2002 02:29:44 -0000 1.5
> +++ t/apache/constants.t 9 May 2003 14:26:25 -0000
> @@ -5,10 +5,11 @@
> use Test;
>
> use Apache2 ();
> -use Apache::Const -compile => qw(DECLINED :http :common TAKE23 &OPT_EXECCGI);
> +use Apache::Const -compile => qw(DECLINED :http :common TAKE23 &OPT_EXECCGI
> + DECLINE_CMD DIR_MAGIC_TYPE);
> use Apache::Const; #defaults to :common
>
> -plan tests => 13;
> +plan tests => 15;
>
> ok REDIRECT == 302;
> ok AUTH_REQUIRED == 401;
> @@ -17,6 +18,8 @@
> ok Apache::DECLINED == -1;
> ok Apache::HTTP_GONE == 410;
> ok Apache::OPT_EXECCGI;
> +ok Apache::DECLINE_CMD eq "\x07\x08";
> +ok Apache::DIR_MAGIC_TYPE eq "httpd/unix-directory";
>
> ok ! defined &M_GET;
> Apache::Const->import('M_GET');
> Index: xs/tables/current/Apache/ConstantsTable.pm
> ===================================================================
> RCS file: /home/cvspublic/modperl-2.0/xs/tables/current/Apache/ConstantsTable.pm,v
> retrieving revision 1.27
> diff -u -r1.27 ConstantsTable.pm
> --- xs/tables/current/Apache/ConstantsTable.pm 24 Aug 2002 17:14:39 -0000 1.27
> +++ xs/tables/current/Apache/ConstantsTable.pm 9 May 2003 14:26:26 -0000
> @@ -143,6 +143,12 @@
> 'HTTP_INSUFFICIENT_STORAGE',
> 'HTTP_NOT_EXTENDED'
> ],
> + 'config' => [
> + 'DECLINE_CMD'
> + ],
> + 'types' => [
> + 'DIR_MAGIC_TYPE'
> + ],
> 'filter_type' => [
> 'AP_FTYPE_RESOURCE',
> 'AP_FTYPE_CONTENT_SET',
> Index: xs/tables/current/ModPerl/FunctionTable.pm
> ===================================================================
> RCS file: /home/cvspublic/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v
> retrieving revision 1.113
> diff -u -r1.113 FunctionTable.pm
> --- xs/tables/current/ModPerl/FunctionTable.pm 9 May 2003 03:33:02 -0000 1.113
> +++ xs/tables/current/ModPerl/FunctionTable.pm 9 May 2003 14:26:27 -0000
> @@ -1473,7 +1473,7 @@
> ]
> },
> {
> - 'return_type' => 'int',
> + 'return_type' => 'SV *',
> 'name' => 'modperl_constants_lookup_apache',
> 'args' => [
> {
> @@ -1483,7 +1483,7 @@
> ]
> },
> {
> - 'return_type' => 'int',
> + 'return_type' => 'SV *',
> 'name' => 'modperl_constants_lookup_apr',
> 'args' => [
> {
>
>
> ---------------------------------------------------------------------
> To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
> For additional commands, e-mail: dev-help@perl.apache.org
>
--
Philippe M. Chiasson <go...@cpan.org>
Re: DECLINE_CMD (take 3)
Posted by Stas Bekman <st...@stason.org>.
Geoffrey Young wrote:
> ok, here's take 3.
+1, good work, Geoff!
> if ($name eq 'DECLINE_CMD' || $name eq 'DIR_MAGIC_TYPE') {
> print $c_fh <<EOF;
> return newSVpv($alias{$name}, 0);
> EOF
>
> I think it's proper to use newSVpv instead of newSVpvn - because the
> length in question is the length of the constant (not the name),
> presupposing we know the length of DECLINE_CMD beforehand seems wrong
> (if we knew the value of the constants then why have a lookup function
> :). it also allows us to simplify logic in Code.pm and add to the list
> of exceptional string cases if they arise in the future.
You are correct.
> anyway, here's the latest version. I hope I got the threading stuff
> right :)
Yup!
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org