1 package Test::Valgrind::Action::Captor;
8 Test::Valgrind::Action::Captor - Mock Test::Valgrind::Action for capturing output.
16 our $VERSION = '1.00';
20 This class provides helpers for saving, redirecting and restoring filehandles.
22 It's not meant to be used directly as an action.
28 use base qw/Test::Valgrind::Carp/;
34 Just a croaking stub to remind you not to use this class as a real action.
38 sub new { shift->_croak('This mock action isn\'t meant to be used directly') }
40 # Widely inspired from Capture::Tiny
43 open $_[1], $_[2], $_[3]
44 or $_[0]->_croak('open(' . fileno($_[1]) . ", '$_[2]', '$_[3]'): $!");
48 my $fd = fileno $_[3];
49 open $_[1], $_[2] . '&' . $fd
50 or $_[0]->_croak('open(' . fileno($_[1]) . ", '$_[2]&', $fd): $!");
53 =head2 C<save_fh $from, $mode [, $to ]>
55 Save the original filehandle C<$from> opened with mode C<$mode>, and redirect it to C<$to> if it's defined or to F</dev/null> otherwise.
60 my ($self, $from, $mode, $to) = @_;
62 unless (defined fileno $from) {
63 $self->_redirect_fh($from, $mode, File::Spec->devnull);
64 push @{$self->{proxies}}, $from;
67 $self->_dup_fh(my $save, $mode, $from);
68 push @{$self->{saves}}, [ $save, $mode, $from ];
70 if ($to and ref $to eq 'GLOB') {
71 $self->_dup_fh($from, $mode, $to);
73 $self->_redirect_fh($from, $mode, defined $to ? $to : File::Spec->devnull);
79 =head2 C<restore_all_fh>
81 Restore all the filehandles that were saved with L</save_fh> to their original state.
83 The redirections aren't closed.
90 for (@{$self->{saves}}) {
91 my ($save, $mode, $from) = @$_;
92 $self->_dup_fh($from, $mode, $save);
93 close $save or $self->_croak('close(saved[' . fileno($save) . "]): $!");
95 delete $self->{saves};
97 for (@{$self->{proxies}}) {
98 close $_ or $self->_croak('close(proxy[' . fileno($_) . "]): $!");
100 delete $self->{proxies};
107 L<Test::Valgrind>, L<Test::Valgrind::Action>.
113 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
115 You can contact me by mail or on C<irc.perl.org> (vincent).
119 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>.
120 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
124 You can find documentation for this module with the perldoc command.
126 perldoc Test::Valgrind::Action::Captor
128 =head1 COPYRIGHT & LICENSE
130 Copyright 2009 Vincent Pit, all rights reserved.
132 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
136 1; # End of Test::Valgrind::Action::Captor