perl-dev mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From "Philippe M. Chiasson" <go...@cpan.org>
Subject [Patch mp2] PerlSections namespace
Date Tue, 09 Dec 2003 20:04:27 GMT
It's been a long time that perl sections have been having trouble with
recursive inclusion. This has been discussed before and has to do with
the fact that all PerlSections are evaluated in the same namespace
Apache::ReadSections.

The following patch follows a similar design than ModPerl::Registry,
putting each <Perl> block in it's own namespace, based on filename &
lineno.

This now prevents infinite-recursion problems and makes $Includes from
within <Perl> sections work fine.

There is still one little problem left with this, people will not be
able to put stuff directly in the Apache::ReadSections namespace
themselves. I do have a plan for fixing that as well in a subsequent
patch.

As usual, look at it and tell me if it breaks more stuff than it fixes
;-)

I had to introduce a function in mod_perl_util.c, modperl_file2package,
that makes a package-safe name from a filepath, so maybe it could be
exposed and used by ModPerl::Registry as well?

Index: todo/release
===================================================================
RCS file: /home/cvs/modperl-2.0/todo/release,v
retrieving revision 1.5
diff -u -I$Id: -r1.5 release
--- todo/release	1 Dec 2003 19:11:19 -0000	1.5
+++ todo/release	9 Dec 2003 19:34:34 -0000
@@ -27,11 +27,6 @@
   A few issues with <Perl> sections:
   http://marc.theaimsgroup.com/?l=apache-modperl-dev&m=106074969831522&w=2
 
-* Recursive <Perl> sections:
-  http://www.gossamer-threads.com/archive/mod_perl_C1/dev_F4/%5BMP2_-_BUG_%5D_Issue_handing_Apache_config._error_messages_P70501/
-  and
-  http://mathforum.org/epigone/modperl/dartrimpcil
-
 * Fixing Apache->warn("foo")
 
   Report: http://mathforum.org/epigone/modperl-dev/noxtramcay/3D11A4E5.6010202@stason.org
Index: t/conf/extra.last.conf.in
===================================================================
RCS file: /home/cvs/modperl-2.0/t/conf/extra.last.conf.in,v
retrieving revision 1.9
diff -u -I$Id: -r1.9 extra.last.conf.in
--- t/conf/extra.last.conf.in	17 Nov 2003 01:11:06 -0000	1.9
+++ t/conf/extra.last.conf.in	9 Dec 2003 19:34:34 -0000
@@ -19,6 +19,7 @@
 	};
 #This is a comment
 $TestDirective::perl::comments="yes";
+$TestDirective::perl::PACKAGE = __PACKAGE__;
 </Perl>
 
 <Perl >
@@ -26,6 +27,10 @@
 $TestDirective::perl::filename = __FILE__;
 $TestDirective::perl::dollar_zero = $0;
 $TestDirective::perl::line =  __LINE__;
+</Perl>
+
+<Perl >
+$Include = "@ServerRoot@/conf/perlsection.conf";
 </Perl>
 
 ### --------------------------------- ###
Index: t/conf/perlsection.conf
===================================================================
RCS file: t/conf/perlsection.conf
diff -N t/conf/perlsection.conf
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ t/conf/perlsection.conf	9 Dec 2003 19:34:34 -0000
@@ -0,0 +1,3 @@
+<Perl >
+$TestDirective::perl::Included++;
+</Perl>
Index: t/response/TestDirective/perldo.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestDirective/perldo.pm,v
retrieving revision 1.5
diff -u -I$Id: -r1.5 perldo.pm
--- t/response/TestDirective/perldo.pm	17 Nov 2003 01:11:06 -0000	1.5
+++ t/response/TestDirective/perldo.pm	9 Dec 2003 19:34:34 -0000
@@ -10,15 +10,21 @@
 sub handler {
     my $r = shift;
 
-    plan $r, tests => 9;
+    plan $r, tests => 11;
 
     ok t_cmp('yes', $TestDirective::perl::worked);
     
-    ok not exists $Apache::ReadConfig::Location{'/perl_sections'};
+    ok t_cmp(qr/extra_last_conf::line_\d+$/, $TestDirective::perl::PACKAGE, '__PACKAGE__');
     
-    ok exists $Apache::ReadConfig::Location{'/perl_sections_saved'};
-  
-    ok t_cmp('PerlSection', $Apache::ReadConfig::Location{'/perl_sections_saved'}{'AuthName'});
+    my %Location;
+    {
+    no strict 'refs';
+    %Location = %{$TestDirective::perl::PACKAGE . '::Location'};
+    }
+
+    ok not exists $Location{'/perl_sections'};
+    ok exists $Location{'/perl_sections_saved'};
+    ok t_cmp('PerlSection', $Location{'/perl_sections_saved'}{'AuthName'});
 
     ok t_cmp('yes', $TestDirective::perl::comments);
 
@@ -29,6 +35,8 @@
     ok $TestDirective::perl::line > 3;
 
     ok t_cmp("-e", $0, '$0');
+
+    ok t_cmp(1, $TestDirective::perl::Included, "Include");
 
     Apache::OK;
 }
