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 Maasha::Common;
  35
  36 use Exporter;
  37
  38 use vars qw( @ISA @EXPORT @EXPORT_OK );
  39
  40 @ISA = qw( Exporter ) ;
  41
  42
  43 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> FILES <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  44
  45
  46 sub file_read_open
  47 {
  48     # Martin A. Hansen, January 2004.
  49
  50     # Read opens a file that may be gzipped and returns a filehandle.
  51
  52     my ( $path,   # full path to file
  53        ) = @_;
  54
  55     # Returns filehandle
  56
  57     my ( $fh );
  58
  59     if ( is_gzipped( $path ) ) {
  60         $fh = new IO::File "zcat $path|" or Maasha::Common::error( qq(Could not read-open file "$path": $!) );
  61     } else {
  62         $fh = new IO::File $path, "r" or Maasha::Common::error( qq(Could not read-open file "$path": $!) );
  63     }
  64
  65     return $fh;
  66 }
  67
  68
  69 sub file_write_open
  70 {
  71     # Martin A. Hansen, January 2004.
  72
  73     # write opens a file and returns a filehandle
  74
  75     my ( $path,   # full path to file
  76          $gzip,   # flag if data is to be gzipped - OPRIONAL
  77        ) = @_;
  78
  79     # returns filehandle
  80
  81     my ( $fh );
  82
  83     if ( $gzip ) {
  84         $fh = new IO::File "|gzip -f>$path" or Maasha::Common::error( qq(Could not write-open file "$path": $!) );
  85     } else {
  86         $fh = new IO::File $path, "w" or Maasha::Common::error( qq(Could not write-open file "$path": $!) );
  87     }
  88
  89     return $fh;
  90 }
  91
  92
  93 sub file_append_open
  94 {
  95     # Martin A. Hansen, February 2006.
  96
  97     # append opens file and returns a filehandle
  98
  99     my ( $path,     # path to file
 100        ) = @_;
 101
 102     # returns filehandle
 103
 104     my ( $fh );
 105
 106     $fh = new IO::File $path, "a" or Maasha::Common::error( qq(Could not append-open file "$path": $!) );
 107
 108     return $fh;
 109 }
 110
 111
 112 sub file_copy
 113 {
 114     # Martin A. Hansen, November 2008.
 115
 116     # Copy the content of a file from source path to
 117     # destination path.
 118
 119     my ( $src,   # source path
 120          $dst,   # destination path
 121        ) = @_;
 122
 123     # Returns nothing.
 124
 125     my ( $fh_in, $fh_out, $line );
 126
 127     Maasha::Common::error( qq(copy failed: destination equals source "$src") ) if $src eq $dst;
 128
 129     $fh_in  = file_read_open( $src );
 130     $fh_out = file_write_open( $dst );
 131
 132     while ( $line = <$fh_in> ) {
 133         print $fh_out $line;
 134     }
 135
 136     close $fh_in;
 137     close $fh_out;
 138 }
 139
 140
 141 sub is_gzipped
 142 {
 143     # Martin A. Hansen, November 2008.
 144
 145     # Checks if a given file is gzipped.
 146     # Currrently uses a call to the systems
 147     # file tool. Returns 1 if gzipped otherwise
 148     # returns 0.
 149
 150     my ( $path,   # path to file
 151        ) = @_;
 152
 153     # Returns boolean.
 154
 155     my ( $type );
 156
 157     $type = `file $path`;
 158
 159     if ( $type =~ /gzip compressed/ ) {
 160         return 1;
 161     } else {
 162         return 0;
 163     }
 164 }
 165
 166
 167 sub file_size
 168 {
 169     # Martin A. Hansen, March 2007
 170
 171     # returns the file size for a given file
 172
 173     my ( $path,   # full path to file
 174        ) = @_;
 175
 176     # returns integer
 177
 178     my $file_size = ( stat ( $path ) )[ 7 ];
 179
 180     return $file_size;
 181 }
 182
 183
 184 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 185
 186
 187 1;
 188
 189
 190 __END__