line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Archive::Builder::File; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
# This package represents a single file in the Archive::Builder structure |
4
|
|
|
|
|
|
|
|
5
|
7
|
|
|
7
|
|
173
|
use strict; |
|
7
|
|
|
|
|
15
|
|
|
7
|
|
|
|
|
365
|
|
6
|
7
|
|
|
7
|
|
39
|
use Scalar::Util (); |
|
7
|
|
|
|
|
16
|
|
|
7
|
|
|
|
|
134
|
|
7
|
7
|
|
|
7
|
|
36
|
use Params::Util ('_SCALAR0'); |
|
7
|
|
|
|
|
12
|
|
|
7
|
|
|
|
|
356
|
|
8
|
7
|
|
|
7
|
|
38
|
use Archive::Builder (); |
|
7
|
|
|
|
|
13
|
|
|
7
|
|
|
|
|
179
|
|
9
|
|
|
|
|
|
|
|
10
|
7
|
|
|
7
|
|
34
|
use vars qw{$VERSION %_PARENT}; |
|
7
|
|
|
|
|
14
|
|
|
7
|
|
|
|
|
410
|
|
11
|
|
|
|
|
|
|
BEGIN { |
12
|
7
|
|
|
7
|
|
36
|
$VERSION = '1.16'; |
13
|
7
|
|
|
|
|
5873
|
%_PARENT = (); |
14
|
|
|
|
|
|
|
} |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
##################################################################### |
21
|
|
|
|
|
|
|
# Main Interface Methods |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
sub new { |
24
|
49
|
|
|
49
|
0
|
4879
|
my $class = shift; |
25
|
49
|
|
|
|
|
152
|
$class->_clear; |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
# Get and check the path |
28
|
49
|
100
|
|
|
|
212
|
my $path = Archive::Builder->_check( 'relative path', $_[0] ) ? shift |
29
|
|
|
|
|
|
|
: return $class->_error( 'Invalid path format for File creation' ); |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
# Get and check the Archive::Builder function |
32
|
37
|
100
|
|
|
|
248
|
my $generator = Archive::Builder->_check( 'generator', $_[0] ) ? shift |
33
|
|
|
|
|
|
|
: return $class->_error( 'Invalid generator function: ' |
34
|
|
|
|
|
|
|
. Archive::Builder->errstr ); |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
# Create the File object |
37
|
27
|
100
|
|
|
|
342
|
bless { |
38
|
|
|
|
|
|
|
path => $path, |
39
|
|
|
|
|
|
|
generator => $generator, |
40
|
|
|
|
|
|
|
arguments => @_ ? [ @_ ] : 0, |
41
|
|
|
|
|
|
|
}, $class; |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
# Accessor methods |
45
|
141
|
|
|
141
|
0
|
1764
|
sub path { $_[0]->{path} } |
46
|
1
|
|
|
1
|
0
|
7
|
sub generator { $_[0]->{generator} } |
47
|
1
|
50
|
|
1
|
0
|
14
|
sub arguments { $_[0]->{arguments} ? [@{ $_[0]->{arguments} }] : 0 } |
|
0
|
|
|
|
|
0
|
|
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
# Save the file to disk ( optionally below a directory ) |
50
|
|
|
|
|
|
|
sub save { |
51
|
13
|
|
|
13
|
0
|
20
|
my $self = shift; |
52
|
13
|
50
|
|
|
|
36
|
my $filename = shift or return undef; |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
# Can we write to the location |
55
|
13
|
50
|
|
|
|
63
|
unless ( File::Flat->canWrite( $filename ) ) { |
56
|
0
|
|
|
|
|
0
|
return $self->_error( "Insufficient permissions to write to '$filename'" ); |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
# Get the file contents ( as a scalar ref ) |
60
|
13
|
50
|
|
|
|
4881
|
my $contents = $self->contents or return undef; |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
# Write the file |
63
|
13
|
50
|
|
|
|
52
|
File::Flat->write( $filename, $contents ) |
64
|
|
|
|
|
|
|
or return $self->_error( "Error writing to '$filename': $!" ); |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
# If it is executable, set the mode |
67
|
13
|
50
|
|
|
|
8729
|
if ( $self->{executable} ) { |
68
|
0
|
|
|
|
|
0
|
chmod 0755, $filename; |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
|
71
|
13
|
|
|
|
|
71
|
1; |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
# Is the file binary. Worked out by examining the content for the null byte, |
75
|
|
|
|
|
|
|
# which should never be in a text file, but almost always is in binary files. |
76
|
|
|
|
|
|
|
sub binary { |
77
|
4
|
|
|
4
|
0
|
7
|
my $self = shift; |
78
|
4
|
50
|
|
|
|
9
|
my $contents = $self->contents or return undef; |
79
|
4
|
|
|
|
|
31
|
index($$contents, "\000") != -1; |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
# Flag a File as being executable |
83
|
1
|
|
|
1
|
0
|
7
|
sub executable { $_[0]->{executable} = 1 } |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
# Get our parent Section |
86
|
6
|
|
|
6
|
0
|
55
|
sub Section { $_PARENT{ Scalar::Util::refaddr($_[0]) } } |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
# Delete this from from its parent |
89
|
|
|
|
|
|
|
sub delete { |
90
|
1
|
|
|
1
|
0
|
8
|
my $self = shift; |
91
|
1
|
50
|
|
|
|
4
|
my $Section = $self->Section or return 1; |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
# Remove from our parent |
94
|
1
|
|
|
|
|
4
|
$Section->remove_file( $self->path ); |
95
|
|
|
|
|
|
|
|
96
|
1
|
|
|
|
|
5
|
1; |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
# If the content has been generated, remove it so it will |
100
|
|
|
|
|
|
|
# be generated again. ( Possibly with a different result ) |
101
|
4
|
|
|
4
|
0
|
13
|
sub reset { delete $_[0]->{contents}; 1 } |
|
4
|
|
|
|
|
15
|
|
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
###################################################################### |
108
|
|
|
|
|
|
|
# File generation |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
# Get the generated content. |
111
|
|
|
|
|
|
|
# Implement caching. |
112
|
|
|
|
|
|
|
sub contents { |
113
|
56
|
|
|
56
|
0
|
1556
|
my $self = shift; |
114
|
56
|
100
|
|
|
|
169
|
unless ( exists $self->{contents} ) { |
115
|
22
|
|
|
|
|
56
|
my $contents = $self->_contents; |
116
|
22
|
50
|
|
|
|
64
|
unless ( defined $contents ) { |
117
|
0
|
|
|
|
|
0
|
return $self->_error( 'Error while generating contents: ' . $self->errstr ); |
118
|
|
|
|
|
|
|
} |
119
|
22
|
|
|
|
|
48
|
$self->{contents} = $contents; |
120
|
|
|
|
|
|
|
} |
121
|
56
|
|
|
|
|
259
|
$self->{contents}; |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
# Actually generate the contents |
125
|
|
|
|
|
|
|
sub _contents { |
126
|
22
|
|
|
22
|
|
33
|
my $self = shift; |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
# Load the module for the function if needed |
129
|
22
|
100
|
|
|
|
108
|
my $generator = $self->{generator} =~ /::/ |
130
|
|
|
|
|
|
|
? $self->{generator} |
131
|
|
|
|
|
|
|
: "Archive::Builder::Generators::$self->{generator}"; |
132
|
22
|
|
|
|
|
134
|
my ($module) = $generator =~ m/^(.*)::.*$/; |
133
|
22
|
50
|
|
|
|
142
|
unless ( Class::Autouse->load( $module ) ) { |
134
|
0
|
|
|
|
|
0
|
return $self->_error( "Failed to load module '$module'" ); |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
# Call the function |
138
|
7
|
|
|
7
|
|
50
|
no strict 'refs'; |
|
7
|
|
|
|
|
17
|
|
|
7
|
|
|
|
|
2195
|
|
139
|
16
|
|
|
|
|
85
|
my $result = $self->{arguments} |
140
|
16
|
|
|
|
|
33
|
? &{ $generator }( $self, @{ $self->{arguments} } ) |
|
6
|
|
|
|
|
35
|
|
141
|
22
|
100
|
|
|
|
772
|
: &{ $generator }( $self ); |
142
|
22
|
50
|
|
|
|
366
|
_SCALAR0($result) or return undef; |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
# Clean up newlines in text files |
145
|
22
|
100
|
|
|
|
97
|
if ( index($$result, "\000") == -1 ) { # If not a binary file |
146
|
21
|
|
|
|
|
123
|
$$result =~ s/(?:\015\012|\015|\012)/\n/g; |
147
|
|
|
|
|
|
|
} |
148
|
|
|
|
|
|
|
|
149
|
22
|
|
|
|
|
47
|
$result; |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
##################################################################### |
157
|
|
|
|
|
|
|
# Utility Methods |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
# Pass through error |
160
|
29
|
|
|
29
|
0
|
17734
|
sub errstr { Archive::Builder->errstr } |
161
|
24
|
|
|
24
|
|
1031
|
sub _error { shift; Archive::Builder->_error(@_) } |
|
24
|
|
|
|
|
99
|
|
162
|
51
|
|
|
51
|
|
2050
|
sub _clear { Archive::Builder->_clear } |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
1; |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
__END__ |