Index: src/modules/perl/modperl_cmd.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_cmd.c,v
retrieving revision 1.51
diff -u -I$Id: -r1.51 modperl_cmd.c
--- src/modules/perl/modperl_cmd.c	17 Nov 2003 01:11:06 -0000	1.51
+++ src/modules/perl/modperl_cmd.c	9 Dec 2003 19:34:34 -0000
@@ -399,8 +399,18 @@
             
         if (!(package_name = apr_table_get(options, "package"))) {
             package_name = apr_pstrdup(p, MP_DEFAULT_PERLSECTION_PACKAGE);
-            apr_table_set(options, "package", package_name);
         }
+
+        package_name = modperl_section2package(p, package_name, 
+                                               parms->directive->filename, 
+                                               parms->directive->line_num);
+
+        apr_table_set(options, "package", package_name);
+
+        MP_TRACE_s(MP_FUNC, "PerlSection from file=%s, line=%d placed in %s\n", 
+                            parms->directive->filename,
+                            parms->directive->line_num,
+                            package_name);
 
         line_header = apr_psprintf(p, "\n#line %d %s\n", 
                                    parms->directive->line_num,
Index: src/modules/perl/modperl_util.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_util.c,v
retrieving revision 1.58
diff -u -I$Id: -r1.58 modperl_util.c
--- src/modules/perl/modperl_util.c	25 Nov 2003 20:31:29 -0000	1.58
+++ src/modules/perl/modperl_util.c	9 Dec 2003 19:34:34 -0000
@@ -769,3 +769,45 @@
     }    
 }
 #endif
+
+#define MP_VALID_PKG_CHAR(c) (isalnum(c)||c==':'||c=='_')
+static const char *modperl_file2package(apr_pool_t *p, const char *file)
+{
+    char *package;
+    char *c;
+
+    c = package = apr_pcalloc(p, strlen(file));
+
+    /* First, skip invalid prefix characters */
+    while (!MP_VALID_PKG_CHAR(*file)) {
+        file++;
+    }
+
+    /* Then, replace bad characters with '_' */
+    while (*file) {
+        if (MP_VALID_PKG_CHAR(*file)) {
+            *c = *file;
+        }
+        else {
+            /* Replace many bad characters with only one '_' */
+            while (*(file+1) && !MP_VALID_PKG_CHAR(*(file+1))) {
+                file++;
+            }
+
+            *c = '_';
+        }
+
+        c++;
+        file++;
+    }
+    
+    return package;
+}
+
+const char *modperl_section2package(apr_pool_t *p, const char *namespace, const char *filename,
int lineno)
+{
+    return apr_psprintf(p, "%s::%s::line_%d", namespace, modperl_file2package(p, filename),
lineno);
+}
+
+
+
Index: src/modules/perl/modperl_util.h
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_util.h,v
retrieving revision 1.48
diff -u -I$Id: -r1.48 modperl_util.h
--- src/modules/perl/modperl_util.h	22 Sep 2003 23:46:19 -0000	1.48
+++ src/modules/perl/modperl_util.h	9 Dec 2003 19:34:34 -0000
@@ -159,4 +159,6 @@
 void modperl_apr_table_dump(pTHX_ apr_table_t *table, char *name);
 #endif
 
+const char *modperl_section2package(apr_pool_t *p, const char *namespace, const char *filename,
int lineno);
+
 #endif /* MODPERL_UTIL_H */



-- 
--------------------------------------------------------------------------------
Philippe M. Chiasson /gozer\@(cpan|ectoplasm)\.org/ 88C3A5A5 (122FF51B/C634E37B)
http://gozer.ectoplasm.org/    F9BF E0C2 480E 7680 1AE5 3631 CB32 A107 88C3 A5A5
Q: It is impossible to make anything foolproof because fools are so ingenious.
perl -e'$$=\${gozer};{$_=unpack(P7,pack(L,$$));/^JAm_pH\n$/&&print||$$++&&redo}'

Mime
View raw message