File Coverage

lib/File/Access/Driver.pm
Criterion Covered Total %
statement 257 473 54.3
branch 96 298 32.2
condition 5 14 35.7
subroutine 33 46 71.7
pod 3 36 8.3
total 394 867 45.4


line stmt bran cond sub pod time code
1             #
2             # @author Bodo (Hugo) Barwich
3             # @version 2026-01-30
4             # @package File Access Driver
5             # @subpackage lib/File/Access/Driver.pm
6              
7             # This module defines the a class to interact with files
8             #
9             #---------------------------------
10             # Requirements:
11             #
12             #---------------------------------
13             # Extensions:
14             #
15             #---------------------------------
16             # Configurations:
17             #
18             #---------------------------------
19             # Features:
20              
21             #==============================================================================
22             # The File::Access::Driver Package
23              
24             =head1 NAME
25              
26             File::Access::Driver - Convenient File Access with "Batteries included"
27              
28             =cut
29              
30             package File::Access::Driver;
31              
32             our $VERSION = '1.0.0';
33              
34             #----------------------------------------------------------------------------
35             #Dependencies
36              
37 1     1   157279 use Fcntl ':flock'; # import LOCK_* constants
  1         1  
  1         184  
38 1     1   5 use File::Path qw(make_path);
  1         2  
  1         4906  
