File Coverage

blib/lib/YATT/Lite/Util/File.pm
Criterion Covered Total %
statement 48 49 97.9
branch 12 16 75.0
condition 2 3 66.6
subroutine 11 11 100.0
pod 0 2 0.0
total 73 81 90.1


line stmt bran cond sub pod time code
1             package YATT::Lite::Util::File;
2 7     7   179551 use strict;
  7         19  
  7         216  
3 7     7   39 use warnings qw(FATAL all NONFATAL misc);
  7         13  
  7         229  
4 7     7   50 use Carp;
  7         14  
  7         326  
5 7     7   1104 use YATT::Lite::Util ();
  7         15  
  7         160  
6 7     7   36 use File::Basename qw(dirname);
  7         14  
  7         342  
7 7     7   49 use File::Path qw(make_path);
  7         13  
  7         299  
8 7     7   211 use Time::HiRes qw/usleep/;
  7         9644  
  7         32  
9 7     7   1364 use File::stat;
  7         39198  
  7         37  
10              
11             sub mkfile {
12 82     82 0 77329 my ($pack) = shift;
13 82         166 my @slept;
14 82         391 while (my ($fn, $content) = splice @_, 0, 2) {
15 125 50       405 ($fn, my @iolayer) = ref $fn ? @$fn : ($fn);
16 125 100       5999 unless (-d (my $dir = dirname($fn))) {
17 55 50       7848 make_path($dir) or die "Can't mkdir $dir: $!";
18             }
19 125         412 my $old_mtime;
20 125 100       2326 if (-e $fn) {
21 5 100       25 if (my $slept = wait_for_time(($old_mtime = stat($fn)->mtime) + 1.05)) {
22 2         14 push @slept, $slept;
23             }
24             }
25 125 50       8081 open my $fh, join('', '>', @iolayer), $fn or die "$fn: $!";
26 125         1348 print $fh $content;
27 125         4752 close $fh;
28 125 50 66     1224 unless (not defined $old_mtime or $old_mtime < stat($fn)->mtime) {
29 0         0 croak "Failed to update mtime for $fn!";
30             }
31             }
32 82         1359 @slept;
33             }
34              
35             #
36             sub wait_for_time {
37 5     5 0 814 my ($time) = @_;
38 5         23 my $now = Time::HiRes::time;
39 5         11 my $diff = $time - $now;
40 5 100       24 return if $diff <= 0;
41 2         1167482 usleep(int($diff * 1000 * 1000));
42 2         58 $diff;
43             }
44              
45             # Auto Export.
46             my $symtab = YATT::Lite::Util::symtab(__PACKAGE__);
47             our @EXPORT_OK = grep {
48             *{$symtab->{$_}}{CODE}
49             } keys %$symtab;
50              
51 7     7   2397 use Exporter qw(import);
  7         16  
  7         287  
52              
53             1;