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] apache/subprocess on Win32
Date Thu, 05 Jun 2003 07:52:51 GMT
On Thu, 5 Jun 2003, Stas Bekman wrote:

> Randy Kobes wrote:
[ .. ]
> > Yes, it does - thanks. Here's a diff that enables all the
> > apache/subprocess tests to pass on Win32 (I haven't tested
> > it on Unix):
> >
> > ==========================================================
> > Index: subprocess.pm
> > ===================================================================
> > RCS file: /home/cvs/modperl-2.0/t/response/TestApache/subprocess.pm,v
> > retrieving revision 1.13
> > diff -u -r1.13 subprocess.pm
> > --- subprocess.pm	8 Apr 2003 02:05:34 -0000	1.13
> > +++ subprocess.pm	5 Jun 2003 06:51:32 -0000
> > @@ -5,6 +5,7 @@
> >
> >  use Apache::Test;
> >  use Apache::TestUtil;
> > +require Apache::TestConfig;
> >
> >  use File::Spec::Functions qw(catfile catdir);
> >  use IO::Select ();
> > @@ -44,11 +45,16 @@
> >
> >      my $target_dir = catfile $vars->{documentroot}, "util";
> >
> > +    my $perl = catfile $Config{bin},
> > +        (Apache::TestConfig::WIN32 ? 'perl.exe' : 'perl');
> > +
>
> In that case, we do know the path to perl, it's stored in Apache::Build:
>
>      require Apache::Build;
>      my $build = Apache::Build->build_config;
>      my $perl_path = $build->perl_config('perlpath');
>
> $Config{bin}/perl is definitely wrong, as it can be $Config{bin}/perl5.9.0 for
> example. Or anything else for that purpose. e.g.  $Config{bin}/python to
> confuse the management ;)

Good point :) -  a revised diff appears below using Apache::Build.

>
> >      {
> >          # test: passing argv + scalar context
> >          my $command = catfile $target_dir, "argv.pl";
> >          my @argv = qw(foo bar);
> > -        my $out_fh = Apache::SubProcess::spawn_proc_prog($r, $command, \@argv);
> > +        my $out_fh = Apache::TestConfig::WIN32 ?
> > +            Apache::SubProcess::spawn_proc_prog($r, $perl, [$command, @argv]) :
> > +                  Apache::SubProcess::spawn_proc_prog($r, $command, \@argv);
>
> Also any reason for not doing the same for all? the WIN32 case should work
> just fine for others, no?
> [...]
> > -        my $output = read_data($out_fh);
> > +        (my $output = read_data($out_fh)) =~ s/[\r\n]{1,2}/\r\n/;
>
> I guess we leave it for now, but later will probably abstract it into a
> function, once we need it in other tests, probably put XXX so we will remember.
>
> please test with using Apache::Build to get the perl path and if it works,
> I'll test on UNIX.

Here's a revised diff, using the same syntax for all. This
works on Win32, but again, I haven't tested it on Unix.

======================================================================
Index: subprocess.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestApache/subprocess.pm,v
retrieving revision 1.13
diff -u -r1.13 subprocess.pm
--- subprocess.pm	8 Apr 2003 02:05:34 -0000	1.13
+++ subprocess.pm	5 Jun 2003 07:59:54 -0000
@@ -5,6 +5,7 @@

 use Apache::Test;
 use Apache::TestUtil;
+require Apache::Build;

 use File::Spec::Functions qw(catfile catdir);
 use IO::Select ();
@@ -44,11 +45,14 @@

     my $target_dir = catfile $vars->{documentroot}, "util";

+    my $perl = Apache::Build->build_config()->perl_config('perlpath');
+
     {
         # test: passing argv + scalar context
-        my $command = catfile $target_dir, "argv.pl";
+        my $script = catfile $target_dir, "argv.pl";
         my @argv = qw(foo bar);
-        my $out_fh = Apache::SubProcess::spawn_proc_prog($r, $command, \@argv);
+        my $out_fh =
+            Apache::SubProcess::spawn_proc_prog($r, $perl, [$script, @argv]);
         my $output = read_data($out_fh);
         ok t_cmp(\@argv,
                  [split / /, $output],
@@ -58,10 +62,11 @@

     {
         # test: passing env to subprocess through subprocess_env
-        my $command = catfile $target_dir, "env.pl";
+        my $script = catfile $target_dir, "env.pl";
         my $value = "my cool proc";
         $r->subprocess_env->set(SubProcess => $value);
-        my $out_fh = Apache::SubProcess::spawn_proc_prog($r, $command);
+        my $out_fh =
+            Apache::SubProcess::spawn_proc_prog($r, $perl, [$script]);
         my $output = read_data($out_fh);
         ok t_cmp($value,
                  $output,
@@ -71,12 +76,12 @@

     {
         # test: subproc's stdin -> stdout + list context
-        my $command = catfile $target_dir, "in_out.pl";
-        my $value = "my cool proc\n"; # must have \n for <IN>
-        my ($in_fh, $out_fh, $err_fh) =
-            Apache::SubProcess::spawn_proc_prog($r, $command);
+        my $script = catfile $target_dir, "in_out.pl";
+        my $value = "my cool proc\r\n"; # must have \n for <IN>
+        my ($in_fh, $out_fh, $err_fh) =
+            Apache::SubProcess::spawn_proc_prog($r, $perl, [$script]);
         print $in_fh $value;
-        my $output = read_data($out_fh);
+        (my $output = read_data($out_fh)) =~ s/[\r\n]{1,2}/\r\n/;
         ok t_cmp($value,
                  $output,
                  "testing subproc's stdin -> stdout + list context"
@@ -85,12 +90,12 @@

     {
         # test: subproc's stdin -> stderr + list context
-        my $command = catfile $target_dir, "in_err.pl";
-        my $value = "my stderr\n"; # must have \n for <IN>
-        my ($in_fh, $out_fh, $err_fh) =
-            Apache::SubProcess::spawn_proc_prog($r, $command);
+        my $script = catfile $target_dir, "in_err.pl";
+        my $value = "my stderr\r\n"; # must have \n for <IN>
+        my ($in_fh, $out_fh, $err_fh) =
+            Apache::SubProcess::spawn_proc_prog($r, $perl, [$script]);
         print $in_fh $value;
-        my $output = read_data($err_fh);
+        (my $output = read_data($err_fh)) =~ s/[\r\n]{1,2}/\r\n/;
         ok t_cmp($value,
                  $output,
                  "testing subproc's stdin -> stderr + list context"
=======================================================================
Thanks.
-- 
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