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 Thu, 04 Dec 2003 05:42:34 GMT
On Tue, 2 Dec 2003, Stas Bekman wrote:

> Sorry, I didn't know that. Does this work?
>
> sub t_catfile_unix {
>      my $f = File::Spec::Unix->canonpath(join "/", @_);
>      return $f unless File::Spec->file_name_is_absolute($f);
>      return Apache::TestConfig::WIN32 ?
>          Win32::GetLongPathName($f) : $f;
> }

Yes ...

> I guess if we do that than your very original patch is
> just right. We came a full cirle back to where we started
> (thanks to me ;).

I think if one wants to grow old fast, offer to help
maintain File::Spec :)

> So may be just go with:
>
>    my $f = File::Spec::Unix->catfile(@_);
>
> One more thing, I'm not sure about. File::Spec has a clear
> separation between path and file/dir, the former
> optionally includes the drive/volume information, the
> latter do not. Does Win32::GetLongPathName($f) return a
> path (including drive/volume) or just dir/file? i.e.
> t_catfile* should deal only with dir/file and not path?

Win32::GetLongPathName(), if given a drive/volume, will use
that, and include that in what it gives back. So, for
example, I could get the long path name for something on
drive D:\ by running a script on drive C:\. If no drive is
specified, then the input is assumed to be on the drive the
script is run on, and no drive appears in the output.

> Or am I wrong and it's file/path vs. dir? It just makes no
> difference on Unix, so I'm a bit confused here.

It is confusing, even on Windows :)

Is the following then 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	4 Dec 2003 05:36:52 -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 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,20 @@
         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 = File::Spec::Unix->catfile(@_);
+    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	4 Dec 2003 05:36:52 -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	4 Dec 2003 05:36:52 -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",
====================================================================
You raised a good point before about potentially
File::Spec::Unix at sometime in the future not being usable
on non-Unix; I guess this is something we'll have to watch
for. It does happen in principle - for example,
File::Spec::VMS requires VMS::Filespec, which presumably is
a VMS-specific module. However, at this point all of the
non-Unix File::Spec::* require File::Spec::Unix, so it
appears by design that File::Spec::Unix is the "base" class.

-- 
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