1package PrimitiveCapture;
2use strict;
3use warnings;
4
5if ("$]" >= 5.008000) {
6  eval "#line @{[__LINE__+1]} ".q{"lib/PrimitiveCapture.pm"
7    sub capture_stdout {
8      my $sub = shift;
9      my $stdout;
10      open my $oldout, ">&STDOUT" or die "Can't dup STDOUT: $!";
11      close STDOUT;
12      open STDOUT, '>', \$stdout or die "Can't open STDOUT: $!";
13      $sub->();
14      close STDOUT;
15      open STDOUT, ">&", $oldout or die "Can't dup \$oldout: $!";
16      return $stdout;
17    }
18    sub capture_stderr {
19      my $sub = shift;
20      my $stderr;
21      open my $olderr, ">&STDERR" or die "Can't dup STDERR: $!";
22      close STDERR;
23      open STDERR, '>', \$stderr or die "Can't open STDERR: $!";
24      $sub->();
25      close STDERR;
26      open STDERR, ">&", $olderr or die "Can't dup \$olderr: $!";
27      return $stderr;
28    }
29  }; die $@ unless $@ eq "";
30} else {
31  eval "#line @{[__LINE__+1]} ".q{"lib/PrimitiveCapture.pm"
32    use File::Spec;
33    use File::Temp;
34    my $tmpdir;
35    my $i = 0;
36    sub _tmpfile {
37      $tmpdir ||= File::Temp::tempdir(CLEANUP => 1, TMPDIR => 1);
38      return File::Spec->catfile($tmpdir, $i++);
39    }
40    sub _slurp {
41      my $filename = shift;
42      open my $fh, "<", $filename or die "Can't read $filename: $!";
43      local $/ = undef;
44      my $content = <$fh>;
45      defined $content or die "Can't read $filename: $!";
46      return $content;
47    }
48    sub capture_stdout {
49      my $sub = shift;
50      my $tmpfile = _tmpfile();
51      local *OLDSTDOUT;
52      open OLDSTDOUT, ">&STDOUT" or die "Can't dup STDOUT: $!";
53      close STDOUT;
54      open STDOUT, '>', $tmpfile or die "Can't open STDOUT: $!";
55      $sub->();
56      close STDOUT;
57      open STDOUT, ">&OLDSTDOUT" or die "Can't dup OLDSTDOUT: $!";
58      close OLDSTDOUT;
59      return _slurp($tmpfile);
60    }
61    sub capture_stderr {
62      my $sub = shift;
63      my $tmpfile = _tmpfile();
64      local *OLDSTDERR;
65      open OLDSTDERR, ">&STDERR" or die "Can't dup STDERR: $!";
66      close STDERR;
67      open STDERR, '>', $tmpfile or die "Can't open STDERR: $!";
68      $sub->();
69      close STDERR;
70      open STDERR, ">&OLDSTDERR" or die "Can't dup OLDSTDERR: $!";
71      close OLDSTDERR;
72      return _slurp($tmpfile);
73    }
74  }; die $@ unless $@ eq "";
75}
76
771;
78