File Coverage

blib/lib/EO/File.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package EO::File;
2              
3 1     1   37962 use strict;
  1         2  
  1         42  
4 1     1   5 use warnings;
  1         2  
  1         30  
5              
6 1     1   40328 use NEXT;
  1         2836  
  1         35  
7 1     1   621 use EO::Data;
  0            
  0            
8             use IO::File;
9             use EO::Storage;
10             use EO::delegate;
11             use Path::Class::File;
12              
13             our $VERSION = 0.96;
14             our @ISA = qw(EO::Storage);
15              
16             exception EO::Error::File;
17             exception EO::Error::File::NotFound
18             extends => 'EO::Error::File';
19             exception EO::Error::File::Permission
20             extends => 'EO::Error::File';
21             exception EO::Error::File::IsDirectory
22             extends => 'EO::Error::File';
23             exception EO::Error::File::Permission::Read
24             extends => 'EO::Error::File::Permission';
25             exception EO::Error::File::Open
26             extends => 'Eo::Error::File';
27              
28             sub init {
29             my $self = shift;
30              
31             return 0 unless ($self->NEXT::init(@_));
32              
33             my %params = @_;
34              
35             if ( my $file = $params{path} ) {
36             $self->path($file)
37             }
38              
39             return 1;
40             }
41              
42             sub path {
43             my $self = shift;
44             if(@_) {
45             my $path = shift;
46             unless(UNIVERSAL::isa($path, 'Path::Class::File')) {
47             $path = Path::Class::File->new(ref $path
48             ? @{$path}
49             : $path
50             );
51             $path = $path->absolute();
52             }
53             $self->delegate($path);
54             return $self;
55             }
56             return $self->delegate();
57             }
58              
59             sub as_string {
60             my $self = shift;
61             return $self->stringify();
62             }
63              
64             sub exists {
65             my $self = shift;
66             my $filename = $self->as_string;
67             unless(-e $filename) {
68             throw EO::Error::File::NotFound
69             text => "Cannot open file: $filename, file not found",
70             filename => $filename;
71             }
72             }
73              
74             sub isfile {
75             my $self = shift;
76             my $filename = $self->as_string;
77             if (-d $filename) {
78             throw EO::Error::File::IsDirectory
79             text => "Cannot open file: $filename, path is a directory";
80             }
81             }
82              
83             sub readable {
84             my $self = shift;
85             my $filename = $self->as_string;
86             unless(-r $filename) {
87             throw EO::Error::File::Permission::Read
88             text => "Cannot open file: $filename, file not readable";
89             }
90             }
91              
92             sub handle {
93             my $self = shift;
94             my $mode = shift;
95             if (!$mode) {
96             throw EO::Error::InvalidParameters
97             text => "no mode supplied";
98             }
99             my $fh = IO::File->new( $self->as_string, $mode );
100             if (!$fh) {
101             my $err = 'Cannot open file: ';
102             $err .= $self->as_string;
103             $err .= " with mode $mode ($!)";
104             throw EO::Error::File::Open text => $err;
105             }
106             return $fh;
107             }
108              
109             sub load {
110             my $self = shift;
111              
112             $self->exists;
113             $self->isfile;
114             $self->readable;
115              
116             my $fh = $self->handle("<");
117              
118             local($/);
119             my $raw_content = $fh->getline;
120              
121             $self->data(
122             EO::Data->new()
123             ->storage( $self )
124             ->content( \$raw_content )
125             );
126              
127             $fh->close();
128              
129             return $self->data;
130             }
131              
132             sub data {
133             my $self = shift;
134             if (@_) {
135             $self->{ e_file_data } = shift;
136             return $self;
137             }
138             return $self->{ e_file_data };
139             }
140              
141             sub file_error {
142             my $self = shift;
143             throw EO::Error::File
144             text => "Could not perform operation on file ", $self->as_string, " ($!)";
145             }
146              
147             sub unlink {
148             my $self = shift;
149             unlink($self->as_string) || $self->file_error;
150             return $self;
151             }
152              
153              
154             sub save {
155             my $self = shift;
156             my $data = shift;
157              
158             my $filename = $self->as_string();
159             my $parent = $self->dir();
160              
161             my $fh = $self->handle( "+>" );
162             my $content = $data->content_ref;
163              
164             $fh->print( $$content ) || $self->file_error;
165             $fh->close();
166             }
167              
168             sub DESTROY {
169             my $self = shift;
170              
171             if ($self->data) {
172             $self->data->delete_storage( $self );
173             }
174              
175             $self->NEXT::DESTROY;
176             }
177              
178             sub make_absolute {
179             my $self = shift;
180             $self->delegate($self->absolute);
181             }
182              
183             sub make_relative {
184             my $self = shift;
185             $self->delegate($self->absolute);
186             }
187              
188             1;