]> git.vpit.fr Git - perl/modules/Test-Valgrind.git/blob - lib/Test/Valgrind/Action/Captor.pm
Make sure File::Temp is recent enough for ->newdir
[perl/modules/Test-Valgrind.git] / lib / Test / Valgrind / Action / Captor.pm
1 package Test::Valgrind::Action::Captor;
2
3 use strict;
4 use warnings;
5
6 =head1 NAME
7
8 Test::Valgrind::Action::Captor - Mock Test::Valgrind::Action for capturing output.
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 class provides helpers for saving, redirecting and restoring filehandles.
21
22 It's not meant to be used directly as an action.
23
24 =cut
25
26 use File::Spec ();
27
28 use base qw<Test::Valgrind::Carp>;
29
30 =head1 METHODS
31
32 =head2 C<new>
33
34 Just a croaking stub to remind you not to use this class as a real action.
35
36 =cut
37
38 sub new { shift->_croak('This mock action isn\'t meant to be used directly') }
39
40 # Widely inspired from Capture::Tiny
41
42 sub _redirect_fh {
43  open $_[1], $_[2], $_[3]
44           or $_[0]->_croak('open(' . fileno($_[1]) . ", '$_[2]', '$_[3]'): $!");
45 }
46
47 sub _dup_fh {
48  my $fd = fileno $_[3];
49  open $_[1], $_[2] . '&' . $fd
50              or $_[0]->_croak('open(' . fileno($_[1]) . ", '$_[2]&', $fd): $!");
51 }
52
53 =head2 C<save_fh>
54
55     $tva->save_fh($from, $mode);
56     $tva->save_fh($from, $mode, $to);
57
58 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.
59
60 =cut
61
62 sub save_fh {
63  my ($self, $from, $mode, $to) = @_;
64
65  unless (defined fileno $from) {
66   $self->_redirect_fh($from, $mode, File::Spec->devnull);
67   push @{$self->{proxies}}, $from;
68  }
69
70  $self->_dup_fh(my $save, $mode, $from);
71  push @{$self->{saves}}, [ $save, $mode, $from ];
72
73  if ($to and ref $to eq 'GLOB') {
74   $self->_dup_fh($from, $mode, $to);
75  } else {
76   $self->_redirect_fh($from, $mode, defined $to ? $to : File::Spec->devnull);
77  }
78
79  return;
80 }
81
82 =head2 C<restore_all_fh>
83
84     $tva->restore_all_fh;
85
86 Restore all the filehandles that were saved with L</save_fh> to their original state.
87
88 The redirections aren't closed.
89
90 =cut
91
92 sub restore_all_fh {
93  my ($self) = @_;
94
95  for (@{$self->{saves}}) {
96   my ($save, $mode, $from) = @$_;
97   $self->_dup_fh($from, $mode, $save);
98   close $save or $self->_croak('close(saved[' . fileno($save) . "]): $!");
99  }
100  delete $self->{saves};
101
102  for (@{$self->{proxies}}) {
103   close $_ or $self->_croak('close(proxy[' . fileno($_) . "]): $!");
104  }
105  delete $self->{proxies};
106
107  return;
108 }
109
110 =head1 SEE ALSO
111
112 L<Test::Valgrind>, L<Test::Valgrind::Action>.
113
114 L<Capture::Tiny>.
115
116 =head1 AUTHOR
117
118 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
119
120 You can contact me by mail or on C<irc.perl.org> (vincent).
121
122 =head1 BUGS
123
124 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>.
125 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
126
127 =head1 SUPPORT
128
129 You can find documentation for this module with the perldoc command.
130
131     perldoc Test::Valgrind::Action::Captor
132
133 =head1 COPYRIGHT & LICENSE
134
135 Copyright 2009,2010,2011,2013,2015 Vincent Pit, all rights reserved.
136
137 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
138
139 =cut
140
141 1; # End of Test::Valgrind::Action::Captor