]> git.vpit.fr Git - perl/modules/Test-Valgrind.git/blob - lib/Test/Valgrind/Command.pm
a305ed65b361143bbad8f530974891dfb1d26fa4
[perl/modules/Test-Valgrind.git] / lib / Test / Valgrind / Command.pm
1 package Test::Valgrind::Command;
2
3 use strict;
4 use warnings;
5
6 =head1 NAME
7
8 Test::Valgrind::Command - Base class for Test::Valgrind commands.
9
10 =head1 VERSION
11
12 Version 1.15
13
14 =cut
15
16 our $VERSION = '1.15';
17
18 =head1 DESCRIPTION
19
20 This class is the base for L<Test::Valgrind> commands.
21
22 Commands gather information about the target of the analysis.
23 They should also provide a default setup for generating suppressions.
24
25 =cut
26
27 use base qw<Test::Valgrind::Carp>;
28
29 =head1 METHODS
30
31 =head2 C<new>
32
33     my $tvc = Test::Valgrind::Command->new(
34      command => $command,
35      args    => \@args,
36     );
37
38 Creates a new command object of type C<$command> by requiring and redispatching the method call to the module named C<$command> if it contains C<'::'> or to C<Test::Valgrind::Command::$command> otherwise.
39 The class represented by C<$command> must inherit this class.
40
41 The C<args> key is used to initialize the L</args> accessor.
42
43 =cut
44
45 sub new {
46  my $class = shift;
47  $class = ref($class) || $class;
48
49  my %args = @_;
50
51  if ($class eq __PACKAGE__ and my $cmd = delete $args{command}) {
52   $cmd =~ s/[^\w:]//g;
53   $cmd = __PACKAGE__ . "::$cmd" if $cmd !~ /::/;
54   $class->_croak("Couldn't load command $cmd: $@") unless eval "require $cmd;1";
55   return $cmd->new(%args);
56  }
57
58  my $args = delete $args{args};
59  $class->_croak('Invalid argument list') if $args and ref $args ne 'ARRAY';
60
61  bless {
62   args => $args,
63  }, $class;
64 }
65
66 =head2 C<new_trainer>
67
68 Creates a new command object suitable for generating suppressions.
69
70 Defaults to return C<undef>, which skips suppression generation.
71
72 =cut
73
74 sub new_trainer { }
75
76 =head2 C<args>
77
78     my @args = $tvc->args($session);
79
80 Returns the list of command-specific arguments that are to be passed to C<valgrind>.
81
82 Defaults to return the contents of the C<args> option.
83
84 =cut
85
86 sub args { @{$_[0]->{args} || []} }
87
88 =head2 C<env>
89
90     my $env = $tvc->env($session);
91
92 This event is called in scalar context before the command is ran, and the returned value goes out of scope when the analysis ends.
93 It's useful for e.g. setting up C<%ENV> for the child process by returning an L<Env::Sanctify> object, hence the name.
94
95 Defaults to void.
96
97 =cut
98
99 sub env { }
100
101 =head2 C<suppressions_tag>
102
103     my $tag = $tvc->suppressions_tag($session);
104
105 Returns a identifier that will be used to pick up the right suppressions for running the command, or C<undef> to indicate that no special suppressions are needed.
106
107 This method must be implemented when subclassing.
108
109 =cut
110
111 sub suppressions_tag;
112
113 =head2 C<check_suppressions_file>
114
115     my $supp_ok = $tvc->check_suppressions_file($file);
116
117 Returns a boolean indicating whether the suppressions contained in C<$file> are compatible with the command.
118
119 Defaults to true.
120
121 =cut
122
123 sub check_suppressions_file { 1 }
124
125 =head2 C<filter>
126
127     my $filtered_report = $tvc->filter($session, $report);
128
129 The C<$session> calls this method after receiving a report from the tool and before forwarding it to the action.
130 You can either return a mangled C<$report> (which does not need to be a clone of the original) or C<undef> if you want the action to ignore it completely.
131
132 Defaults to the identity function.
133
134 =cut
135
136 sub filter { $_[2] }
137
138 =head1 SEE ALSO
139
140 L<Test::Valgrind>, L<Test::Valgrind::Session>.
141
142 =head1 AUTHOR
143
144 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
145
146 You can contact me by mail or on C<irc.perl.org> (vincent).
147
148 =head1 BUGS
149
150 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>.
151 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
152
153 =head1 SUPPORT
154
155 You can find documentation for this module with the perldoc command.
156
157     perldoc Test::Valgrind::Command
158
159 =head1 COPYRIGHT & LICENSE
160
161 Copyright 2009,2010,2011,2013,2015 Vincent Pit, all rights reserved.
162
163 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
164
165 =cut
166
167 1; # Test::Valgrind::Command