File Coverage

blib/lib/YATT/Lite/XHF/StoreDir.pm
Criterion Covered Total %
statement 18 51 35.2
branch 0 20 0.0
condition 0 9 0.0
subroutine 6 11 54.5
pod 1 5 20.0
total 25 96 26.0


line stmt bran cond sub pod time code
1             package YATT::Lite::XHF::StoreDir; sub MY () {__PACKAGE__}
2 1     1   9257 use strict;
  1         2  
  1         30  
3 1     1   6 use warnings qw(FATAL all NONFATAL misc);
  1         2  
  1         43  
4              
5 1     1   6 use base qw(YATT::Lite::Object);
  1         2  
  1         165  
6 1         6 use fields qw(cf_datadir
7             cf_fileprefix
8             cf_fileext
9             cf_lockname
10 1     1   6 );
  1         2  
11              
12 1     1   74 use YATT::Lite::XHF::Dumper;
  1         2  
  1         55  
13              
14 1     1   6 use Fcntl qw(:DEFAULT :flock SEEK_SET);
  1         2  
  1         1166  
15              
16             sub after_new {
17 0     0 1   my MY $self = shift;
18 0   0       $self->{cf_fileprefix} //= '.ht_';
19 0   0       $self->{cf_fileext} //= '.xhf';
20 0   0       $self->{cf_lockname} //= 'lock';
21             }
22              
23             sub create {
24 0     0 0   my MY $self = shift;
25 0 0         my $dump = $self->dump_xhf(@_) if @_;
26 0           my ($fnum, $lockfh) = $self->lastfnum(1);
27 0           my ($fname);
28 0           do {
29 0           $fname = "$self->{cf_datadir}/$self->{cf_fileprefix}" . ++$fnum;
30             } while (-e $fname);
31              
32 0 0         seek $lockfh, 0, SEEK_SET
33             or die "Can't seek: $!";
34 0           print $lockfh $fnum, "\n";
35 0           truncate $lockfh, tell($lockfh);
36              
37 0 0         open my $fh, '>', $fname
38             or die "Can't open newfile '$fname': $!";
39              
40 0 0         if (defined $dump) {
41 0           print $fh $dump;
42 0           return $fnum;
43             } else {
44 0 0         wantarray ? ($fh, $fnum, $fname) : $fh;
45             }
46             }
47              
48             sub fnum2path {
49 0     0 0   (my MY $self, my $fnum) = @_;
50 0           "$self->{cf_datadir}/$self->{cf_fileprefix}$fnum";
51             }
52              
53             sub lastfnum {
54 0     0 0   (my MY $self) = shift;
55 0           my $lockfh = $self->openlock(@_);
56 0           my $num = <$lockfh>;
57 0 0 0       if (defined $num and $num =~ /^\d+/) {
58 0           $num = $&;
59             } else {
60 0           $num = 0;
61             }
62 0 0         wantarray ? ($num, $lockfh) : $num;
63             }
64              
65             sub openlock {
66 0     0 0   (my MY $self, my $flock) = @_;
67 0           my $lockfn = "$self->{cf_datadir}/$self->{cf_fileprefix}$self->{cf_lockname}";
68 0 0         sysopen my $lockfh, $lockfn, O_RDWR | O_CREAT
69             or die "Can't open '$lockfn': $!";
70              
71 0 0         if ($flock) {
72 0 0         flock $lockfh, LOCK_EX
73             or die "Can't lock '$lockfn': $!";
74             }
75 0           $lockfh;
76             }
77              
78             1;