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