perl-dev mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From Randy Kobes <ra...@theoryx5.uwinnipeg.ca>
Subject Re: [mp2] ModPerl-Registry redirect test
Date Wed, 03 Dec 2003 05:09:55 GMT
On Mon, 1 Dec 2003, Stas Bekman wrote:

> [...]
>
> I'm still unhappy about whatever_url() working with fs
> paths. I guess I'm taking my words on using Unix-> back.
> At least we know that we work with paths and not urls. How
> about this:
>
> # concat a dir/file using unix path separators
> # no platform specific path cleanups are run unless the filepath is absolute
> sub t_catfile_unix {
>      my $f = canonpath join "/", @_;
>      return $f unless File::Spec->file_name_is_absolute($f);
>      return Apache::TestConfig::WIN32 ?
>          Win32::GetLongPathName($f) : $f;
> }
>
> # concat a dir/file ala catfile
> # and run platform specific path cleanups if the filepath is absolute
> sub t_catfile {
>      my $f = File::Spec->catfile(@_);
>      return $f unless File::Spec->file_name_is_absolute($f);
>      return Apache::TestConfig::WIN32 ?
>          Win32::GetLongPathName($f) : $f;
> }
>
> or may be even better:
>   s/t_catfile_unix/t_catfile_apache/
> ? to denote that we catfile the apache way?
>
> I won't try to use File::Spec::Unix instead of join '/',
> because one day it may stop loading on non-Unix...

That's a good point ... However, using
 sub t_catfile_apache {
      my $f = canonpath join "/", @_;
      return $f unless File::Spec->file_name_is_absolute($f);
      return Apache::TestConfig::WIN32 ?
          Win32::GetLongPathName($f) : $f;
 }
doesn't quite work on Win32 :( (and probably not on Macs,
either), as canonpath flips the '/' back to the native
directory separator ('\' on Win32). What one could do is
then s{[\\:]}{/}g afterwards, but on Win32 one has to take
care of the case that the drive is specified, as
D:/whatever, and not change the ':'. The following is OK:
=============================================================
Index: Apache-Test/lib/Apache/TestUtil.pm
===================================================================
RCS file: /home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestUtil.pm,v
retrieving revision 1.31
diff -u -r1.31 TestUtil.pm
--- Apache-Test/lib/Apache/TestUtil.pm	29 Apr 2003 08:04:04 -0000	1.31
+++ Apache-Test/lib/Apache/TestUtil.pm	3 Dec 2003 05:10:59 -0000
@@ -9,7 +9,7 @@
 use Carp ();
 use Config;
 use File::Basename qw(dirname);
-use File::Spec::Functions qw(catfile);
+use File::Spec::Functions qw(catfile canonpath file_name_is_absolute);
 use Symbol ();

 use Apache::Test ();
@@ -26,7 +26,8 @@
     t_client_log_error_is_expected t_client_log_warn_is_expected
 );

-@EXPORT_OK = qw(t_write_perl_script t_write_shell_script t_chown);
+@EXPORT_OK = qw(t_write_perl_script t_write_shell_script t_chown
+               t_catfile_apache t_catfile);

 %CLEAN = ();

@@ -302,6 +303,21 @@
         t_debug("removing dir tree: $_");
         t_rmtree($_);
     }
+}
+
+sub t_catfile {
+    my $f = catfile(@_);
+    return $f unless file_name_is_absolute($f);
+    return Apache::TestConfig::WIN32 ?
+        Win32::GetLongPathName($f) : $f;
+}
+
+sub t_catfile_apache {
+    my $f = canonpath join '/', @_;
+    $f =~ s{[\\:](?!\\)}{/}g;
+    return $f unless file_name_is_absolute($f);
+    return Apache::TestConfig::WIN32 ?
+        Win32::GetLongPathName($f) : $f;
 }

 1;
Index: ModPerl-Registry/t/basic.t
===================================================================
RCS file: /home/cvs/modperl-2.0/ModPerl-Registry/t/basic.t,v
retrieving revision 1.15
diff -u -r1.15 basic.t
--- ModPerl-Registry/t/basic.t	23 Nov 2003 21:01:50 -0000	1.15
+++ ModPerl-Registry/t/basic.t	3 Dec 2003 05:10:59 -0000
@@ -6,7 +6,7 @@
 use Apache::TestRequest qw(GET GET_BODY HEAD);
 use Apache::TestConfig ();

-use File::Spec::Functions qw(catfile);
+use Apache::TestUtil qw(t_catfile_apache);

 my %modules = (
     registry    => 'ModPerl::Registry',
@@ -19,7 +19,7 @@
 plan tests => @aliases * 4 + 3;

 my $vars = Apache::Test::config()->{vars};
-my $script_file = catfile $vars->{serverroot}, 'cgi-bin', 'basic.pl';
+my $script_file = t_catfile_apache($vars->{serverroot}, 'cgi-bin', 'basic.pl');

 # very basic compilation/response test
 for my $alias (@aliases) {
Index: ModPerl-Registry/t/redirect.t
===================================================================
RCS file: /home/cvs/modperl-2.0/ModPerl-Registry/t/redirect.t,v
retrieving revision 1.6
diff -u -r1.6 redirect.t
--- ModPerl-Registry/t/redirect.t	23 Nov 2003 21:01:50 -0000	1.6
+++ ModPerl-Registry/t/redirect.t	3 Dec 2003 05:10:59 -0000
@@ -5,7 +5,7 @@
 use Apache::TestUtil;
 use Apache::TestRequest qw(GET_BODY HEAD);

-use File::Spec::Functions qw(catfile);
+use Apache::TestUtil qw(t_catfile_apache);

 plan tests => 4, have_lwp;

@@ -16,7 +16,7 @@
     my $redirect_path = "/registry/basic.pl";
     my $url = "$base_url?$redirect_path";
     my $vars = Apache::Test::config()->{vars};
-    my $script_file = catfile $vars->{serverroot}, 'cgi-bin', 'basic.pl';
+    my $script_file = t_catfile_apache($vars->{serverroot}, 'cgi-bin', 'basic.pl');

     ok t_cmp(
         "ok $script_file",
=========================================================================

-- 
best regards,
randy

---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org


Mime
View raw message