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