]> git.vpit.fr Git - perl/modules/Test-Valgrind.git/blob - lib/Test/Valgrind/Command/PerlScript.pm
9aeac0d72faa76c49909921c5eaf1a61fca16293
[perl/modules/Test-Valgrind.git] / 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.16
13
14 =cut
15
16 our $VERSION = '1.16';
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