]> git.vpit.fr Git - perl/modules/Test-Valgrind.git/blob - Command.pm
eb5a3476a2e83cc3cbc345dc1fc659b9ef89bc10
[perl/modules/Test-Valgrind.git] / 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.01
13
14 =cut
15
16 our $VERSION = '1.01';
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. They should also provide a default setup for generating suppressions.
23
24 =cut
25
26 use base qw/Test::Valgrind::Carp/;
27
28 =head1 METHODS
29
30 =head2 C<< new command => $command, args => \@args >>
31
32 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.
33 The class represented by C<$command> must inherit this class.
34
35 The C<args> key is used to initialize the L</args> accessor.
36
37 =cut
38
39 sub new {
40  my $class = shift;
41  $class = ref($class) || $class;
42
43  my %args = @_;
44
45  if ($class eq __PACKAGE__ and my $cmd = delete $args{command}) {
46   $cmd =~ s/[^\w:]//g;
47   $cmd = __PACKAGE__ . "::$cmd" if $cmd !~ /::/;
48   $class->_croak("Couldn't load command $cmd: $@") unless eval "require $cmd;1";
49   return $cmd->new(%args);
50  }
51
52  my $args = delete $args{args};
53  $class->_croak('Invalid argument list') if $args and ref $args ne 'ARRAY';
54
55  bless {
56   args => $args,
57  }, $class;
58 }
59
60 =head2 C<new_trainer>
61
62 Creates a new command object suitable for generating suppressions.
63
64 Defaults to return C<undef>, which skips suppression generation.
65
66 =cut
67
68 sub new_trainer { }
69
70 =head2 C<args $session>
71
72 Returns the list of command-specific arguments that are to be passed to C<valgrind>.
73
74 Defaults to return the contents of the C<args> option.
75
76 =cut
77
78 sub args { @{$_[0]->{args} || []} }
79
80 =head2 C<env $session>
81
82 This event is called in scalar context before the command is ran, and the returned value goes out of scope when the analysis ends.
83 It's useful for e.g. setting up C<%ENV> for the child process by returning an L<Env::Sanctify> object, hence the name.
84
85 Defaults to void.
86
87 =cut
88
89 sub env { }
90
91 =head2 C<suppressions_tag $session>
92
93 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.
94
95 This method must be implemented when subclassing.
96
97 =cut
98
99 sub suppressions_tag;
100
101 =head1 SEE ALSO
102
103 L<Test::Valgrind>, L<Test::Valgrind::Session>.
104
105 =head1 AUTHOR
106
107 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
108
109 You can contact me by mail or on C<irc.perl.org> (vincent).
110
111 =head1 BUGS
112
113 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>.
114 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
115
116 =head1 SUPPORT
117
118 You can find documentation for this module with the perldoc command.
119
120     perldoc Test::Valgrind::Command
121
122 =head1 COPYRIGHT & LICENSE
123
124 Copyright 2009 Vincent Pit, all rights reserved.
125
126 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
127
128 =cut
129
130 1; # Test::Valgrind::Command