1 package Maasha::Filesys;
4 # Copyright (C) 2006-2008 Martin A. Hansen.
6 # This program is free software; you can redistribute it and/or
7 # modify it under the terms of the GNU General Public License
8 # as published by the Free Software Foundation; either version 2
9 # of the License, or (at your option) any later version.
11 # This program is distributed in the hope that it will be useful,
12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 # GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License
17 # along with this program; if not, write to the Free Software
18 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
20 # http://www.gnu.org/copyleft/gpl.html
23 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DESCRIPTION <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
26 # This module contains routines for manipulation of files and directories.
29 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
42 use vars qw( @ISA @EXPORT @EXPORT_OK );
44 @ISA = qw( Exporter ) ;
47 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> FILES <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
52 # Martin A. Hansen, January 2004.
54 # Read opens a file that may be gzipped and returns a filehandle.
56 my ( $path, # full path to file
63 if ( is_gzipped( $path ) ) {
64 $fh = new IO::File "zcat $path|" or Maasha::Common::error( qq(Could not read-open file "$path": $!) );
66 $fh = new IO::File $path, "r" or Maasha::Common::error( qq(Could not read-open file "$path": $!) );
75 # Martin A. Hansen, May 2009.
77 # Cats a number of files and returns a filehandle.
79 my ( $files, # full path to file
84 my ( $file, $fh, $type, %type_hash, $file_string );
86 foreach $file ( @{ $files } )
88 Maasha::Common::error( qq(No such file: $file) ) if not -f $file;
92 if ( $type =~ /gzip compressed/ ) {
93 $type_hash{ 'gzip' } = 1;
95 $type_hash{ 'ascii' } = 1;
99 Maasha::Common::error( qq(Mixture of zipped and unzipped files) ) if scalar keys %type_hash > 1;
101 $file_string = join " ", @{ $files };
103 if ( $type =~ /gzip compressed/ ) {
104 $fh = new IO::File "zcat $file_string|" or Maasha::Common::error( qq(Could not open pipe: $!) );
106 $fh = new IO::File "cat $file_string|" or Maasha::Common::error( qq(Could not open pipe: $!) );
115 # Martin A. Hansen, January 2004.
117 # write opens a file and returns a filehandle
119 my ( $path, # full path to file
120 $gzip, # flag if data is to be gzipped - OPRIONAL
128 $fh = new IO::File "|gzip -f>$path" or Maasha::Common::error( qq(Could not write-open file "$path": $!) );
130 $fh = new IO::File $path, "w" or Maasha::Common::error( qq(Could not write-open file "$path": $!) );
139 # Martin A. Hansen, February 2006.
141 # append opens file and returns a filehandle
143 my ( $path, # path to file
150 $fh = new IO::File $path, "a" or Maasha::Common::error( qq(Could not append-open file "$path": $!) );
158 # Martin A. Hansen, July 2007.
160 # Returns a filehandle to STDIN
164 $fh = new IO::File "<&STDIN" or Maasha::Common::error( qq(Could not read from STDIN: $!) );
172 # Martin A. Hansen, July 2007.
174 # Returns a filehandle to STDOUT
178 $fh = new IO::File ">&STDOUT" or Maasha::Common::error( qq(Could not write to STDOUT: $!) );
186 # Martin A. Hansen, December 2004.
188 # given a file, a seek beg position and
189 # length, returns the corresponding string.
191 my ( $fh, # file handle to file
192 $beg, # read start in file
193 $len, # read length of block
200 Maasha::Common::error( qq(Negative length: $len) ) if $len < 0;
202 sysseek $fh, $beg, 0;
203 sysread $fh, $string, $len;
211 # Martin A. Hansen, December 2004.
213 # writes a data structure to file.
215 my ( $path, # full path to file
216 $data, # data structure
219 Storable::store( $data, $path ) or Maasha::Common::error( qq(Could not write-open file "$path": $!) );
225 # Martin A. Hansen, December 2004.
227 # retrieves hash data structure
228 # (this routines needs to test if its a hash, array or else)
230 my ( $path, # full path to data file
235 $data = Storable::retrieve( $path ) or Maasha::Common::error( qq(Could not read-open file "$path": $!) );
237 return wantarray ? %{ $data } : $data;
243 # Martin A. Hansen, November 2008.
245 # Copy the content of a file from source path to
248 my ( $src, # source path
249 $dst, # destination path
254 my ( $fh_in, $fh_out, $line );
256 Maasha::Common::error( qq(copy failed: destination equals source "$src") ) if $src eq $dst;
258 $fh_in = file_read_open( $src );
259 $fh_out = file_write_open( $dst );
261 while ( $line = <$fh_in> ) {
272 # Martin A. Hansen, November 2008.
274 # Checks if a given file is gzipped.
275 # Currrently uses a call to the systems
276 # file tool. Returns 1 if gzipped otherwise
279 my ( $path, # path to file
286 $type = `file $path`;
288 if ( $type =~ /gzip compressed/ ) {
298 # Martin A. Hansen, March 2007
300 # returns the file size for a given file
302 my ( $path, # full path to file
307 my $file_size = -s $path;
315 # Martin A. Hansen, December 2009.
317 # Get an MD5 sum for a given file.
319 my ( $file, # file path
326 $fh = file_read_open( $file );
328 $md5 = Digest::MD5->new;
330 $md5->addfile( $fh );
334 return $md5->hexdigest;
338 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DIRECTORIES <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
343 # Martin A. Hansen, July 2007.
345 # Creates a directory.
347 my ( $path, # full path to dir
350 # Returns created path.
353 Maasha::Common::error( qq(Directory already exists "$path") );
355 mkdir $path or Maasha::Common::error( qq(Could not create directory "$path": $!) );
362 sub dir_create_if_not_exists
364 # Martin A. Hansen, May 2008.
366 # Creates a directory if it does not already exists.
368 my ( $path, # full path to dir
373 if ( not -d $path ) {
374 mkdir $path or Maasha::Common::error( qq(Could not create directory "$path": $!) );
383 # Martin A. Hansen, April 2008.
385 # Removes a directory recursively.
387 my ( $path, # directory
390 Maasha::Common::run( "rm", "-rf $path" ) if -d $path;
396 # Martin A. Hansen, June 2007.
398 # returns all dirs in a given directory.
400 my ( $path, # full path to directory
403 # returns a list of filenames.
407 $dh = open_dir( $path );
409 @dirs = read_dir( $dh );
410 @dirs = grep { -d "$path/$_" } @dirs;
412 map { $_ = "$path/$_" } @dirs;
418 return wantarray ? @dirs : \@dirs;
424 # Martin A. Hansen, November 2009.
426 # Returns all directory basenames execpt . and ..
427 # from a given directory.
434 my ( @dirs, $dir, @list );
436 @dirs = Maasha::Filesys::ls_dirs( $path );
438 foreach $dir ( @dirs )
440 next if $dir =~ /\/\.\.?$/;
442 push @list, ( split "/", $dir )[ -1 ];
445 return wantarray ? @list : \@list;
451 # Martin A. Hansen, June 2007.
453 # returns all files in a given directory.
455 my ( $path, # full path to directory
458 # returns a list of filenames.
462 $dh = open_dir( $path );
464 @files = read_dir( $dh );
465 @files = grep { -f "$path/$_" } @files;
467 map { $_ = "$path/$_" } @files;
471 return wantarray ? @files : \@files;
477 # Martin A. Hansen, June 2007.
479 # open a directory and returns a directory handle
483 my ( $path, # full path to directory
490 $dh = IO::Dir->new( $path ) or Maasha::Common::error( qq(Could not open dir "$path": $!) );
498 # Martin A. Hansen, June 2007.
500 # read all files and directories from a directory.
502 my ( $dh, # directory handle object
507 my ( $elem, @elems );
509 while ( defined( $elem = $dh->read ) ) {
513 return wantarray ? @elems : \@elems;
517 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<