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