39              
40             =head1 DESCRIPTION
41              
42             C is a class for convenient file access designed to reduce
43             the code needed to interact with files.
44              
45             It has grown to a "I" solution covering the most file access
46             use cases.
47              
48             It will not produce exceptions but instead report the errors over the C
49             and the C methods.
50              
51             =head1 SYNOPSIS
52              
53             The C can be used as seen in the "I" test:
54              
55             use File::Access::Driver;
56              
57             my $driver = File::Access::Driver->new( 'filepath' => $spath . 'files/out/testfile_out.txt' );
58              
59             # Make sure the file does not exist
60             is( $driver->Delete(), 1, "File Delete: Delete operation 1 correct" );
61             is( $driver->Exists(), 0, "File Exist: File does not exist anymore" );
62              
63             $driver->writeContent(q(This is the multi line content for the test file.
64              
65             It will be written into the test file.
66             The file should only contain this text.
67             Also the file should be created.
68             ));
69              
70             printf(
71             "Test File Exists - File '%s': Write finished with [%d]\n",
72             $driver->getFileName(),
73             $driver->getErrorCode()
74             );
75             printf(
76             "Test File Exists - File '%s': Write Report:\n'%s'\n",
77             $driver->getFileName(),
78             ${ $driver->getReportString() }
79             );
80             printf(
81             "Test File Exists - File '%s': Write Error:\n'%s'\n",
82             $driver->getFileName(),
83             ${ $driver->getErrorString() }
84             );
85              
86             is( $driver->getErrorCode(), 0, "Write Error Code: No errors have occurred" );
87             is( ${ $driver->getErrorString() }, '', "Write Error Message: No errors are reported" );
88              
89             is( $driver->Exists(), 1, "File Exist: File does exist now" );
90             isnt( $driver->getFileSize(), 0, "File Size: File is not empty anymore" );
91              
92             =cut
93              
94             #----------------------------------------------------------------------------
95             #Constructors
96              
97             =head1 METHODS
98              
99             =head2 Constructor
100              
101             =over 4
102              
103             =item new ( [ CONFIGURATIONS ] )
104              
105             This is the constructor for a new C object.
106              
107             B
108              
109             =over 4
110              
111             =item C
112              
113             Key and value pairs containing the configurations.
114              
115             B
116              
117             C - The directory where the file is located.
118              
119             C - The base name of the file.
120              
121             C - The complete path with directory and file base name.
122              
123             =back
124              
125             See L|/"setFileDirectory ( DIRECTORY )">
126              
127             See L|/"setFileName ( NAME )">
128              
129             =cut
130              
131             sub new {
132              
133             #Take the Method Parameters
134 6     6 1 233766 my ( $invocant, %hshprms ) = @_;
135 6   33     65 my $class = ref($invocant) || $invocant;
136 6         11 my $self = undef;
137              
138             # Set the Default Attributes and assign the initial Values
139 6         124 $self = {
140             '_file' => undef,
141             '_directory_name' => '',
142             '_file_name' => '',
143              
144             # A Reference to the Content Text
145             '_file_content' => undef,
146             '_file_content_lines' => undef,
147             '_file_time' => -1,
148             '_file_access_time' => -1,
149             '_file_size' => -1,
150             '_package_size' => 32768,
151             '_buffered' => 0,
152             '_persistent' => 0,
153             '_locked' => 0,
154             '_writable' => 0,
155             '_appendable' => 0,
156             '_report' => '',
157             '_error_message' => '',
158             '_error_code' => 0
159             };
160              
161 6         16 bless $self, $class;
162              
163 6 100       31 if ( scalar( keys %hshprms ) > 0 ) {
164 5 100       27 $self->setFileDirectory( $hshprms{'filedirectory'} ) if ( defined $hshprms{'filedirectory'} );
165 5 100       17 $self->setFileName( $hshprms{'filename'} ) if ( defined $hshprms{'filename'} );
166 5 100       29 $self->setFilePath( $hshprms{'filepath'} ) if ( defined $hshprms{'filepath'} );
167             } #if(scalar(keys %hshprms) > 0)
168              
169             #Give the Object back
170 6         28 return $self;
171             }
172              
173             sub DESTROY {
174 6     6   11032 my $self = $_[0];
175              
176             # Free the System Resources
177 6         20 $self->freeResources;
178             }
179              
180             #----------------------------------------------------------------------------
181             #Administration Methods
182              
183             =head3 setFileDirectory ( DIRECTORY )
184              
185             This method sets the directory where the file is located.
186              
187             B
188              
189             =over 4
190              
191             =item C
192              
193             The directory where the file is located.
194              
195             If the directory does not end on a slash C< / > it will be appended.
196              
197             =back
198              
199             =cut
200              
201             sub setFileDirectory {
202 5     5 1 15 my $self = $_[0];
203              
204 5 50       20 if ( scalar(@_) > 1 ) {
205 5         18 $self->{'_directory_name'} = $_[1];
206             }
207             else #No Parameter given
208             {
209 0         0 $self->{'_directory_name'} = '';
210             }
211              
212 5 50       20 $self->{'_directory_name'} = '' unless ( defined $self->{'_directory_name'} );
213              
214 5 50       17 if ( $self->{'_directory_name'} ne '' ) {
215 5 100       58 $self->{'_directory_name'} .= '/' unless ( $self->{'_directory_name'} =~ qr#/$# );
216             }
217              
218             #Clear the File Object
219 5         29 $self->Clear;
220             }
221              
222             =head3 setFileName ( NAME )
223              
224             This method sets the base name of the file.
225              
226             B
227              
228             =over 4
229              
230             =item C
231              
232             The base name of the file.
233              
234             This will also close open file handles and free in-memory cache.
235              
236             =back
237              
238             =cut
239              
240             sub setFileName {
241 5     5 1 11 my $self = $_[0];
242              
243 5 50       13 if ( scalar(@_) > 1 ) {
244 5         11 $self->{'_file_name'} = $_[1];
245             }
246             else #No Parameter given
247             {
248 0         0 $self->{'_file_name'} = '';
249             }
250              
251 5 50       25 $self->{'_file_name'} = '' unless ( defined $self->{'_file_name'} );
252              
253             #Clear the File Object
254 5         11 $self->Clear;
255             }
256              
257             sub setFilePath {
258 4     4 0 5 my $self = $_[0];
259 4   50     14 my $sdirnm = $_[1] || '';
260 4         10 my $sflnm = '';
261              
262 4 50       11 if ( $sdirnm ne '' ) {
263 4 50       16 if ( index( $sdirnm, '/' ) > -1 ) {
264 4 50       63 if ( $sdirnm =~ qr#(.*/)([^/]+)$# ) {
265 4         1925 $sdirnm = $1;
266 4         20 $sflnm = $2;
267             }
268             }
269             else #The Path does not include a Slash Sign
270             {
271 0         0 $sflnm = $sdirnm;
272 0         0 $sdirnm = '';
273             }
274             }
275              
276             #Set the Parsed Values
277 4         42 $self->setFileDirectory($sdirnm);
278 4         14 $self->setFileName($sflnm);
279             }
280              
281             sub changeFileName {
282 0     0 0 0 my $self = $_[0];
283 0         0 my $sdirnm = '';
284 0   0     0 my $sflnm = $_[1] || '';
285 0         0 my $irs = 0;
286              
287 0 0       0 if ( $sflnm ne '' ) {
288              
289             #If File Name contains Directory Information
290 0 0       0 if ( index( $sflnm, '/' ) > -1 ) {
291 0 0       0 if ( $sflnm =~ qr#(.*/)([^/]+)$# ) {
292 0         0 $sdirnm = $1;
293 0         0 $sflnm = $2;
294             }
295             }
296              
297             #Assume the same Directory
298 0 0       0 $sdirnm = $self->{'_directory_name'}
299             if ( $sdirnm eq '' );
300              
301 0 0       0 if ( $self->Exists ) {
302 0         0 $irs = rename $self->{'_directory_name'} . $self->{'_file_name'}, $sdirnm . $sflnm;
303              
304 0 0       0 if ($irs) {
305              
306             #Update the File Access Object accordingly but keep the Report History
307              
308 0         0 $self->{'_directory_name'} = $sdirnm;
309 0         0 $self->{'_file_name'} = $sflnm;
310             }
311             else #Change File Name failed
312             {
313 0         0 $irs = 0 + $!;
314              
315             $self->{'_error_message'} .=
316             "File '"
317             . $self->{'_directory_name'}
318 0         0 . $self->{'_file_name'}
319             . "': Change File Name failed with [$irs]!"
320             . "Message: '$!'\n";
321 0 0       0 $self->{'_error_code'} = 1 if ( $self->{'_error_code'} < 1 );
322              
323 0         0 $irs = 0;
324             }
325             }
326             else #File does not exist
327             {
328 0         0 $self->{'_error_message'} .= "File does not exist!\n";
329 0 0       0 $self->{'_error_code'} = 3 if ( $self->{'_error_code'} < 1 );
330             }
331             }
332             else #New File Name was not given
333             {
334 0         0 $self->{'_error_message'} .= "New File Name is not set!\n";
335 0 0       0 $self->{'_error_code'} = 3 if ( $self->{'_error_code'} < 1 );
336             }
337              
338 0         0 return $irs;
339             }
340              
341             sub setContent {
342 3     3 0 5 my $self = $_[0];
343              
344 3         8 $self->{'_file_content'} = undef;
345 3         10 $self->{'_file_content_lines'} = undef;
346 3   100     35 $self->{'_buffered'} ||= 1;
347              
348 3 50       13 if ( scalar(@_) > 1 ) {
349 3 50       12 if ( ref( $_[1] ) eq '' ) {
350 3         8 $self->{'_file_content'} = \$_[1];
351             }
352             else {
353 0         0 $self->{'_file_content'} = $_[1];
354             }
355             }
356              
357 0         0 ${ $self->{'_file_content'} } = ''
358 3 50       35 unless ( defined $self->{'_file_content'} );
359              
360             }
361              
362             sub setContentArray {
363 1     1 0 2 my $self = $_[0];
364              
365 1         3 $self->{'_file_content'} = \'';
366 1         3 $self->{'_file_content_lines'} = undef;
367 1   50     4 $self->{'_buffered'} ||= 1;
368              
369 1 50       5 if ( scalar(@_) > 1 ) {
370 1 50       7 if ( ref( $_[1] ) eq '' ) {
371 0         0 $self->{'_file_content_lines'} = \$_[1];
372             }
373             else {
374 1         4 $self->{'_file_content_lines'} = $_[1];
375             }
376             }
377             }
378              
379             sub setFileTime {
380 0     0 0 0 my $self = $_[0];
381 0   0     0 my $itmfl = $_[1] || time;
382 0         0 my $irs = 0;
383              
384 0 0       0 if ( $self->Exists ) {
385 0         0 $self->getFileTime;
386              
387 0         0 $irs = utime $self->{'_file_access_time'}, $itmfl, $self->{'_directory_name'} . $self->{'_file_name'};
388              
389 0 0       0 if ( $irs < 1 ) {
390 0         0 $irs = 0 + $!;
391              
392             $self->{'_error_message'} .=
393             "File '"
394             . $self->{'_directory_name'}
395 0         0 . $self->{'_file_name'}
396             . "': Set File Time failed with [$irs]!"
397             . "Message: '$!'\n";
398 0 0       0 $self->{'_error_code'} = 1 if ( $self->{'_error_code'} < 1 );
399              
400 0         0 $irs = 0;
401             }
402             }
403             else #File does not exist
404             {
405 0         0 $self->{'_error_message'} .= "File does not exist!\n";
406 0 0       0 $self->{'_error_code'} = 3 if ( $self->{'_error_code'} < 1 );
407             }
408              
409 0         0 return $irs;
410             }
411              
412             sub setBuffered {
413 0     0 0 0 my $self = $_[0];
414              
415 0 0       0 if ( scalar(@_) > 1 ) {
416 0 0       0 if ( $_[1] =~ qr/^\d+$/ ) {
417              
418             # The parameter is an unsigned whole number
419              
420 0 0       0 if ( $_[1] != 0 ) {
421 0         0 $self->{'_buffered'} = 1;
422             }
423             else {
424 0         0 $self->{'_buffered'} = 0;
425             }
426             }
427             else #The Parameter is not a Number
428             {
429 0         0 $self->{'_buffered'} = 0;
430             }
431             }
432             else #No Parameter was given
433             {
434 0         0 $self->{'_buffered'} = 1;
435             }
436             }
437              
438             sub setPersistent {
439 0     0 0 0 my $self = $_[0];
440              
441 0 0       0 if ( scalar(@_) > 1 ) {
442 0 0       0 if ( $_[1] =~ qr/^\d+$/ ) {
443              
444             # The parameter is an unsigned whole number
445              
446 0 0       0 if ( $_[1] != 0 ) {
447 0         0 $self->{'_persistent'} = 1;
448             }
449             else {
450 0         0 $self->{'_persistent'} = 0;
451             }
452             }
453             else #The Parameter is not a Number
454             {
455 0         0 $self->{'_persistent'} = 0;
456             }
457             }
458             else #No Parameter was given
459             {
460 0         0 $self->{'_persistent'} = 1;
461             }
462             }
463              
464             sub Create {
465 1     1 0 3 my $self = $_[0];
466              
467 1         5 return $self->writeContent('');
468             }
469              
470             sub _openrFile {
471 1     1   3 my $self = $_[0];
472 1         3 my $irs = 0;
473              
474 1 50       8 if ( $self->_isOpen() ) {
475              
476             #Reopen the File in shared Reading Mode
477 0 0       0 $self->_closeFile() if ( $self->_isWritable() );
478             } #if($self->_isOpen())
479              
480 1 50       4 unless ( $self->_isOpen() ) {
481 1 50       3 if ( $self->Exists() ) {
482              
483             #Open the File
484 1         61 $irs = open $self->{'_file'}, '<', $self->{'_directory_name'} . $self->{'_file_name'};
485              
486 1 50       31 if ( defined $irs ) {
487 1         16 $irs = flock( $self->{'_file'}, LOCK_SH );
488              
489 1 50       6 if ($irs) {
490 1         3 $self->{'_locked'} = 1;
491              
492 1         3 $irs = 1;
493             } #if($irs)
494             }
495             else #The File could not be opened
496             {
497             $self->{'_error_message'} .=
498             "File '"
499             . $self->{'_directory_name'}
500 0         0 . $self->{'_file_name'} . "': "
501             . "Open Read failed!\n"
502             . "Message: '$!'\n";
503 0 0       0 $self->{'_error_code'} = 1 if ( $self->{'_error_code'} < 1 );
504              
505 0         0 $irs = 0;
506             } #unless(defined $irs)
507             }
508             else #The File does not exist
509             {
510             $self->{'_error_message'} .=
511             "File '"
512             . $self->{'_directory_name'}
513 0         0 . $self->{'_file_name'} . "': "
514             . "Open Read failed!\n"
515             . "Message: 'File does not exist.'\n";
516 0 0       0 $self->{'_error_code'} = 3 if ( $self->{'_error_code'} < 1 );
517             }
518             }
519             else #The File is open and in Reading Mode
520             {
521 0         0 $irs = 1;
522             }
523              
524 1         3 return $irs;
525             }
526              
527             sub _openwFile {
528 4     4   7 my $self = $_[0];
529 4         8 my $irs = 0;
530              
531 4 50       10 unless ( $self->_isWritable() ) {
532 4 50       13 $self->_closeFile() if ( $self->_isOpen() );
533              
534 4 50       14 if ( $self->{'_directory_name'} ne '' ) {
535 4 100       101 unless ( -d $self->{'_directory_name'} ) {
536 1         3 my $idircnt = -1;
537              
538             $self->{"_report"} .=
539             "Directory '"
540 1         5 . $self->{'_directory_name'} . "': "
541             . "Directory does not exist. Directory creating ...\n";
542              
543             #Clear any previous Error Messages
544 1         3 $@ = '';
545              
546 1         3 eval {
547             #Create the Directory
548 1         434 $idircnt = make_path( $self->{'_directory_name'}, { mode => 0775 } );
549             };
550              
551 1 50       7 if ($@) {
552             $self->{'_error_message'} .=
553             "Directory '"
554 0         0 . $self->{'_directory_name'} . "': "
555             . "Create Directory failed.\n"
556             . "Message (Code '"
557             . ( $! + 0 )
558             . "'): '$@'\n";
559              
560 0 0       0 $self->{'_error_code'} = 1 if ( $self->{'_error_code'} < 1 );
561              
562 0         0 $idircnt = -1;
563             }
564              
565 1 50       5 $irs = 1 if ( $idircnt != -1 );
566             }
567             else # Directory does exist
568             {
569 3         23 $irs = 1;
570             }
571             }
572             else #The File Directory is not set
573             {
574 0         0 $irs = 1;
575             }
576              
577 4 50       13 if ($irs) {
578 4 50       15 if ( $self->{'_file_name'} ne '' ) {
579              
580             #Open the File
581 4         774 $irs = open $self->{'_file'}, ">", $self->{'_directory_name'} . $self->{'_file_name'};
582              
583 4 50       19 if ( defined $irs ) {
584 4         13 $self->{'_writable'} = 1;
585              
586 4         63 $irs = flock( $self->{'_file'}, LOCK_EX );
587              
588 4 50       18 if ($irs) {
589 4         9 $self->{'_locked'} = 1;
590              
591 4         27 $irs = 1;
592             }
593             }
594             else #The File could not be opened
595             {
596             $self->{'_error_message'} .=
597             "File '"
598             . $self->{'_directory_name'}
599 0         0 . $self->{'_file_name'}
600             . "': Open Write failed!\n"
601             . "Message: '$!'\n";
602 0 0       0 $self->{'_error_code'} = 1 if ( $self->{'_error_code'} < 1 );
603              
604 0         0 $irs = 0;
605             }
606             }
607             else #The File Name isnt set
608             {
609 0         0 $self->{'_error_message'} .= "File Name isn't set!\n";
610 0 0       0 $self->{'_error_code'} = 3 if ( $self->{'_error_code'} < 1 );
611              
612 0         0 $irs = 0;
613             }
614             }
615             }
616             else #The File is already open in Appending Mode
617             {
618 0         0 $irs = 1;
619             } #unless($self->_isWritable())
620              
621 4         11 return $irs;
622             }
623              
624             sub _openaFile {
625 0     0   0 my $self = $_[0];
626 0         0 my $irs = 0;
627              
628 0 0       0 unless ( $self->_isAppendable() ) {
629 0 0       0 $self->_closeFile() if ( $self->_isOpen() );
630              
631 0 0       0 if ( $self->{'_directory_name'} ne '' ) {
632 0 0       0 unless ( -d $self->{'_directory_name'} ) {
633 0         0 my $idircnt = -1;
634              
635             #Clear any previous Error Messages
636 0         0 $@ = '';
637              
638 0         0 eval {
639             #Create the Directory
640 0         0 $idircnt = make_path( $self->{'_directory_name'}, { mode => 0775 } );
641             };
642              
643 0 0       0 if ($@) {
644             $self->{'_error_message'} .=
645             "Directory '"
646 0         0 . $self->{'_directory_name'} . "': "
647             . "Create Directory failed.\n"
648             . "Message (Code '"
649             . ( 0 + $! )
650             . "'): '$@'\n";
651              
652 0 0       0 $self->{'_error_code'} = 1 if ( $self->{'_error_code'} < 1 );
653              
654 0         0 $idircnt = -1;
655             }
656              
657 0 0       0 $irs = 1 if ( $idircnt != -1 );
658             }
659             else # Directory does exist
660             {
661 0         0 $irs = 1;
662             }
663             }
664             else #The File Directory is not set
665             {
666 0         0 $irs = 1;
667             }
668              
669 0 0       0 if ($irs) {
670 0 0       0 if ( $self->{'_file_name'} ne '' ) {
671              
672             #Open the File
673 0         0 $irs = open $self->{'_file'}, ">>", $self->{'_directory_name'} . $self->{'_file_name'};
674              
675 0 0       0 if ( defined $irs ) {
676 0         0 $self->{'_writable'} = 1;
677 0         0 $self->{'_appendable'} = 1;
678              
679 0         0 $irs = flock( $self->{'_file'}, LOCK_EX );
680              
681 0 0       0 $irs = seek( $self->{'_file'}, 0, SEEK_END ) if ($irs);
682              
683 0 0       0 if ($irs) {
684 0         0 $self->{'_locked'} = 1;
685              
686 0         0 $irs = 1;
687             }
688             }
689             else #The File could not be opened
690             {
691             $self->{'_error_message'} .=
692             "File '"
693             . $self->{'_directory_name'}
694 0         0 . $self->{'_file_name'}
695             . "': Open Append failed!\n"
696             . "Message: '$!'\n";
697 0 0       0 $self->{'_error_code'} = 1 if ( $self->{'_error_code'} < 1 );
698              
699 0         0 $irs = 0;
700             }
701             }
702             else #The File Name isnt set
703             {
704 0         0 $self->{'_error_message'} .= "File Name isn't set!\n";
705 0 0       0 $self->{'_error_code'} = 3 if ( $self->{'_error_code'} < 1 );
706             }
707             }
708             }
709             else #The File is already open in Appending Mode
710             {
711 0         0 $irs = 1;
712             } #unless($self->_isAppendable())
713              
714 0         0 return $irs;
715             }
716              
717             sub Read {
718 1     1 0 2 my $self = $_[0];
719 1         3 my $irs = 0;
720              
721 1         2 ${ $self->{'_file_content'} } = '';
  1         4  
722 1         3 $self->{'_file_content_lines'} = undef;
723 1 50       5 $self->{'_buffered'} = 1 unless ( $self->{'_buffered'} );
724 1         3 $self->{'_file_time'} = -1;
725 1         2 $self->{'_file_size'} = -1;
726              
727 1 50       7 $self->_openrFile() if ( $self->_isWritable() );
728              
729 1 50       3 $self->_openrFile() unless ( $self->_isOpen() );
730              
731 1 50       4 if ( $self->_isOpen() ) {
732 1         2 my $scntntln = '';
733 1         3 my $irdcnt = -1;
734              
735             do #while($irdcnt);
736 1         2 {
737 2         56 $irdcnt = sysread( $self->{'_file'}, $scntntln, $self->{"_package_size"} );
738              
739 2 50       8 if ( defined $irdcnt ) {
740 2 100       7 ${ $self->{'_file_content'} } .= $scntntln if ( $irdcnt > 0 );
  1         7  
741             }
742             else #An Error has ocurred
743             {
744             $self->{'_error_message'} .=
745             "File '"
746             . $self->{'_directory_name'}
747 0         0 . $self->{'_file_name'}
748             . "': Read File failed with ["
749             . ( 0 + $! ) . "]!!"
750             . "Message: '$!'\n";
751 0 0       0 $self->{'_error_code'} = 1 if ( $self->{'_error_code'} < 1 );
752             }
753             } while ($irdcnt);
754              
755 1 50       8 $irs = 1 unless ($!);
756              
757 1 50       4 if ($irs) {
758 1         16 my @arrflstt = stat( $self->{'_file'} );
759              
760 1 50       4 if ( scalar(@arrflstt) > 0 ) {
761 1         4 $self->{'_file_time'} = $arrflstt[9];
762 1         3 $self->{'_file_size'} = $arrflstt[7];
763             }
764             else #The File Attributes are empty
765             {
766             $self->{'_error_message'} .=
767 0         0 "File '" . $self->{'_directory_name'} . $self->{'_file_name'} . "': File Attributes failed!\n";
768             }
769             }
770              
771 1 50       5 if ( $self->{'_persistent'} ) {
772 0 0       0 unless ($irs) {
773             $self->{'_error_message'} .=
774             "File '"
775             . $self->{'_directory_name'}
776 0         0 . $self->{'_file_name'} . "': "
777             . "File closing because of Reading Error ...\n";
778              
779             #Close the File
780 0         0 $self->_closeFile();
781             }
782             }
783             else #File is not persistent
784             {
785             #Close the File
786 1         23 $self->_closeFile();
787             }
788             }
789              
790 1         8 return $irs;
791             }
792              
793             sub readContent {
794 0     0 0 0 my $self = $_[0];
795              
796 0         0 $self->Read();
797              
798 0         0 return $self->getContent;
799             }
800              
801             sub readContentArray {
802 0     0 0 0 my $self = $_[0];
803              
804 0         0 File::Access::Driver::Read $self;
805              
806 0         0 return $self->getContentArray;
807             }
808              
809             sub Truncate {
810 1     1 0 4 my $self = $_[0];
811              
812 1         5 return $self->writeContent('');
813             }
814              
815             sub Write {
816 4     4 0 7 my $self = $_[0];
817 4         7 my $irs = 0;
818              
819 4 50       14 $self->{'_buffered'} = 1 unless ( $self->{'_buffered'} );
820 4         8 $self->{'_file_time'} = -1;
821 4         10 $self->{'_file_access_time'} = -1;
822 4         9 $self->{'_file_size'} = -1;
823              
824 4 50       15 unless ( $self->_isWritable() ) {
825 4 50       9 $self->_closeFile() if ( $self->_isOpen() );
826              
827             #Open the File in Write Mode
828 4         17 $self->_openwFile();
829             }
830              
831 4 50       15 if ( $self->_isWritable() ) {
832 4         6 my $iwrtcnt = -1;
833 4         15 my $content = $self->getContent();
834 4         6 my $icntntlen = length( ${$content} );
  4         9  
835              
836 4         7 $irs = 0;
837              
838             # Write the Content Line to the File
839 4         10 $iwrtcnt = syswrite( $self->{'_file'}, ${$content} );
  4         100  
840              
841 4 50       14 if ( defined $iwrtcnt ) {
842 4         7 $irs = 1;
843              
844 4 50       12 if ( $iwrtcnt != $icntntlen ) {
845             $self->{'_error_message'} .=
846             "File '"
847             . $self->{'_directory_name'}
848 0         0 . $self->{'_file_name'}
849             . "': '$iwrtcnt' from '$icntntlen' Bytes written.\n";
850             }
851             }
852             else # An Error has ocurred
853             {
854             $self->{'_error_message'} .=
855             "File '"
856             . $self->{'_directory_name'}
857 0         0 . $self->{'_file_name'}
858             . "': File Write failed!\n"
859             . "Message: '$!'\n";
860 0 0       0 $self->{'_error_code'} = 1 if ( $self->{'_error_code'} < 1 );
861             }
862              
863 4 50       11 if ($irs) {
864 4         47 my @arrflstt = stat( $self->{'_file'} );
865              
866 4 50       12 if ( scalar(@arrflstt) > 0 ) {
867 4         9 $self->{'_file_time'} = $arrflstt[9];
868 4         8 $self->{'_file_access_time'} = $arrflstt[8];
869 4         11 $self->{'_file_size'} = $arrflstt[7];
870             }
871             else #The File Attributes are empty
872             {
873             $self->{'_error_message'} .=
874 0         0 "File '" . $self->{'_directory_name'} . $self->{'_file_name'} . "': File Attributes failed!\n";
875             }
876             }
877              
878 4 50       13 if ( $self->{'_persistent'} ) {
879 0 0       0 unless ($irs) {
880             $self->{'_error_message'} .=
881             "File '"
882             . $self->{'_directory_name'}
883 0         0 . $self->{'_file_name'} . "': "
884             . "File closing because of Writing Error ...\n";
885              
886             #Close the File
887 0         0 $self->_closeFile();
888             }
889             }
890             else #File is not persistent
891             {
892             #Close the File
893 4         16 $self->_closeFile();
894             }
895             }
896              
897 4         23 return $irs;
898             }
899              
900             sub writeContent {
901 3     3 0 8 my $self = $_[0];
902              
903 3         14 $self->setContent( $_[1] );
904              
905 3         12 return File::Access::Driver::Write $self;
906             }
907              
908             sub appendLine {
909 0     0 0 0 my $self = $_[0];
910 0         0 my $rcntntln = undef;
911 0         0 my $irs = 0;
912              
913 0         0 $self->{'_file_time'} = -1;
914 0         0 $self->{'_file_size'} = -1;
915              
916 0 0       0 if ( scalar(@_) > 1 ) {
917 0 0       0 if ( ref( $_[1] ) ne '' ) {
918 0         0 $rcntntln = $_[1];
919             }
920             else {
921 0         0 $rcntntln = \$_[1];
922             }
923              
924 0 0       0 if ( $$rcntntln ne '' ) {
925 0 0       0 if ( $self->{'_buffered'} > 0 ) {
926 0         0 ${ $self->{'_file_content'} } .= $$rcntntln;
  0         0  
927             }
928             }
929             }
930              
931 0 0       0 unless ( $self->_isAppendable() ) {
932 0 0       0 $self->_closeFile() if ( $self->_isOpen() );
933              
934             #Open the File in Appending Mode
935 0         0 $self->_openaFile();
936             }
937              
938 0 0       0 if ( $self->_isAppendable() ) {
939 0         0 my $iwrtcnt = -1;
940 0         0 my $icntntlen = length($$rcntntln);
941              
942 0         0 $irs = 0;
943              
944             #Write the Content Line to the File
945 0         0 $iwrtcnt = syswrite( $self->{'_file'}, $$rcntntln );
946              
947 0 0       0 if ( defined $iwrtcnt ) {
948 0         0 $irs = 1;
949              
950 0 0       0 if ( $iwrtcnt != $icntntlen ) {
951             $self->{'_error_message'} .=
952             "File '"
953             . $self->{'_directory_name'}
954 0         0 . $self->{'_file_name'} . "': "
955             . "'$iwrtcnt' from '$icntntlen' Bytes written.\n";
956             }
957             }
958             else #An Error has ocurred
959             {
960             $self->{'_error_message'} .=
961             "File '"
962             . $self->{'_directory_name'}
963 0         0 . $self->{'_file_name'}
964             . "': File Write failed!\n"
965             . "Message: '$!'\n";
966 0 0       0 $self->{'_error_code'} = 1 if ( $self->{'_error_code'} < 1 );
967             }
968              
969 0 0       0 if ($irs) {
970 0         0 my @arrflstt = stat( $self->{'_file'} );
971              
972 0 0       0 if ( scalar(@arrflstt) > 0 ) {
973 0         0 $self->{'_file_time'} = $arrflstt[9];
974 0         0 $self->{'_file_size'} = $arrflstt[7];
975             }
976             else #The File Attributes are empty
977             {
978             $self->{'_error_message'} .=
979 0         0 "File '" . $self->{'_directory_name'} . $self->{'_file_name'} . "': File Attributes failed!\n";
980             }
981             }
982              
983 0 0       0 if ( $self->{'_persistent'} > 0 ) {
984 0 0       0 unless ( $irs > 0 ) {
985             $self->{'_error_message'} .=
986             "File '"
987             . $self->{'_directory_name'}
988 0         0 . $self->{'_file_name'} . "': "
989             . "File closing because of Writing Error ...\n";
990              
991             #Close the File
992 0         0 $self->_closeFile();
993             }
994             }
995             else #File is not persistent
996             {
997             #Close the File
998 0         0 $self->_closeFile();
999             }
1000             } #if($self->_isAppendable())
1001              
1002 0         0 return $irs;
1003             }
1004              
1005             sub writeLine {
1006 0     0 0 0 my $self = $_[0];
1007              
1008 0         0 return $self->appendLine( $_[1] );
1009             }
1010              
1011             sub Delete {
1012 4     4 0 20 my $self = $_[0];
1013 4         10 my $irs = 0;
1014              
1015             #Close the Open File
1016 4 50       11 $self->_closeFile() if ( $self->_isOpen );
1017              
1018 4 100       14 if ( $self->Exists ) {
1019 2         233 $irs = unlink $self->{'_directory_name'} . $self->{'_file_name'};
1020              
1021 2 50       10 if ( $irs < 1 ) {
1022             $self->{'_error_message'} .=
1023             "File '"
1024             . $self->{'_directory_name'}
1025 0         0 . $self->{'_file_name'}
1026             . "': Delete File failed with ["
1027             . ( 0 + $! ) . "]!"
1028             . "Message: '$!'\n";
1029 0 0       0 $self->{'_error_code'} = 1 if ( $self->{'_error_code'} < 1 );
1030              
1031 0         0 $irs = 0;
1032             }
1033             }
1034             else #The File does not exist
1035             {
1036 2         5 $irs = 1;
1037             }
1038              
1039 4         80 return $irs;
1040             }
1041              
1042             sub _closeFile {
1043 5     5   11 my $self = $_[0];
1044 5         10 my $irs = 0;
1045              
1046 5 50       11 if ( $self->_isOpen() ) {
1047 5 50       32 if ( $self->{'_locked'} > 0 ) {
1048 5         35 $irs = flock( $self->{'_file'}, LOCK_UN );
1049              
1050 5 50       15 unless ($irs) {
1051             $self->{'_error_message'} .=
1052             "File '"
1053             . $self->{'_directory_name'}
1054 0         0 . $self->{'_file_name'} . "': "
1055             . "Lock Release failed!\n"
1056             . "Message: '$!'\n";
1057 0 0       0 $self->{'_error_code'} = 1 if ( $self->{'_error_code'} < 1 );
1058             }
1059             else #File Lock was released
1060             {
1061 5         12 $self->{'_locked'} = 0;
1062             }
1063             }
1064              
1065 5         87 $irs = close $self->{'_file'};
1066              
1067 5 50       17 unless ( $irs > 0 ) {
1068             $self->{'_error_message'} .=
1069             "File '"
1070             . $self->{'_directory_name'}
1071 0         0 . $self->{'_file_name'} . "': "
1072             . "Close failed!\n"
1073             . "Message: '$!'\n";
1074 0 0       0 $self->{'_error_code'} = 1 if ( $self->{'_error_code'} < 1 );
1075             } #unless($irs > 0)
1076              
1077 5         25 $self->{'_file'} = undef;
1078 5         10 $self->{'_writable'} = 0;
1079 5         10 $self->{'_appendable'} = 0;
1080              
1081             #To Refresh on next Request
1082 5         11 $self->{'_file_access_time'} = -1;
1083 5         8 $self->{'_file_time'} = -1;
1084 5         9 $self->{'_file_size'} = -1;
1085              
1086             }
1087             else #The File is not open
1088             {
1089 0         0 $irs = 1;
1090             }
1091              
1092 5         12 return $irs;
1093             }
1094              
1095             sub Clear {
1096 10     10 0 17 my $self = $_[0];
1097              
1098             #Close the Open File
1099 10 50       33 $self->_closeFile() if ( $self->_isOpen() );
1100              
1101             #Clear Content
1102 10         21 $self->{'_file_content'} = undef;
1103 10         15 $self->{'_file_content_lines'} = undef;
1104              
1105 10         44 $self->clearErrors;
1106              
1107             #To Refresh on next Request
1108 10         13 $self->{'_file_access_time'} = -1;
1109 10         18 $self->{'_file_time'} = -1;
1110 10         18 $self->{'_file_size'} = -1;
1111              
1112             }
1113              
1114             sub clearErrors {
1115 11     11 0 15 my $self = $_[0];
1116              
1117 11         21 $self->{"_report"} = '';
1118 11         17 $self->{'_error_message'} = '';
1119 11         24 $self->{'_error_code'} = 0;
1120             }
1121              
1122             sub freeResources {
1123 6     6 0 8 my $self = $_[0];
1124              
1125 6 50       18 if ( $self->_isOpen ) {
1126              
1127             # Close the Open File
1128 0         0 $self->_closeFile();
1129             }
1130              
1131             #Clear Content
1132 6         13 $self->{'_file_content'} = undef;
1133 6         192 $self->{'_file_content_lines'} = undef;
1134             }
1135              
1136             #----------------------------------------------------------------------------
1137             #Consultation Methods
1138              
1139             sub getFileDirectory {
1140 3     3 0 17 return $_[0]->{'_directory_name'};
1141             }
1142              
1143             sub getFileName {
1144 14     14 0 2527 return $_[0]->{'_file_name'};
1145             }
1146              
1147             sub getFilePath {
1148 3     3 0 14 return $_[0]->{'_directory_name'} . $_[0]->{'_file_name'};
1149             }
1150              
1151             sub getContent {
1152 5     5 0 11 my $self = $_[0];
1153              
1154             $self->{'_file_content'} = \''
1155 5 50       20 unless ( defined $self->{'_file_content'} );
1156              
1157 5 100       8 if ( ${ $self->{'_file_content'} } eq '' ) {
  5         20  
1158 3         77 print "build cntnt ...\n";
1159             print "build lns ("
1160 3         9 . scalar( @{ $self->{'_file_content_lines'} } ) . "): '"
1161 3         7 . join( '|', @{ $self->{'_file_content_lines'} } ) . "'\n";
  3         19  
1162              
1163 3 100       7 if ( scalar( @{ $self->{'_file_content_lines'} } ) > 0 ) {
  3         12  
1164 1         3 my $content = join( "\n", @{ $self->{'_file_content_lines'} } );
  1         5  
1165              
1166 1         3 $self->{'_file_content'} = \$content;
1167             }
1168             }
1169              
1170 5         13 return $self->{'_file_content'};
1171             }
1172              
1173             sub getContentArray {
1174 1     1 0 1834 my $self = $_[0];
1175              
1176 1         3 @{ $self->{'_file_content_lines'} } = ()
1177 1 50       5 unless ( defined $self->{'_file_content_lines'} );
1178              
1179 1 50       2 if ( scalar( @{ $self->{'_file_content_lines'} } ) == 0 ) {
  1         2280  
1180 1 50       4 if ( ${ $self->{'_file_content'} } ne '' ) {
  1         6  
1181 1         2 @{ $self->{'_file_content_lines'} } = split( "\n", ${ $self->{'_file_content'} } );
  1         3  
  1         7  
1182             }
1183             }
1184              
1185 1         7 return $self->{'_file_content_lines'};
1186             }
1187              
1188             sub getFileTime {
1189 0     0 0 0 my $self = $_[0];
1190              
1191 0 0       0 if ( $self->Exists() ) {
1192 0 0       0 if ( $self->{'_file_time'} < 0 ) {
1193 0         0 my @arrflstt = stat( $self->{'_directory_name'} . $self->{'_file_name'} );
1194              
1195 0         0 $self->{'_file_time'} = -1;
1196 0         0 $self->{'_file_access_time'} = -1;
1197 0         0 $self->{'_file_size'} = -1;
1198              
1199 0 0       0 if ( scalar(@arrflstt) > 0 ) {
1200 0         0 $self->{'_file_time'} = $arrflstt[9];
1201 0         0 $self->{'_file_access_time'} = $arrflstt[8];
1202 0         0 $self->{'_file_size'} = $arrflstt[7];
1203             }
1204             else #The File Attributes are empty
1205             {
1206             $self->{'_error_message'} .=
1207 0         0 "File '" . $self->{'_directory_name'} . $self->{'_file_name'} . "': File Attributes failed!\n";
1208 0 0       0 $self->{'_error_code'} = 1 if ( $self->{'_error_code'} < 1 );
1209             }
1210             }
1211             }
1212             else #The File does not exist
1213             {
1214 0         0 $self->{'_file_time'} = -1;
1215 0         0 $self->{'_file_access_time'} = -1;
1216 0         0 $self->{'_file_size'} = -1;
1217             }
1218              
1219 0         0 return $self->{'_file_time'};
1220             }
1221              
1222             sub getFileSize {
1223 5     5 0 14 my $self = $_[0];
1224              
1225 5 50       15 if ( $self->Exists() ) {
1226 5 50       18 if ( $self->{'_file_size'} < 0 ) {
1227 5         69 my @arrflstt = stat( $self->{'_directory_name'} . $self->{'_file_name'} );
1228              
1229 5         15 $self->{'_file_time'} = -1;
1230 5         11 $self->{'_file_access_time'} = -1;
1231 5         9 $self->{'_file_size'} = -1;
1232              
1233 5 50       15 if ( scalar(@arrflstt) > 0 ) {
1234 5         9 $self->{'_file_time'} = $arrflstt[9];
1235 5         10 $self->{'_file_access_time'} = $arrflstt[8];
1236 5         15 $self->{'_file_size'} = $arrflstt[7];
1237             }
1238             else #The File Attributes are empty
1239             {
1240             $self->{'_error_message'} .=
1241 0         0 "File '" . $self->{'_directory_name'} . $self->{'_file_name'} . "': File Attributes failed!\n";
1242 0 0       0 $self->{'_error_code'} = 1 if ( $self->{'_error_code'} < 1 );
1243             }
1244             }
1245             }
1246             else #The File does not exist
1247             {
1248 0         0 $self->{'_file_time'} = -1;
1249 0         0 $self->{'_file_access_time'} = -1;
1250 0         0 $self->{'_file_size'} = -1;
1251             }
1252              
1253 5         30 return $self->{'_file_size'};
1254             }
1255              
1256             sub Exists {
1257 17     17 0 37 my $self = $_[0];
1258 17         28 my $irs = 0;
1259              
1260 17 50       40 unless ( $self->_isOpen() ) {
1261 17 50       45 if ( $self->{'_file_name'} ne '' ) {
1262 17 50       47 if ( $self->{'_directory_name'} ne '' ) {
1263 17 100       554 $irs = 1 if ( -d $self->{'_directory_name'} );
1264             }
1265             else #The Directory Name isnt set
1266             {
1267 0         0 $irs = 1;
1268             }
1269              
1270 17 100       55 if ($irs) {
1271 15 100       259 $irs = 0 unless ( -e $self->{'_directory_name'} . $self->{'_file_name'} );
1272             }
1273             }
1274             else #The File Name isnt set
1275             {
1276 0         0 $self->{'_error_message'} .= "File Name isn't set!\n";
1277 0 0       0 $self->{'_error_code'} = 3 if ( $self->{'_error_code'} < 1 );
1278             }
1279             }
1280             else #The File is already open
1281             {
1282 0         0 $irs = 1;
1283             }
1284              
1285 17         73 return $irs;
1286             }
1287              
1288             sub _isOpen {
1289 67     67   109 my $self = $_[0];
1290 67         122 my $iopn = 0;
1291              
1292 67 100       131 if ( defined $self->{'_file'} ) {
1293 10 50       36 $iopn = 1 if ( fileno( $self->{'_file'} ) );
1294             }
1295             else #The File Handle is not set
1296             {
1297 57 50       122 $self->{'_file'} = undef unless ( exists $self->{'_file'} );
1298             }
1299              
1300 67         183 return $iopn;
1301             }
1302              
1303             sub _isWritable {
1304 13     13   21 my $self = $_[0];
1305 13         22 my $iopn = 0;
1306              
1307 13 100       29 if ( $self->_isOpen() ) {
1308 4 50       14 $iopn = $self->{'_writable'} if ( defined $self->{'_writable'} );
1309             }
1310              
1311 13         45 return $iopn;
1312             }
1313              
1314             sub _isAppendable {
1315 0     0   0 my $self = $_[0];
1316 0         0 my $iopn = 0;
1317              
1318 0 0       0 if ( $self->_isOpen() ) {
1319 0 0       0 $iopn = $self->{'_appendable'} if ( defined $self->{'_appendable'} );
1320             }
1321              
1322 0         0 return $iopn;
1323             }
1324              
1325             sub isBuffered {
1326 0     0 0 0 return $_[0]->{'_buffered'};
1327             }
1328              
1329             sub isPersistent {
1330 0     0 0 0 return $_[0]->{'_persistent'};
1331             }
1332              
1333             sub getReportString {
1334 3     3 0 29 return \$_[0]->{"_report"};
1335             }
1336              
1337             sub getErrorString {
1338 6     6 0 37 return \$_[0]->{'_error_message'};
1339             }
1340              
1341             sub getErrorCode {
1342 6     6 0 74 return $_[0]->{'_error_code'};
1343             }
1344              
1345             return 1;