File Coverage

blib/lib/Test2/Tools/SkipUntil.pm
Criterion Covered Total %
statement 61 62 98.3
branch 20 24 83.3
condition 18 21 85.7
subroutine 14 14 100.0
pod 2 7 28.5
total 115 128 89.8


line stmt bran cond sub pod time code
1             package Test2::Tools::SkipUntil;
2 4     4   332484 use strict;
  4         18  
  4         102  
3 4     4   16 use warnings;
  4         5  
  4         94  
4 4     4   16 use Carp 'croak';
  4         8  
  4         199  
5 4     4   484 use Test2::API 'context';
  4         58312  
  4         182  
6 4     4   1344 use Time::Piece;
  4         27327  
  4         18  
7              
8             our $VERSION = '0.04';
9             our @EXPORT = qw(skip_until skip_all_until);
10 4     4   419 use base 'Exporter';
  4         7  
  4         949  
11              
12             sub skip_until($;$$) {
13 7     7 1 11810 my ($why, $count, $datetime) = @_;
14              
15 7         26 check_why($why);
16              
17             # count is optional
18 6 100       15 if (@_ == 3) {
19 4         9 check_skip_count($count);
20             }
21             else {
22 2         5 $datetime = $count;
23 2         3 $count = 1;
24             }
25              
26 5         12 my $timepiece = parse_datetime($datetime);
27 3         214 $timepiece = apply_offset($timepiece);
28              
29 3 100       169 if (should_skip($timepiece)) {
30             # copied from Test2::Tools::Basic::skip
31 2         43 my $ctx = context();
32 2         150 $ctx->skip('skipped test', "$why until $timepiece") for (1..$count);
33 2         1292 $ctx->release;
34 4     4   27 no warnings 'exiting';
  4         7  
  4         1939  
35 2         53 last SKIP;
36             }
37             }
38              
39             sub skip_all_until($$) {
40 1     1 1 89 my ($why, $datetime) = @_;
41              
42 1         9 check_why($why);
43              
44 1         4 my $timepiece = parse_datetime($datetime);
45 1         124 $timepiece = apply_offset($timepiece);
46              
47 1 50       112 if (should_skip($timepiece)) {
48             # copied from Test2::Tools::Basic::skip_all
49 1         33 my $ctx = context();
50 1         5909 $ctx->plan(0, SKIP => "$why until $timepiece");
51 0 0       0 $ctx->release if $ctx;
52             }
53             }
54              
55             sub check_why {
56 12     12 0 2442 my $why = shift;
57 12 100 100     74 unless(defined $why && ref $why eq '' && length $why) {
      100        
58 5 100       497 croak sprintf 'requires "why" defined scalar argument (got %s)',
59             defined $why ? $why : 'undef';
60             }
61 7         14 return 1;
62             }
63              
64             sub should_skip {
65 6     6 0 2622 my $timepiece = shift;
66              
67 6 50 33     21 croak 'Requires a Time::Piece argument'
68             unless $timepiece && ref $timepiece eq 'Time::Piece';
69              
70 6         199 my $timepiece_now = localtime;
71 6         355 return $timepiece_now < $timepiece;
72             }
73              
74             sub check_skip_count {
75 13     13 0 3784 my $count = shift;
76 13 100 100     123 unless (defined $count &&
      66        
77             $count =~ qr/^\d+$/ &&
78             $count > 0)
79             {
80 7 100       642 croak sprintf('skip test count must be a positive integer! (got %s)',
81             defined $count ? $count : 'undef');
82             }
83 6         26 return 1;
84             }
85              
86             sub parse_datetime {
87 14     14 0 14357 my $datetime = shift;
88              
89 14 100 100     189 if ($datetime && $datetime =~ qr/^\d\d\d\d-\d\d-\d\dT\d\d:\d\d:\d\d$/) {
    100 100        
90 1         15 return Time::Piece->strptime($datetime, '%Y-%m-%dT%H:%M:%S');
91             }
92             elsif ($datetime && $datetime =~ qr/^\d\d\d\d-\d\d-\d\d$/) {
93 5         42 return Time::Piece->strptime($datetime, '%Y-%m-%d');
94             }
95             else {
96 8 100       760 croak sprintf q#Datetime must be in format YYYY-MM-DD(THH:MM:SS)? (got %s)#,
97             defined $datetime ? $datetime : 'undef';
98             }
99             }
100              
101             sub apply_offset {
102 5     5 0 2623 my $timepiece = shift;
103 5         18 my $offset_secs = localtime()->tzoffset;
104 5         913 return $timepiece + $offset_secs;
105             }
106              
107             1;
108             =head1 NAME
109              
110             Test2::Tools::SkipUntil - skip tests until a date is reached
111              
112             =head1 SYNOPSIS
113              
114             use Test2::Bundle::More
115             use Test2::Tools::SkipUntil;
116              
117             SKIP: {
118             skip_until "known fail see issue #213", '2018-06-01';
119             ...
120             }
121              
122             ...
123              
124             done_testing;
125              
126             =head1 DESCRIPTION
127              
128             Exports two functions for skipping tests until a datetime is reached. Dates are
129             evaluated in C. These might be useful when you have known exceptions
130             in your test suite which are temporary.
131              
132             =head1 FUNCTIONS
133              
134             =head2 skip_until ($why, $count, $datetime)
135              
136             Skips all tests in a C block, registering C<$count> skipped tests until
137             C is greater than or equal to C<$datetime>. Just like with
138             L, C<$count> is
139             optional, and defaults to 1.
140              
141             C<$datetime> must be a scalar in one of the following formats:
142              
143             =over 4
144              
145             =item *
146              
147             YYYY-MM-DDTHH:MM:SS - e.g. "2017-05-01T13:24:58"
148              
149             =item *
150              
151             YYYY-MM-DD - e.g. "2017-05-01"
152              
153             =back
154              
155             =head2 skip_all_until ($why, $datetime)
156              
157             Skips all tests by setting the test plan to zero, and exiting succesfully
158             unless C is greater than or equal to C<$datetime>. Behaves like
159             L.
160              
161             See L for the accepted C<$datetime> formats.
162              
163             =head1 SOURCE
164              
165             The source code repository for Test2-Tools-SkipUntil can be found on L.
166              
167             =head1 AUTHORS
168              
169             David Farrell
170              
171             =head1 COPYRIGHT
172              
173             Copyright 2018 David Farrell
174              
175             =head1 LICENSE
176              
177             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
178              
179             See L.
180              
181             =cut