From: Vincent Pit <vince@profvince.com>
Date: Tue, 14 Apr 2009 23:18:19 +0000 (+0200)
Subject: Move the "taint_mode" option from Test::Valgrind::Command::PerlScript to Perl
X-Git-Tag: v1.02~18
X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=11eeabaad0bbb6db15b9c967fae94cd7388f0012;p=perl%2Fmodules%2FTest-Valgrind.git

Move the "taint_mode" option from Test::Valgrind::Command::PerlScript to Perl

But keep in Test::Valgrind::Command::PerlScript the automatic discovery for when we know the file.
---

diff --git a/lib/Test/Valgrind/Command/Perl.pm b/lib/Test/Valgrind/Command/Perl.pm
index a8e3e8d..3ded74a 100644
--- a/lib/Test/Valgrind/Command/Perl.pm
+++ b/lib/Test/Valgrind/Command/Perl.pm
@@ -27,15 +27,31 @@ use base qw/Test::Valgrind::Command Test::Valgrind::Carp/;
 
 This class inherits L<Test::Valgrind::Command>.
 
-=head2 C<< new perl => $^X, inc => \@INC, ... >>
+=head2 C<< new perl => $^X, inc => \@INC, taint_mode => $taint_mode, ... >>
 
-Your usual constructor.
+The package constructor, which takes several options :
+
+=over 4
+
+=item *
 
 The C<perl> option specifies which C<perl> executable will run the arugment list given in C<args>.
-It defaults to C<$^X>.
+
+Defaults to C<$^X>.
+
+=item *
 
 C<inc> is a reference to an array of paths that will be passed as C<-I> to the invoked command.
-It defaults to C<@INC>.
+
+Defaults to C<@INC>.
+
+=item *
+
+C<$taint_mode> is a boolean that specifies if the script should be run under taint mode.
+
+Defaults to false.
+
+=back
 
 Other arguments are passed straight to C<< Test::Valgrind::Command->new >>.
 
@@ -47,16 +63,19 @@ sub new {
 
  my %args = @_;
 
- my $perl = delete($args{perl}) || $^X;
- my $inc  = delete($args{inc})  || [ @INC ];
+ my $perl       = delete $args{perl} || $^X;
+ my $inc        = delete $args{inc}  || [ @INC ];
  $class->_croak('Invalid INC list') unless ref $inc eq 'ARRAY';
+ my $taint_mode = delete $args{taint_mode};
 
  my $trainer_file = delete $args{trainer_file};
 
  my $self = bless $class->SUPER::new(%args), $class;
 
- $self->{perl}         = $perl;
- $self->{inc}          = $inc;
+ $self->{perl}       = $perl;
+ $self->{inc}        = $inc;
+ $self->{taint_mode} = $taint_mode;
+
  $self->{trainer_file} = $trainer_file;
 
  return $self;
@@ -97,10 +116,19 @@ Read-only accessor for the C<inc> option.
 
 sub inc { @{$_[0]->{inc} || []} }
 
+=head2 C<taint_mode>
+
+Read-only accessor for the C<taint_mode> option.
+
+=cut
+
+sub taint_mode { $_[0]->{taint_mode} }
+
 sub args {
  my $self = shift;
 
  return $self->perl,
+        (('-T') x!! $self->taint_mode),
         map("-I$_", $self->inc),
         $self->SUPER::args(@_);
 }
diff --git a/lib/Test/Valgrind/Command/PerlScript.pm b/lib/Test/Valgrind/Command/PerlScript.pm
index fbe077e..3c4627d 100644
--- a/lib/Test/Valgrind/Command/PerlScript.pm
+++ b/lib/Test/Valgrind/Command/PerlScript.pm
@@ -29,12 +29,21 @@ This class inherits L<Test::Valgrind::Command::Perl>.
 
 =head2 C<< new file => $file, [ taint_mode => $taint_mode ], ... >>
 
-Your usual constructor.
+The package constructor, which takes several options :
+
+=over 4
+
+=item *
 
 C<$file> is the path to the C<perl> script you want to run.
 
-C<$taint_mode> is a boolean that specifies if the script should be run under taint mode.
-If C<undef> is passed (which is the default), the constructor will try to infer it from the shebang line of the script.
+This option is mandatory.
+
+=item *
+
+C<$taint_mode> is actually handled by the parent class L<Test::Valgrind::Command::Perl>, but it gets special handling in this subclass : if C<undef> is passed (which is the default), the constructor will try to infer its right value from the shebang line of the script.
+
+=back
 
 Other arguments are passed straight to C<< Test::Valgrind::Command::Perl->new >>.
 
@@ -46,14 +55,10 @@ sub new {
 
  my %args = @_;
 
- my $file       = delete $args{file};
+ my $file = delete $args{file};
  $class->_croak('Invalid script file') unless $file and -e $file;
- my $taint_mode = delete $args{taint_mode};
-
- my $self = bless $class->SUPER::new(%args), $class;
-
- $self->{file} = $file;
 
+ my $taint_mode = delete $args{taint_mode};
  if (not defined $taint_mode and open my $fh, '<', $file) {
   my $first = <$fh>;
   close $fh;
@@ -62,7 +67,13 @@ sub new {
   }
   $taint_mode = 0 unless defined $taint_mode;
  }
- $self->{taint_mode} = $taint_mode;
+
+ my $self = bless $class->SUPER::new(
+  taint_mode => $taint_mode,
+  %args,
+ ), $class;
+
+ $self->{file} = $file;
 
  return $self;
 }
@@ -73,19 +84,14 @@ sub new_trainer { Test::Valgrind::Command::Perl->new_trainer }
 
 Read-only accessor for the C<file> option.
 
-=head2 C<taint_mode>
-
-Read-only accessor for the C<taint_mode> option.
-
 =cut
 
-eval "sub $_ { \$_[0]->{$_} }" for qw/file taint_mode/;
+sub file { $_[0]->{file} }
 
 sub args {
  my $self = shift;
 
  return $self->SUPER::args(@_),
-        (('-T') x!! $self->taint_mode),
         $self->file
 }