1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
|
package Test::Trap::Builder::TempFile;
use version; $VERSION = qv('0.3.5');
use strict;
use warnings;
use IO::Handle;
use File::Temp qw( tempfile );
use Test::Trap::Builder;
########
#
# I can no longer (easily?) install Devel::Cover on 5.6.2, so silence the coverage report:
#
# uncoverable condition right
# uncoverable condition false
use constant GOTPERLIO => (eval "use PerlIO (); 1" || 0);
sub import {
shift; # package name
my $strategy_name = @_ ? shift : 'tempfile';
my $strategy_option = @_ ? shift : {};
Test::Trap::Builder->capture_strategy( $strategy_name => $_ ) for sub {
my $self = shift;
my ($name, $fileno, $globref) = @_;
my $pid = $$;
my ($fh, $file) = do {
local ($!, $^E);
tempfile( UNLINK => 1 ); # XXX: Test?
};
# make an alias to $self->{$name}, so that the closure does not hold $self:
for my $buffer ($self->{$name}) {
$self->Teardown($_) for sub {
# if the file is opened by some other process, that one should deal with it:
return unless $pid == $$;
local $/;
local ($!, $^E);
$buffer .= <$fh>;
close $fh;
unlink $file;
};
}
my @io_layers;
IO_LAYERS: {
GOTPERLIO or last IO_LAYERS;
local($!, $^E);
if ($strategy_option->{preserve_io_layers}) {
@io_layers = PerlIO::get_layers(*$globref, output => 1);
}
if ($strategy_option->{io_layers}) {
push @io_layers, $strategy_option->{io_layers};
}
binmode $fh; # set the perlio layers for reading:
binmode $fh, $_ for @io_layers;
}
local *$globref;
{
no warnings 'io';
local ($!, $^E);
open *$globref, '>>', $file;
}
IO_LAYERS: {
GOTPERLIO or last IO_LAYERS;
local($!, $^E);
binmode *$globref; # set the perlio layers for writing:
binmode *$globref, $_ for @io_layers;
}
*$globref->autoflush(1);
$self->Next;
};
}
1; # End of Test::Trap::Builder::TempFile
__END__
=head1 NAME
Test::Trap::Builder::TempFile - Capture strategies using File::Temp
=head1 VERSION
Version 0.3.5
=head1 DESCRIPTION
This module by default provides a capture strategy based on File::Temp
for the trap's output layers.
The import accepts a name (as a string; default I<tempfile>) and
options (as a hashref; by default empty), and registers a capture
strategy with that name and a variant implementation based on the
options.
Note that you may specify different strategies for each output layer
on the trap.
See also L<Test::Trap> (:stdout and :stderr) and
L<Test::Trap::Builder> (output_layer).
=head1 OPTIONS
The following options are recognized:
=head2 preserve_io_layers
A boolean, indicating whether to apply to the handles writing to and
reading from the tempfile, the same perlio layers as are found on the
to-be-trapped output handle.
=head2 io_layers
A colon-separated string representing perlio layers to be applied to
the handles writing to and reading from the tempfile.
If the I<preserve_io_layers> option is set, these perlio layers will
be applied on top of the original (preserved) perlio layers.
=head1 CAVEATS
Using File::Temp, we need privileges to create tempfiles.
We need disk space for the output of every trap (it should clean up
after the trap is sprung).
Disk access may be slow -- certainly compared to the in-memory files
of PerlIO.
If the options specify (explicitly or via preserve on handles with)
perlio custom layers, they may (or may not) fail to apply to the
tempfile read and write handles.
Threads? No idea. It might even work correctly.
=head1 BUGS
Please report any bugs or feature requests directly to the author.
=head1 AUTHOR
Eirik Berg Hanssen, C<< <ebhanssen@cpan.org> >>
=head1 COPYRIGHT & LICENSE
Copyright 2006-2014 Eirik Berg Hanssen, All Rights Reserved.
This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
|
