line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Csistck::Test::Template; |
2
|
|
|
|
|
|
|
|
3
|
17
|
|
|
17
|
|
282
|
use 5.010; |
|
17
|
|
|
|
|
57
|
|
|
17
|
|
|
|
|
1011
|
|
4
|
17
|
|
|
17
|
|
94
|
use strict; |
|
17
|
|
|
|
|
31
|
|
|
17
|
|
|
|
|
481
|
|
5
|
17
|
|
|
17
|
|
79
|
use warnings; |
|
17
|
|
|
|
|
71
|
|
|
17
|
|
|
|
|
502
|
|
6
|
|
|
|
|
|
|
|
7
|
17
|
|
|
17
|
|
103
|
use base 'Csistck::Test::FileBase'; |
|
17
|
|
|
|
|
34
|
|
|
17
|
|
|
|
|
1832
|
|
8
|
17
|
|
|
17
|
|
98
|
use Csistck::Oper qw/debug/; |
|
17
|
|
|
|
|
33
|
|
|
17
|
|
|
|
|
908
|
|
9
|
17
|
|
|
17
|
|
89
|
use Csistck::Util qw/hash_file hash_string/; |
|
17
|
|
|
|
|
31
|
|
|
17
|
|
|
|
|
1290
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
our @EXPORT_OK = qw/template/; |
12
|
|
|
|
|
|
|
|
13
|
17
|
|
|
17
|
|
101
|
use Template; |
|
17
|
|
|
|
|
34
|
|
|
17
|
|
|
|
|
507
|
|
14
|
17
|
|
|
17
|
|
113
|
use File::Copy; |
|
17
|
|
|
|
|
29
|
|
|
17
|
|
|
|
|
991
|
|
15
|
17
|
|
|
17
|
|
107
|
use Sys::Hostname::Long qw//; |
|
17
|
|
|
|
|
31
|
|
|
17
|
|
|
|
|
401
|
|
16
|
17
|
|
|
17
|
|
104
|
use FindBin; |
|
17
|
|
|
|
|
44
|
|
|
17
|
|
|
|
|
548
|
|
17
|
17
|
|
|
17
|
|
135
|
use Text::Diff (); |
|
17
|
|
|
|
|
35
|
|
|
17
|
|
|
|
|
9823
|
|
18
|
|
|
|
|
|
|
|
19
|
2
|
|
|
2
|
1
|
2242
|
sub template { Csistck::Test::Template->new(@_); }; |
20
|
|
|
|
|
|
|
|
21
|
8
|
|
|
8
|
0
|
26
|
sub desc { sprintf("Template check for destination %s", shift->dest); } |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
sub file_check { |
24
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
25
|
0
|
|
|
|
|
|
my $tplout; |
26
|
|
|
|
|
|
|
|
27
|
0
|
0
|
|
|
|
|
$self->template_file(\$tplout) |
28
|
0
|
|
|
|
|
|
or die("Template file not processed: template=<${\$self->src}>"); |
29
|
|
|
|
|
|
|
|
30
|
0
|
|
|
|
|
|
my $hashsrc = hash_string($tplout); |
31
|
0
|
|
|
|
|
|
my $hashdst = hash_file($self->dest); |
32
|
|
|
|
|
|
|
|
33
|
0
|
|
0
|
|
|
|
return (defined $hashsrc and defined $hashdst and ($hashsrc eq $hashdst)); |
34
|
|
|
|
|
|
|
} |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
sub file_repair { |
37
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
38
|
0
|
|
|
|
|
|
debug(sprintf("Output template: template=<%s> dest=<%s>", |
39
|
|
|
|
|
|
|
$self->src, $self->dest)); |
40
|
|
|
|
|
|
|
# TODO tmp file for template |
41
|
0
|
0
|
|
|
|
|
open(my $h, '>', $self->dest) |
42
|
|
|
|
|
|
|
or die("Permission denied writing template"); |
43
|
0
|
|
|
|
|
|
$self->template_file($h); |
44
|
0
|
|
|
|
|
|
close($h); |
45
|
0
|
|
|
|
|
|
return 1; |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
sub file_diff { |
49
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
50
|
0
|
|
|
|
|
|
my $temp_h; |
51
|
|
|
|
|
|
|
# TODO prune args in common function |
52
|
0
|
|
|
|
|
|
$self->template_file(\$temp_h); |
53
|
0
|
|
|
|
|
|
say(Text::Diff::diff($self->dest, \$temp_h)); |
54
|
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
# Processing absoulte template name and outputs to reference |
57
|
|
|
|
|
|
|
# variable $out. Die on error or unreadable template file |
58
|
|
|
|
|
|
|
sub template_file { |
59
|
0
|
|
|
0
|
0
|
|
my ($self, $out) = @_; |
60
|
|
|
|
|
|
|
|
61
|
0
|
0
|
|
|
|
|
die("Invalid template name") |
62
|
|
|
|
|
|
|
unless($self->src =~ /^[A-Za-z0-9\-\_][A-Za-z0-9\/\-\_\.]+$/); |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
# Build object, finish checks |
65
|
0
|
|
|
|
|
|
my $t = Template->new(); |
66
|
0
|
|
|
|
|
|
my $file = get_absolute_template($self->src); |
67
|
0
|
|
|
|
|
|
$self->{hostname} = Sys::Hostname::Long::hostname_long(); |
68
|
0
|
0
|
|
|
|
|
die("Template not found") |
69
|
|
|
|
|
|
|
if(! -e $file); |
70
|
0
|
0
|
|
|
|
|
die("Permission denied reading template") |
71
|
|
|
|
|
|
|
if(! -r $file); |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
# Create Template object, no config for now |
74
|
0
|
|
|
|
|
|
open(my $h, $file); |
75
|
0
|
0
|
|
|
|
|
$t->process($h, $self, $out) or die $t->error(); |
76
|
0
|
|
|
|
|
|
close($h); |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
# Get absoulte path from relative path |
80
|
|
|
|
|
|
|
# TODO error checking |
81
|
|
|
|
|
|
|
sub get_absolute_template { |
82
|
0
|
|
|
0
|
0
|
|
my $template = shift; |
83
|
0
|
|
|
|
|
|
return join "/", $FindBin::Bin, $template; |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
1; |
87
|
|
|
|
|
|
|
__END__ |