File Coverage

blib/lib/Test/TempFile.pm
Criterion Covered Total %
statement 94 94 100.0
branch 8 8 100.0
condition 3 3 100.0
subroutine 31 31 100.0
pod 23 23 100.0
total 159 159 100.0


line stmt bran cond sub pod time code
1             package Test::TempFile;
2 2     2   173375 use strict;
  2         24  
  2         58  
3 2     2   10 use warnings;
  2         4  
  2         72  
4              
5             our $VERSION = "0.92";
6              
7 2     2   10 use Carp;
  2         5  
  2         177  
8 2     2   811 use Path::Tiny ();
  2         13238  
  2         50  
9 2     2   732 use YAML::Tiny ();
  2         5801  
  2         37  
10 2     2   465 use JSON::MaybeXS ();
  2         5688  
  2         39  
11 2     2   12 use Test::Builder::Module;
  2         5  
  2         19  
12 2     2   47 use Test::More ();
  2         4  
  2         2213  
13              
14             my $Builder = Test::Builder::Module->builder;
15              
16             =head1 NAME
17              
18             Test::TempFile - compact way to use tempfiles in unit tests
19              
20             =head1 SYNOPSIS
21              
22             # Under Test::More
23              
24             my $t = Test::TempFile->new([content]);
25            
26             download_file($url, $t->path);
27             $t->exists_ok
28             ->content_is("Expected content", 'test message')
29             ->json_is({ foo => 'bar' }, 'expect file to be JSON' );
30              
31             my $t = Test::TempFile->to_json({ a => 1 });
32             run_some_script( config_file => $t->path );
33              
34             =head1 DESCRIPTION
35              
36             This is a simple module for creating temporarily files with optional initial
37             content, then running various tests on the state of the tempfile.
38              
39             It is intended for testing code that uses files as input or output.
40              
41             B. In the future a binary/raw subclass of this
42             module may be released.
43              
44             =head1 CONSTRUCTORS
45              
46             =over
47              
48             =item new ( [content] )
49              
50             Create a new tempfile. Upon creation the file will exist but be empty. When
51             this object is destroyed, the file will be deleted if it still exists.
52              
53             C may be a string or an arrayref of strings (which will be joined
54             using the empty string). The tempfile will be populated with this content.
55              
56             =cut
57              
58             sub new {
59 17     17 1 54668 my ($class, $content) = @_;
60              
61 17         101 my $pt = Path::Tiny->tempfile;
62 17         46840 my $self = { pt => $pt };
63 17         60 bless $self, $class;
64              
65 17 100       59 if (defined $content) {
66 4         10 $self->set_content($content);
67             }
68              
69 17         65 return $self;
70             }
71              
72             =item to_json ( data )
73              
74             Create a new tempfile, with content set to the JSON representation of C.
75              
76             =cut
77              
78             sub to_json {
79 1     1 1 907 my ($class, $data) = @_;
80 1         10 my $json = JSON::MaybeXS->new(utf8 => 1)->encode($data);
81 1         33 return $class->new($json);
82             }
83              
84             =item to_yaml ( data )
85              
86             Create a new tempfile, with content set to the YAML representation of C.
87              
88             =cut
89              
90             sub to_yaml {
91 1     1 1 1107 my ($class, $data) = @_;
92 1         8 my $yaml = YAML::Tiny->new($data)->write_string;
93 1         232 return $class->new($yaml);
94             }
95              
96             =back
97              
98             =head1 INSTANCE METHODS
99              
100             =over
101              
102             =item path
103              
104             Returns the string path to this tempfile.
105              
106             =cut
107              
108             sub path {
109 27     27 1 18067 my ($self) = @_;
110 27         132 return "$self->{pt}";
111             }
112              
113             =item absolute
114              
115             As C but guaranteed to be absolute.
116              
117             =cut
118              
119             sub absolute {
120 5     5 1 5269 my ($self) = @_;
121 5         19 return $self->{pt}->absolute;
122             }
123              
124             =item content
125              
126             Returns the content of this tempfile as a string.
127              
128             =cut
129              
130             sub content {
131 14     14 1 1091 my ($self) = @_;
132 14         53 return $self->{pt}->slurp_utf8;
133             }
134              
135             =item set_content ( content )
136              
137             Sets the content of this tempfile. C may be a string, or an
138             arrayref of strings (which are passed to C.
139              
140             Returns the L object to allow chaining.
141              
142             =cut
143              
144             sub set_content {
145 6     6 1 865 my ($self, $content) = @_;
146 6         25 $self->{pt}->spew_utf8($content);
147 6         2501 return $self;
148             }
149              
150             =item append_content ( content )
151              
152             Appends C to the end of the tempfile. C must be a
153             string.
154              
155             Returns the L object to allow chaining.
156              
157             =cut
158              
159             sub append_content {
160 2     2 1 1670 my ($self, $content) = @_;
161 2         10 $self->{pt}->append_utf8($content);
162 2         423 return $self;
163             }
164              
165             =item exists
166              
167             Returns whether or not the tempfile currently exists.
168              
169             =cut
170              
171             sub exists {
172 13     13 1 361 my ($self) = @_;
173 13         49 return $self->{pt}->exists;
174             }
175              
176             =item empty
177              
178             Returns true if the file is non-existent or existent but empty.
179              
180             =cut
181              
182             sub empty {
183 8     8 1 1651 my ($self) = @_;
184 8   100     39 return !$self->exists || -z $self->{pt}->path;
185             }
186              
187             =item filehandle ( [mode] )
188              
189             Returns a filehandle to the tempfile. The default C is '>'
190             (read-only) but others may be used ('<', '>>' etc.)
191              
192             =cut
193              
194             sub filehandle {
195 5     5 1 3904 my ($self, $mode) = @_;
196 5 100       17 $mode = '>' if !defined $mode;
197 5         17 return $self->{pt}->filehandle($mode, ':raw:encoding(UTF-8)');
198             }
199              
200             =item unlink
201              
202             Unlinks (deletes) the tempfile if it exists.
203              
204             =cut
205              
206             sub unlink {
207 1     1 1 829 my ($self) = @_;
208 1         5 return $self->{pt}->remove;
209             }
210              
211             =item from_json
212              
213             Interprets the tempfile contents as JSON and returned the decoded
214             Perl data.
215              
216             =cut
217              
218             sub from_json {
219 3     3 1 449 my ($self) = @_;
220 3         44 return JSON::MaybeXS->new(utf8 => 1)->decode($self->content);
221             }
222              
223             =item from_yaml
224              
225             Interprets the tempfile contents as JSON and returned the decoded
226             Perl data.
227              
228             =cut
229              
230             sub from_yaml {
231 3     3 1 450 my ($self) = @_;
232 3         11 return YAML::Tiny->read($self->path)->[0];
233             }
234              
235             =back
236              
237             =head1 TEST METHODS
238              
239             These methods can be used inside unit tests. They always return the
240             L object itself, so multiple tests can be chained.
241              
242             =over
243              
244             =item exists_ok ( [message] )
245              
246             Asserts that the tempfile exists.
247              
248             =cut
249              
250             sub exists_ok {
251 1     1 1 4 my ($self, $message) = @_;
252 1         4 $Builder->ok($self->exists, $message);
253 1         209 return $self;
254             }
255              
256             =item not_exists_ok ( [message] )
257              
258             Asserts that the tempfile does not exist.
259              
260             =cut
261              
262             sub not_exists_ok {
263 1     1 1 4 my ($self, $message) = @_;
264 1         4 $Builder->ok(!$self->exists, $message);
265 1         819 return $self;
266             }
267              
268             =item empty_ok ( [message] )
269              
270             Asserts that the tempfile is empty.
271              
272             =cut
273              
274             sub empty_ok {
275 2     2 1 351 my ($self, $message) = @_;
276 2         10 $Builder->ok($self->empty, $message);
277 2         1061 return $self;
278             }
279              
280             =item not_empty_ok ( [message] )
281              
282             Asserts that the tempfile is not empty.
283              
284             =cut
285              
286             sub not_empty_ok {
287 2     2 1 204 my ($self, $message) = @_;
288 2         10 $Builder->ok(!$self->empty, $message);
289 2         1242 return $self;
290             }
291              
292             =item content_is ( expected [, message] )
293              
294             Asserts that the tempfile contents are equal to C.
295              
296             =cut
297              
298             sub content_is {
299 4     4 1 839 my ($self, $expected, $message) = @_;
300 4         14 $Builder->is_eq($self->content, $expected, $message);
301 4         5322 return $self;
302             }
303              
304             =item content_like ( expected [, message] )
305              
306             Asserts that the tempfile contents match the regex C.
307              
308             =cut
309              
310             sub content_like {
311 3     3 1 13 my ($self, $expected, $message) = @_;
312 3         9 $Builder->like($self->content, $expected, $message);
313 3         3280 return $self;
314             }
315              
316             =item json_is ( expected [, message] )
317              
318             Asserts that the tempfile contains JSON content equivalent to the Perl data in
319             C.
320              
321             =cut
322              
323             sub json_is {
324 2     2 1 732 my ($self, $expected, $message) = @_;
325              
326 2         5 local $Test::Builder::Level = $Test::Builder::Level + 1;
327 2         8 Test::More::is_deeply($self->from_json, $expected, $message);
328              
329 2         2278 return $self;
330             }
331              
332             =item yaml_is ( expected [, message] )
333              
334             Asserts that the tempfile contains YAML content equivalent to the Perl data in
335             C.
336              
337             =cut
338              
339             sub yaml_is {
340 2     2 1 629 my ($self, $expected, $message) = @_;
341              
342 2         6 local $Test::Builder::Level = $Test::Builder::Level + 1;
343 2         10 Test::More::is_deeply($self->from_yaml, $expected, $message);
344              
345 2         15417 return $self;
346             }
347              
348             =item assert ( coderef, message )
349              
350             Calls C with C<$_> set to this object. Asserts that the C
351             returns true. Returns the original object.
352              
353             Is useful when chaining multiple tests together:
354              
355             $t->not_empty_ok
356             ->assert(sub { $_->content =~ /foo/ })
357             ->assert(sub { $_->content !~ /bar/ });
358              
359             =cut
360              
361             sub assert {
362 8     8 1 3552 my ($self, $coderef, $message) = @_;
363              
364 8 100       45 $coderef
365             or croak "missing coderef";
366              
367 7 100       43 ref $coderef eq 'CODE'
368             or croak "first argument to assert() must be a code reference";
369              
370 5         9 local $_ = $self;
371 5         13 $Builder->ok( $coderef->(), $message );
372              
373 5         2329 return $self;
374             }
375              
376             =back
377              
378             =cut
379              
380             1;