File Coverage

blib/lib/Decision/Depends/Target.pm
Criterion Covered Total %
statement 49 49 100.0
branch 13 18 72.2
condition 2 6 33.3
subroutine 11 11 100.0
pod 0 7 0.0
total 75 91 82.4


line stmt bran cond sub pod time code
1             # --8<--8<--8<--8<--
2             #
3             # Copyright (C) 2008 Smithsonian Astrophysical Observatory
4             #
5             # This file is part of Decision::Depends
6             #
7             # Decision-Depends is free software: you can redistribute it and/or modify
8             # it under the terms of the GNU General Public License as published by
9             # the Free Software Foundation, either version 3 of the License, or (at
10             # your option) any later version.
11             #
12             # This program is distributed in the hope that it will be useful,
13             # but WITHOUT ANY WARRANTY; without even the implied warranty of
14             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15             # GNU General Public License for more details.
16             #
17             # You should have received a copy of the GNU General Public License
18             # along with this program. If not, see .
19             #
20             # -->8-->8-->8-->8--
21              
22             package Decision::Depends::Target;
23              
24             require 5.005_62;
25 11     11   54 use strict;
  11         20  
  11         422  
26 11     11   92 use warnings;
  11         18  
  11         356  
27              
28 11     11   58 use Carp;
  11         17  
  11         716  
29              
30 11     11   55 use IO::File;
  11         20  
  11         9278  
31              
32             ## no critic ( ProhibitAccessOfPrivateData )
33              
34             our $VERSION = '0.20';
35              
36             our %attr = ( target => 1,
37             targets => 1,
38             force => 0,
39             sfile => 1,
40             slink => 1,
41             );
42              
43             sub new
44             {
45 57     57 0 197 my $class = shift;
46 57   33     478 $class = ref($class) || $class;
47              
48 57         339 my ( $state, $spec ) = @_;
49              
50 57         430 my $self = { %$spec, state => $state };
51              
52 57         365 $self->{Pretend} = $self->{state}{Attr}{Pretend};
53              
54             # ensure that no bogus attributes are set
55 57         111 my @notok = grep { ! exists $attr{$_} } keys %{$self->{attr}};
  59         268  
  57         172  
56 57 50       212 croak( __PACKAGE__,
57             "->new: bad attributes for Target `$self->{val}': ",
58             join( ', ', @notok ) ) if @notok;
59              
60 57         511 bless $self, $class;
61             }
62              
63              
64             sub getTime
65             {
66 53     53 0 98 my $self = shift;
67 53         232 my $file = $self->{val};
68              
69 53         81 my @sb;
70 53   33     301 my $time =
71             $self->{state}->getTime( $file )
72             || ((@sb = stat( $file )) ? $sb[9] : undef);
73              
74             # cache the value
75 53 100       380 $self->{state}->setTime( $file, $time )
76             if defined $time;
77              
78 53         218 $time;
79             }
80              
81             sub setTime
82             {
83 16     16 0 29 my $self = shift;
84 16         25 my @sb;
85 16         44 my $file = $self->{val};
86              
87 16 50       339 my $time = $self->{Pretend} ?
    100          
88             time () : ((@sb = stat( $file )) ? $sb[9] : undef);
89              
90 16 50       62 croak( __PACKAGE__,
91             "->setTime: couldn't get time for `$file'. does it exist?" )
92             unless defined $time;
93              
94 16         102 $self->{state}->setTime( $file, $time );
95             }
96              
97             sub update
98             {
99 16     16 0 53 my ( $self ) = @_;
100              
101 16         47 my $file = $self->{val};
102 16         38 my $attr = $self->{attr};
103              
104             # if it's an sfile or slink, create the file
105 16 100       94 if ( exists $attr->{slink} )
    100          
106             {
107 10         45 $self->mkSFile;
108 10         2979 $self->{state}->attachSLink( $file, $attr->{slink} );
109             }
110              
111             elsif ( exists $attr->{sfile} )
112             {
113 2         22 $self->mkSFile;
114             }
115              
116 16         859 $self->setTime;
117             }
118              
119             sub mkSFile
120             {
121 12     12 0 29 my ( $self ) = @_;
122              
123 12 50       54 return if $self->{Pretend};
124              
125 12         28 my $file = $self->{val};
126              
127 12         582 unlink $file;
128 12 50       246 my $fh = IO::File->new( $file, 'w' )
129             or croak( __PACKAGE__, "->mkSFile: unable to create file `$file'" );
130             }
131              
132 109     109 0 31890 sub file { $_[0]{val} }
133              
134 7     7 0 60 sub force { $_[0]{attr}{force} }
135              
136             1;