lib/Test/Valgrind/Command/PerlScript.pm

   1 package Test::Valgrind::Command::PerlScript;
   2
   3 use strict;
   4 use warnings;
   5
   6 =head1 NAME
   7
   8 Test::Valgrind::Command::PerlScript - A Test::Valgrind command that invokes a perl script.
   9
  10 =head1 VERSION
  11
  12 Version 1.17
  13
  14 =cut
  15
  16 our $VERSION = '1.17';
  17
  18 =head1 DESCRIPTION
  19
  20 This command is meant to abstract the argument list handling of a C<perl> script.
  21
  22 =cut
  23
  24 use base qw<Test::Valgrind::Command::Perl Test::Valgrind::Carp>;
  25
  26 =head1 METHODS
  27
  28 This class inherits L<Test::Valgrind::Command::Perl>.
  29
  30 =head2 C<new>
  31
  32     my $tvcps = Test::Valgrind::Command::PerlScript->new(
  33      file       => $file,
  34      taint_mode => $taint_mode,
  35      %extra_args,
  36     );
  37
  38 The package constructor, which takes several options :
  39
  40 =over 4
  41
  42 =item *
  43
  44 C<$file> is the path to the C<perl> script you want to run.
  45
  46 This option is mandatory.
  47
  48 =item *
  49
  50 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.
  51
  52 =back
  53
  54 Other arguments are passed straight to C<< Test::Valgrind::Command::Perl->new >>.
  55
  56 =cut
  57
  58 sub new {
  59  my $class = shift;
  60  $class = ref($class) || $class;
  61
  62  my %args = @_;
  63
  64  my $file = delete $args{file};
  65  $class->_croak('Invalid script file') unless $file and -e $file;
  66
  67  my $taint_mode = delete $args{taint_mode};
  68  if (not defined $taint_mode and open my $fh, '<', $file) {
  69   my $first = <$fh>;
  70   close $fh;
  71   if ($first and my ($args) = $first =~ /^\s*#\s*!\s*perl\s*(.*)/) {
  72    $taint_mode = 1 if $args =~ /(?:^|\s)-T(?:$|\s)/;
  73   }
  74   $taint_mode = 0 unless defined $taint_mode;
  75  }
  76
  77  my $self = bless $class->SUPER::new(
  78   taint_mode => $taint_mode,
  79   %args,
  80  ), $class;
  81
  82  $self->{file} = $file;
  83
  84  return $self;
  85 }
  86
  87 sub new_trainer { Test::Valgrind::Command::Perl->new_trainer }
  88
  89 =head2 C<file>
  90
  91     my $file = $tvcps->file;
  92
  93 Read-only accessor for the C<file> option.
  94
  95 =cut
  96
  97 sub file { $_[0]->{file} }
  98
  99 sub args {
 100  my $self = shift;
 101
 102  return $self->SUPER::args(@_),
 103         $self->file
 104 }
 105
 106 =head1 SEE ALSO
 107
 108 L<Test::Valgrind>, L<Test::Valgrind::Command::Perl>.
 109
 110 =head1 AUTHOR
 111
 112 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
 113
 114 You can contact me by mail or on C<irc.perl.org> (vincent).
 115
 116 =head1 BUGS
 117
 118 Please report any bugs or feature requests to C<bug-test-valgrind at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-Valgrind>.
 119 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
 120
 121 =head1 SUPPORT
 122
 123 You can find documentation for this module with the perldoc command.
 124
 125     perldoc Test::Valgrind::Command::PerlScript
 126
 127 =head1 COPYRIGHT & LICENSE
 128
 129 Copyright 2009,2010,2011,2013,2015 Vincent Pit, all rights reserved.
 130
 131 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
 132
 133 =cut
 134
 135 1; # End of Test::Valgrind::Command::PerlScript