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
);
[EMAIL PROTECTED] = qw(t_write_perl_script t_write_shell_script t_chown);
[EMAIL PROTECTED] = 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: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
