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   164415 use strict;
  2         22  
  2         56  
3 2     2   10 use warnings;
  2         3  
  2         72  
4              
5             our $VERSION = "0.91";
6              
7 2     2   11 use Carp;
  2         3  
  2         110  
8 2     2   832 use Path::Tiny ();
  2         13086  
  2         38  
9 2     2   591 use YAML::Tiny ();
  2         5693  
  2         39  
10 2     2   431 use JSON::MaybeXS ();
  2         5527  
  2         49  
11 2     2   13 use Test::Builder::Module;
  2         3  
  2         14  
12 2     2   46 use Test::More ();
  2         4  
  2         2127  
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 50871 my ($class, $content) = @_;
60              
61 17         86 my $pt = Path::Tiny->tempfile;
62 17         43961 my $self = { pt => $pt };
63 17         56 bless $self, $class;
64              
65 17 100       55 if (defined $content) {
66 4         12 $self->set_content($content);
67             }
68              
69 17         70 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 879 my ($class, $data) = @_;
80 1         9 my $json = JSON::MaybeXS->new(utf8 => 1)->encode($data);
81 1         32 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 1054 my ($class, $data) = @_;
92 1         8 my $yaml = YAML::Tiny->new($data)->write_string;
93 1         202 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 17370 my ($self) = @_;
110 27         136 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 4962 my ($self) = @_;
121 5         18 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 1004 my ($self) = @_;
132 14         48 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 803 my ($self, $content) = @_;
146 6         22 $self->{pt}->spew_utf8($content);
147 6         2363 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 1612 my ($self, $content) = @_;
161 2         11 $self->{pt}->append_utf8($content);
162 2         419 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 368 my ($self) = @_;
173 13         48 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 1596 my ($self) = @_;
184 8   100     27 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 3765 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 774 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 435 my ($self) = @_;
220 3         22 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 423 my ($self) = @_;
232 3         8 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         3 $Builder->ok($self->exists, $message);
253 1         206 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 3 my ($self, $message) = @_;
264 1         3 $Builder->ok(!$self->exists, $message);
265 1         799 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 242 my ($self, $message) = @_;
276 2         8 $Builder->ok($self->empty, $message);
277 2         1010 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 188 my ($self, $message) = @_;
288 2         6 $Builder->ok(!$self->empty, $message);
289 2         1232 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 746 my ($self, $expected, $message) = @_;
300 4         9 $Builder->is_eq($self->content, $expected, $message);
301 4         4873 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 8 my ($self, $expected, $message) = @_;
312 3         9 $Builder->like($self->content, $expected, $message);
313 3         3237 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 625 my ($self, $expected, $message) = @_;
325              
326 2         5 local $Test::Builder::Level = $Test::Builder::Level + 1;
327 2         5 Test::More::is_deeply($self->from_json, $expected, $message);
328              
329 2         2089 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 646 my ($self, $expected, $message) = @_;
341              
342 2         5 local $Test::Builder::Level = $Test::Builder::Level + 1;
343 2         6 Test::More::is_deeply($self->from_yaml, $expected, $message);
344              
345 2         14819 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 3397 my ($self, $coderef, $message) = @_;
363              
364 8 100       38 $coderef
365             or croak "missing coderef";
366              
367 7 100       41 ref $coderef eq 'CODE'
368             or croak "first argument to assert() must be a code reference";
369              
370 5         7 local $_ = $self;
371 5         19 $Builder->ok( $coderef->(), $message );
372              
373 5         2285 return $self;
374             }
375              
376             =back
377              
378             =cut
379              
380             1;