code_perl/Maasha/Filesys.pm

   1 package Maasha::Filesys;
   2
   3
   4 # Copyright (C) 2006-2008 Martin A. Hansen.
   5
   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.
  10
  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.
  15
  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.
  19
  20 # http://www.gnu.org/copyleft/gpl.html
  21
  22
  23 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DESCRIPTION <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  24
  25
  26 # This module contains routines for manipulation of files and directories.
  27
  28
  29 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  30
  31
  32 use warnings;
  33 use strict;
  34 use IO::File;
  35 use Storable;
  36 use Data::Dumper;
  37 use Maasha::Common;
  38
  39 use Exporter;
  40
  41 use vars qw( @ISA @EXPORT @EXPORT_OK );
  42
  43 @ISA = qw( Exporter ) ;
  44
  45
  46 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> FILES <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  47
  48
  49 sub file_read_open
  50 {
  51     # Martin A. Hansen, January 2004.
  52
  53     # Read opens a file that may be gzipped and returns a filehandle.
  54
  55     my ( $path,   # full path to file
  56        ) = @_;
  57
  58     # Returns filehandle
  59
  60     my ( $fh );
  61
  62     if ( is_gzipped( $path ) ) {
  63         $fh = new IO::File "zcat $path|" or Maasha::Common::error( qq(Could not read-open file "$path": $!) );
  64     } else {
  65         $fh = new IO::File $path, "r" or Maasha::Common::error( qq(Could not read-open file "$path": $!) );
  66     }
  67
  68     return $fh;
  69 }
  70
  71
  72 sub files_read_open
  73 {
  74     # Martin A. Hansen, May 2009.
  75
  76     # Cats a number of files and returns a filehandle.
  77
  78     my ( $files,   # full path to file
  79        ) = @_;
  80
  81     # returns filehandle
  82
  83     my ( $file, $fh, $type, %type_hash, $file_string );
  84
  85     foreach $file ( @{ $files } )
  86     {
  87         Maasha::Common::error( qq(No such file: $file) ) if not -f $file;
  88
  89         $type = `file $file`;
  90
  91         if ( $type =~ /gzip compressed/ ) {
  92             $type_hash{ 'gzip' } = 1;
  93         } else {
  94             $type_hash{ 'ascii' } = 1;
  95         }
  96     }
  97
  98     Maasha::Common::error( qq(Mixture of zipped and unzipped files) ) if scalar keys %type_hash > 1;
  99
 100     $file_string = join " ", @{ $files };
 101
 102     if ( $type =~ /gzip compressed/ ) {
 103         $fh = new IO::File "zcat $file_string|" or Maasha::Common::error( qq(Could not open pipe: $!) );
 104     } else {
 105         $fh = new IO::File "cat $file_string|" or Maasha::Common::error( qq(Could not open pipe: $!) );
 106     }
 107
 108     return $fh;
 109 }
 110
 111
 112 sub file_write_open
 113 {
 114     # Martin A. Hansen, January 2004.
 115
 116     # write opens a file and returns a filehandle
 117
 118     my ( $path,   # full path to file
 119          $gzip,   # flag if data is to be gzipped - OPRIONAL
 120        ) = @_;
 121
 122     # returns filehandle
 123
 124     my ( $fh );
 125
 126     if ( $gzip ) {
 127         $fh = new IO::File "|gzip -f>$path" or Maasha::Common::error( qq(Could not write-open file "$path": $!) );
 128     } else {
 129         $fh = new IO::File $path, "w" or Maasha::Common::error( qq(Could not write-open file "$path": $!) );
 130     }
 131
 132     return $fh;
 133 }
 134
 135
 136 sub file_append_open
 137 {
 138     # Martin A. Hansen, February 2006.
 139
 140     # append opens file and returns a filehandle
 141
 142     my ( $path,     # path to file
 143        ) = @_;
 144
 145     # returns filehandle
 146
 147     my ( $fh );
 148
 149     $fh = new IO::File $path, "a" or Maasha::Common::error( qq(Could not append-open file "$path": $!) );
 150
 151     return $fh;
 152 }
 153
 154
 155 sub stdin_read
 156 {
 157     # Martin A. Hansen, July 2007.
 158
 159     # Returns a filehandle to STDIN
 160
 161     my ( $fh );
 162
 163     $fh = new IO::File "<&STDIN" or Maasha::Common::error( qq(Could not read from STDIN: $!) );
 164
 165     return $fh;
 166 }
 167
 168
 169 sub stdout_write
 170 {
 171     # Martin A. Hansen, July 2007.
 172
 173     # Returns a filehandle to STDOUT
 174
 175     my ( $fh );
 176
 177     $fh = new IO::File ">&STDOUT" or Maasha::Common::error( qq(Could not write to STDOUT: $!) );
 178
 179     return $fh;
 180 }
 181
 182
 183 sub file_read
 184 {
 185     # Martin A. Hansen, December 2004.
 186
 187     # given a file, a seek beg position and
 188     # length, returns the corresponding string.
 189
 190     my ( $fh,     # file handle to file
 191          $beg,    # read start in file
 192          $len,    # read length of block
 193         ) = @_;
 194
 195     # returns string
 196
 197     my ( $string );
 198
 199     Maasha::Common::error( qq(Negative length: $len) ) if $len < 0;
 200
 201     sysseek $fh, $beg, 0;
 202     sysread $fh, $string, $len;
 203
 204     return $string;
 205 }
 206
 207
 208 sub file_store
 209 {
 210     # Martin A. Hansen, December 2004.
 211
 212     # writes a data structure to file.
 213
 214     my ( $path,      # full path to file
 215          $data,      # data structure
 216        ) = @_;
 217
 218     Storable::store( $data, $path ) or Maasha::Common::error( qq(Could not write-open file "$path": $!) );
 219 }
 220
 221
 222 sub file_retrieve
 223 {
 224     # Martin A. Hansen, December 2004.
 225
 226     # retrieves hash data structure
 227     # (this routines needs to test if its a hash, array or else)
 228
 229     my ( $path,   # full path to data file
 230        ) = @_;
 231
 232     my ( $data );
 233
 234     $data = Storable::retrieve( $path ) or Maasha::Common::error( qq(Could not read-open file "$path": $!) );
 235
 236     return wantarray ? %{ $data } : $data;
 237 }
 238
 239
 240 sub file_copy
 241 {
 242     # Martin A. Hansen, November 2008.
 243
 244     # Copy the content of a file from source path to
 245     # destination path.
 246
 247     my ( $src,   # source path
 248          $dst,   # destination path
 249        ) = @_;
 250
 251     # Returns nothing.
 252
 253     my ( $fh_in, $fh_out, $line );
 254
 255     Maasha::Common::error( qq(copy failed: destination equals source "$src") ) if $src eq $dst;
 256
 257     $fh_in  = file_read_open( $src );
 258     $fh_out = file_write_open( $dst );
 259
 260     while ( $line = <$fh_in> ) {
 261         print $fh_out $line;
 262     }
 263
 264     close $fh_in;
 265     close $fh_out;
 266 }
 267
 268
 269 sub is_gzipped
 270 {
 271     # Martin A. Hansen, November 2008.
 272
 273     # Checks if a given file is gzipped.
 274     # Currrently uses a call to the systems
 275     # file tool. Returns 1 if gzipped otherwise
 276     # returns 0.
 277
 278     my ( $path,   # path to file
 279        ) = @_;
 280
 281     # Returns boolean.
 282
 283     my ( $type );
 284
 285     $type = `file $path`;
 286
 287     if ( $type =~ /gzip compressed/ ) {
 288         return 1;
 289     } else {
 290         return 0;
 291     }
 292 }
 293
 294
 295 sub file_size
 296 {
 297     # Martin A. Hansen, March 2007
 298
 299     # returns the file size for a given file
 300
 301     my ( $path,   # full path to file
 302        ) = @_;
 303
 304     # returns integer
 305
 306     my $file_size = -s $path;
 307
 308     return $file_size;
 309 }
 310
 311
 312 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DIRECTORIES <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 313
 314
 315 sub dir_create
 316 {
 317     # Martin A. Hansen, July 2007.
 318
 319     # Creates a directory.
 320
 321     my ( $path,   # full path to dir
 322        ) = @_;
 323
 324     # Returns nothing.
 325
 326     if ( -d $path ) {
 327         Maasha::Common::error( qq(Directory already exists "$path": $!) );
 328     } else {
 329         mkdir $path or Maasha::Common::error( qq(Could not create directory "$path": $!) );
 330     }
 331 }
 332
 333
 334 sub dir_create_if_not_exists
 335 {
 336     # Martin A. Hansen, May 2008.
 337
 338     # Creates a directory if it does not already exists.
 339
 340     my ( $path,   # full path to dir
 341        ) = @_;
 342
 343     # Returns nothing.
 344
 345     if ( not -d $path ) {
 346         mkdir $path or Maasha::Common::error( qq(Could not create directory "$path": $!) );
 347     }
 348 }
 349
 350
 351 sub dir_remove
 352 {
 353     # Martin A. Hansen, April 2008.
 354
 355     # Removes a directory recursively.
 356
 357     my ( $path,   # directory
 358        ) = @_;
 359
 360     Maasha::Common::run( "rm", "-rf $path" ) if -d $path;
 361 }
 362
 363
 364 sub ls_dirs
 365 {
 366     # Martin A. Hansen, June 2007.
 367
 368     # returns all dirs in a given directory.
 369
 370     my ( $path,   # full path to directory
 371        ) = @_;
 372
 373     # returns a list of filenames.
 374
 375     my ( $dh, @dirs );
 376
 377     $dh = open_dir( $path );
 378
 379     @dirs =  read_dir( $dh );
 380     @dirs = grep { -d "$path/$_" } @dirs;
 381
 382     map { $_ = "$path/$_" } @dirs;
 383
 384     close $dh;
 385
 386     return wantarray ? @dirs : \@dirs;
 387 }
 388
 389
 390 sub ls_files
 391 {
 392     # Martin A. Hansen, June 2007.
 393
 394     # returns all files in a given directory.
 395
 396     my ( $path,   # full path to directory
 397        ) = @_;
 398
 399     # returns a list of filenames.
 400
 401     my ( $dh, @files );
 402
 403     $dh = open_dir( $path );
 404
 405     @files =  read_dir( $dh );
 406     @files = grep { -f "$path/$_" } @files;
 407
 408     map { $_ = "$path/$_" } @files;
 409
 410     close $dh;
 411
 412     return wantarray ? @files : \@files;
 413 }
 414
 415
 416 sub open_dir
 417 {
 418     # Martin A. Hansen, June 2007.
 419
 420     # open a directory and returns a directory handle
 421
 422     use IO::Dir;
 423
 424     my ( $path,   # full path to directory
 425        ) = @_;
 426
 427     # returns object
 428
 429     my $dh;
 430
 431     $dh = IO::Dir->new( $path ) or Maasha::Common::error( qq(Could not open dir "$path": $!) );
 432
 433     return $dh;
 434 }
 435
 436
 437 sub read_dir
 438 {
 439     # Martin A. Hansen, June 2007.
 440
 441     # read all files and directories from a directory.
 442
 443     my ( $dh,   # directory handle object
 444        ) = @_;
 445
 446     # returns list
 447
 448     my ( $elem, @elems );
 449
 450     while ( defined( $elem = $dh->read ) ) {
 451         push @elems, $elem;
 452     }
 453
 454     return wantarray ? @elems : \@elems;
 455 }
 456
 457
 458 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 459
 460
 461 1;
 462
 463
 464 __END__