File Coverage

lib/Slaughter/Private.pm
Criterion Covered Total %
statement 26 45 57.7
branch 5 20 25.0
condition 0 3 0.0
subroutine 5 6 83.3
pod 2 2 100.0
total 38 76 50.0


line stmt bran cond sub pod time code
1             #!/usr/bin/perl -w
2              
3             =head1 NAME
4            
5             Slaughter::Private - Perl Automation Tool Helper Internal Details
6            
7             =cut
8              
9             =head1 SYNOPSIS
10            
11             This module implements the non-public API of the Slaughter administration tool.
12            
13             Users are not expected to use, touch, browse, or modify the code in this module!
14            
15             =cut
16              
17              
18             =head1 METHODS
19            
20             Now follows documentation on the available methods.
21            
22             =cut
23              
24 9     9   26604 use strict;
  9         11  
  9         238  
25 9     9   31 use warnings;
  9         10  
  9         3272  
26              
27             package Slaughter::Private;
28              
29              
30             #
31             # The version of our release.
32             #
33             our $VERSION = "3.0.5";
34              
35              
36             =head2 fetchFromTransport
37            
38             This primitive will retrieve a file from the central server, using
39             the specified transport.
40            
41             The various transports are pluggable and live beneath the Slaughter::Transport
42             namespace.
43            
44             =for example begin
45            
46             fetchFromTransport( "/etc/motd" );
47            
48             =for example end
49            
50             A single parameter is accepted which is the name of the file
51             to fetch, relative to the transport's root.
52            
53             On success the file's contents are returned. On failure undef
54             is returned.
55            
56             =cut
57              
58             sub fetchFromTransport
59             {
60 0     0 1 0     my ($url) = (@_);
61              
62 0 0       0     $::template{ 'verbose' } && print "\tfetchFromTransport( $url ) \n";
63              
64 0         0     my $content = undef;
65              
66              
67             #
68             # Make requests for:
69             #
70             # url.$fqdn
71             # url.$hostname
72             # url.$role
73             # url.$os
74             # url.$arch
75             # url
76             #
77             # Return the first one that matches, if any do.
78             #
79 0         0     my @urls;
80              
81 0         0     push( @urls, $url . "." . $::fqdn );
82 0         0     push( @urls, $url . "." . $::hostname );
83 0 0 0     0     push( @urls, $url . "." . $::role )
84                   if ( defined($::role) && length($::role) );
85 0         0     push( @urls, $url . "." . $::os );
86 0         0     push( @urls, $url . "." . $::arch );
87 0         0     push( @urls, $url );
88              
89              
90 0         0     foreach my $attempt (@urls)
91                 {
92 0         0         $content =
93                       $::TRANSPORT->fetchContents( prefix => "/files/",
94                                                    file => $attempt );
95              
96 0 0       0         if ( defined($content) )
97                     {
98 0 0       0             $::template{ 'verbose' } && print "\t$attempt OK\n";
99 0         0             return ($content);
100                     }
101                     else
102                     {
103 0 0       0             $::template{ 'verbose' } &&
104                           print "\t$attempt failed - continuing\n";
105                     }
106                 }
107              
108             #
109             # Failed
110             #
111 0 0       0     $::template{ 'verbose' } &&
112                   print "\tFailed to fetch any of our attempts for $url\n";
113 0         0     return $content;
114             }
115              
116              
117              
118              
119             =head2 checksumFile
120            
121             This primitive will attempt to calculate and return the SHA digest of
122             the specified file.
123            
124             The method attempts to use both L<Digest::SHA> & L<Digest::SHA1>,
125             returning the result from the first one which is present.
126            
127             =for example begin
128            
129             checksumFile( "/etc/motd" );
130            
131             =for example end
132            
133             A single parameter is accepted which is the name of the file
134             to hash.
135            
136             On success the hash is returned, on failure undef is returned.
137            
138             =cut
139              
140             sub checksumFile
141             {
142 3     3 1 9992     my ($file) = (@_);
143              
144 3         3     my $hash = undef;
145              
146 3         6     foreach my $module (qw! Digest::SHA Digest::SHA1 !)
147                 {
148              
149             # If we succeeded in calculating the hash we're done.
150 6 100       55         next if ( defined($hash) );
151              
152             # Attempt to load the module
153 3         5         my $eval = "use $module;";
154              
155             ## no critic (Eval)
156 2     2   515         eval($eval);
  2     1   2524  
  2         55  
  1         5  
  1         1  
  1         19  
  3         129  
157             ## use critic
158              
159             #
160             # Loaded module, with no errors.
161             #
162 3 50       9         if ( !$@ )
163                     {
164 3         10             my $object = $module->new;
165              
166 3 50       109             open my $handle, "<", $file or
167                           die "Failed to read $file to hash contents with $module - $!";
168 3         8             $object->addfile($handle);
169 3         73             close($handle);
170              
171 3         24             $hash = $object->hexdigest();
172                     }
173                 }
174              
175 3 50       7     unless ( defined $hash )
176                 {
177 0         0         die "Failed to calculate hash of $file - internal error.";
178                 }
179              
180 3         11     return ($hash);
181             }
182              
183              
184             1;
185              
186              
187              
188             =head1 LICENSE
189            
190             Copyright (c) 2010-2015 by Steve Kemp. All rights reserved.
191            
192             This module is free software;
193             you can redistribute it and/or modify it under
194             the same terms as Perl itself.
195             The LICENSE file contains the full text of the license.
196            
197             =cut
198              
199             =head1 AUTHOR
200            
201             Steve Kemp <steve@steve.org.uk>
202            
203             =cut
204