File Coverage

blib/lib/Archive/Builder/File.pm
Criterion Covered Total %
statement 68 73 93.1
branch 25 36 69.4
condition n/a
subroutine 22 22 100.0
pod 0 12 0.0
total 115 143 80.4


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__