File Coverage

blib/lib/App/Countdown.pm
Criterion Covered Total %
statement 61 96 63.5
branch 18 34 52.9
condition 2 5 40.0
subroutine 15 19 78.9
pod 2 2 100.0
total 98 156 62.8


line stmt bran cond sub pod time code
1             package App::Countdown;
2             $App::Countdown::VERSION = '0.8.2';
3 1     1   79385 use 5.010;
  1         12  
4              
5 1     1   4 use strict;
  1         2  
  1         19  
6 1     1   4 use warnings FATAL => 'all';
  1         2  
  1         37  
7              
8 1     1   432 use DateTime::Format::Natural ();
  1         437309  
  1         30  
9 1     1   447 use Time::HiRes qw(sleep time);
  1         1049  
  1         4  
10 1     1   151 use POSIX qw();
  1         2  
  1         17  
11 1     1   448 use IO::Handle;
  1         4877  
  1         42  
12 1     1   575 use Getopt::Long qw(2.36 GetOptionsFromArray);
  1         8711  
  1         4  
13 1     1   561 use Pod::Usage;
  1         40169  
  1         91  
14 1     1   7 use Carp;
  1         2  
  1         783  
15              
16              
17             sub new
18             {
19 1     1 1 106 my $class = shift;
20              
21 1         2 my $self = bless {}, $class;
22              
23 1         6 $self->_init(@_);
24              
25 1         3 return $self;
26             }
27              
28             sub _delay
29             {
30 1     1   2 my $self = shift;
31              
32 1 50       3 if (@_)
33             {
34 1         5 $self->{_delay} = shift;
35             }
36              
37 1         2 return $self->{_delay};
38             }
39              
40             sub _end
41             {
42 0     0   0 my $self = shift;
43              
44 0 0       0 if (@_)
45             {
46 0         0 $self->{_end} = shift;
47             }
48              
49 0         0 return $self->{_end};
50             }
51              
52             my $up_to_60_re = qr/[1-9]|[1-5][0-9]|0[0-9]?/;
53              
54             sub _get_up_to_60_val
55             {
56 13     13   42 my ($v) = @_;
57              
58 13   100     56 ( $v //= '' ) =~ s/\A0*//;
59              
60 13 100       66 return ( length($v) ? $v : 0 );
61             }
62              
63             sub _calc_delay
64             {
65 19     19   47 my ( $self, $delay_spec ) = @_;
66              
67 19 100       253 if ( my ( $n, $qualifier ) =
    100          
    50          
68             $delay_spec =~ /\A((?:[1-9][0-9]*(?:\.\d*)?)|(?:0\.\d+))([mhs]?)\z/ )
69             {
70             return int(
71 11 100       72 $n * (
    100          
72             $qualifier eq 'h' ? ( 60 * 60 )
73             : $qualifier eq 'm' ? 60
74             : 1
75             )
76             );
77             }
78             elsif ( my ( $min, $sec ) =
79             $delay_spec =~ /\A([1-9][0-9]*)m($up_to_60_re)s\z/ )
80             {
81 3         11 return $min * 60 + _get_up_to_60_val($sec);
82             }
83             elsif ( ( ( my $hour ), $min, $sec ) =
84             $delay_spec =~
85             /\A([1-9][0-9]*)h(?:($up_to_60_re)m)?(?:($up_to_60_re)s)?\z/ )
86             {
87 5         14 return ( ( $hour * 60 + _get_up_to_60_val($min) ) * 60 +
88             _get_up_to_60_val($sec) );
89             }
90             else
91             {
92 0         0 die
93             "Invalid delay. Must be a positive and possibly fractional number, possibly followed by s, m, or h";
94             }
95             }
96              
97             sub _init
98             {
99 1     1   9 my ( $self, $args ) = @_;
100              
101 1         2 my $argv = [ @{ $args->{argv} } ];
  1         2  
102              
103 1         2 my $help = 0;
104 1         1 my $man = 0;
105 1         2 my $version = 0;
106 1         1 my $end_str;
107 1 50       7 if (
108             !(
109             my $ret = GetOptionsFromArray(
110             $argv,
111             'help|h' => \$help,
112             man => \$man,
113             version => \$version,
114             'to=s' => \$end_str,
115             )
116             )
117             )
118             {
119 0         0 die "GetOptions failed!";
120             }
121              
122 1 50       372 if ($help)
123             {
124 0         0 pod2usage(1);
125             }
126              
127 1 50       2 if ($man)
128             {
129 0         0 pod2usage( -verbose => 2 );
130             }
131              
132 1 50       3 if ($version)
133             {
134 0         0 print "countdown version $App::Countdown::VERSION .\n";
135 0         0 exit(0);
136             }
137              
138 1 50       4 if ( defined $end_str )
139             {
140 0         0 my $parser = DateTime::Format::Natural->new(
141             prefer_future => 1,
142             time_zone => 'local',
143             );
144 0         0 my $dt = $parser->parse_datetime($end_str);
145 0 0       0 if ( not $parser->success )
146             {
147 0         0 die $parser->error;
148             }
149 0         0 $self->_end( $dt->epoch );
150             }
151             else
152             {
153 1         3 my $delay = shift(@$argv);
154              
155 1 50       2 if ( !defined $delay )
156             {
157 0         0 Carp::confess("You should pass a number of seconds.");
158             }
159              
160 1         5 $self->_delay( $self->_calc_delay($delay) );
161             }
162 1         2 return;
163             }
164              
165             sub _format
166             {
167 0     0     my $delay = shift;
168 0           return sprintf( "%d:%02d:%02d",
169             POSIX::floor( $delay / 3600 ),
170             POSIX::floor( $delay / 60 ) % 60,
171             $delay % 60 );
172             }
173              
174             sub _calc_end
175             {
176 0     0     my ( $self, $start ) = @_;
177              
178 0 0         return defined( $self->_end ) ? $self->_end : ( $start + $self->_delay );
179             }
180              
181             sub run
182             {
183 0     0 1   my ($self) = @_;
184              
185 0           STDOUT->autoflush(1);
186              
187 0           my $start = time();
188 0           my $end = $self->_calc_end($start);
189              
190 0           my $delay = $end - $start;
191              
192 0           my $hms_tot = _format($delay);
193 0           my $last_printed;
194 0           while ( ( my $t = time() ) < $end )
195             {
196 0           my $new_to_print = POSIX::floor( $end - $t );
197 0 0 0       if ( !defined($last_printed) or $new_to_print != $last_printed )
198             {
199 0           $last_printed = $new_to_print;
200 0           my $hms = _format($new_to_print);
201 0           print "Remaining $hms / $hms_tot ( $new_to_print/$delay )",
202             ' ' x 10, "\r";
203             }
204 0           sleep(0.1);
205             }
206              
207 0           return;
208             }
209              
210             1;
211              
212              
213             1; # End of App::Countdown
214              
215             __END__
216              
217             =pod
218              
219             =encoding UTF-8
220              
221             =head1 NAME
222              
223             App::Countdown - wait some specified time while displaying the remaining time.
224              
225             =head1 VERSION
226              
227             version 0.8.2
228              
229             =head1 SYNOPSIS
230              
231             use App::Countdown;
232              
233             App::Countdown->new({ argv => [@ARGV] })->run();
234              
235             =head1 SUBROUTINES/METHODS
236              
237             =head2 new
238              
239             A constructor. Accepts the argv named arguments.
240              
241             =head2 run
242              
243             Runs the program.
244              
245             =head1 AUTHOR
246              
247             Shlomi Fish, L<http://www.shlomifish.org/>, C<< <shlomif at cpan.org> >> .
248              
249             =head1 BUGS
250              
251             Please report any bugs or feature requests to
252             L<https://github.com/shlomif/App-Countdown/issues> .
253              
254             =head1 SUPPORT
255              
256             You can find documentation for this module with the perldoc command.
257              
258             perldoc App::Countdown
259              
260             You can also look for information at:
261              
262             =over 4
263              
264             =item * RT: CPAN's request tracker (report bugs here)
265              
266             L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=App-Countdown>
267              
268             =item * AnnoCPAN: Annotated CPAN documentation
269              
270             L<http://annocpan.org/dist/App-Countdown>
271              
272             =item * CPAN Ratings
273              
274             L<http://cpanratings.perl.org/d/App-Countdown>
275              
276             =item * Search CPAN
277              
278             L<http://search.cpan.org/dist/App-Countdown/>
279              
280             =back
281              
282             =head1 ACKNOWLEDGEMENTS
283              
284             =over 4
285              
286             =item * Neil Bowers
287              
288             Reporting a typo and a problem with the description not fitting on one line.
289              
290             =back
291              
292             =head1 LICENSE AND COPYRIGHT
293              
294             Copyright 2012 Shlomi Fish.
295              
296             This program is distributed under the MIT (X11) License:
297             L<http://www.opensource.org/licenses/mit-license.php>
298              
299             Permission is hereby granted, free of charge, to any person
300             obtaining a copy of this software and associated documentation
301             files (the "Software"), to deal in the Software without
302             restriction, including without limitation the rights to use,
303             copy, modify, merge, publish, distribute, sublicense, and/or sell
304             copies of the Software, and to permit persons to whom the
305             Software is furnished to do so, subject to the following
306             conditions:
307              
308             The above copyright notice and this permission notice shall be
309             included in all copies or substantial portions of the Software.
310              
311             THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
312             EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
313             OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
314             NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
315             HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
316             WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
317             FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
318             OTHER DEALINGS IN THE SOFTWARE.
319              
320             =for :stopwords cpan testmatrix url bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
321              
322             =head1 SUPPORT
323              
324             =head2 Websites
325              
326             The following websites have more information about this module, and may be of help to you. As always,
327             in addition to those websites please use your favorite search engine to discover more resources.
328              
329             =over 4
330              
331             =item *
332              
333             MetaCPAN
334              
335             A modern, open-source CPAN search engine, useful to view POD in HTML format.
336              
337             L<https://metacpan.org/release/App-Countdown>
338              
339             =item *
340              
341             Search CPAN
342              
343             The default CPAN search engine, useful to view POD in HTML format.
344              
345             L<http://search.cpan.org/dist/App-Countdown>
346              
347             =item *
348              
349             RT: CPAN's Bug Tracker
350              
351             The RT ( Request Tracker ) website is the default bug/issue tracking system for CPAN.
352              
353             L<https://rt.cpan.org/Public/Dist/Display.html?Name=App-Countdown>
354              
355             =item *
356              
357             CPAN Ratings
358              
359             The CPAN Ratings is a website that allows community ratings and reviews of Perl modules.
360              
361             L<http://cpanratings.perl.org/d/App-Countdown>
362              
363             =item *
364              
365             CPANTS
366              
367             The CPANTS is a website that analyzes the Kwalitee ( code metrics ) of a distribution.
368              
369             L<http://cpants.cpanauthors.org/dist/App-Countdown>
370              
371             =item *
372              
373             CPAN Testers
374              
375             The CPAN Testers is a network of smoke testers who run automated tests on uploaded CPAN distributions.
376              
377             L<http://www.cpantesters.org/distro/A/App-Countdown>
378              
379             =item *
380              
381             CPAN Testers Matrix
382              
383             The CPAN Testers Matrix is a website that provides a visual overview of the test results for a distribution on various Perls/platforms.
384              
385             L<http://matrix.cpantesters.org/?dist=App-Countdown>
386              
387             =item *
388              
389             CPAN Testers Dependencies
390              
391             The CPAN Testers Dependencies is a website that shows a chart of the test results of all dependencies for a distribution.
392              
393             L<http://deps.cpantesters.org/?module=App::Countdown>
394              
395             =back
396              
397             =head2 Bugs / Feature Requests
398              
399             Please report any bugs or feature requests by email to C<bug-app-countdown at rt.cpan.org>, or through
400             the web interface at L<https://rt.cpan.org/Public/Bug/Report.html?Queue=App-Countdown>. You will be automatically notified of any
401             progress on the request by the system.
402              
403             =head2 Source Code
404              
405             The code is open to the world, and available for you to hack on. Please feel free to browse it and play
406             with it, or whatever. If you want to contribute patches, please send me a diff or prod me to pull
407             from your repository :)
408              
409             L<https://github.com/shlomif/app-countdown>
410              
411             git clone https://github.com/shlomif/App-Countdown
412              
413             =head1 AUTHOR
414              
415             Shlomi Fish <shlomif@cpan.org>
416              
417             =head1 BUGS
418              
419             Please report any bugs or feature requests on the bugtracker website
420             L<https://github.com/shlomif/app-countdown/issues>
421              
422             When submitting a bug or request, please include a test-file or a
423             patch to an existing test-file that illustrates the bug or desired
424             feature.
425              
426             =head1 COPYRIGHT AND LICENSE
427              
428             This software is Copyright (c) 2020 by Shlomi Fish.
429              
430             This is free software, licensed under:
431              
432             The MIT (X11) License
433              
434             =cut