       1 package FileUtil;
       2 #
       3 # $RCSfile: FileUtil.pm,v $
       4 # $Date: 2015/02/28 20:47:17 $
       5 # $Revision: 1.40 $
       6 #
       7 # Author: Manish Sud <msud@san.rr.com>
       8 #
       9 # Copyright (C) 2015 Manish Sud. All rights reserved.
      10 #
      11 # This file is part of MayaChemTools.
      12 #
      13 # MayaChemTools is free software; you can redistribute it and/or modify it under
      14 # the terms of the GNU Lesser General Public License as published by the Free
      15 # Software Foundation; either version 3 of the License, or (at your option) any
      16 # later version.
      17 #
      18 # MayaChemTools is distributed in the hope that it will be useful, but without
      19 # any warranty; without even the implied warranty of merchantability of fitness
      20 # for a particular purpose.  See the GNU Lesser General Public License for more
      21 # details.
      22 #
      23 # You should have received a copy of the GNU Lesser General Public License
      24 # along with MayaChemTools; if not, see <http://www.gnu.org/licenses/> or
      25 # write to the Free Software Foundation Inc., 59 Temple Place, Suite 330,
      26 # Boston, MA, 02111-1307, USA.
      27 #
      28
      29 use strict;
      30 use Exporter;
      31 use Carp;
      32 use File::stat;
      33 use Time::localtime ();
      34 use TextUtil ();
      35
      36 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
      37
      38 @ISA = qw(Exporter);
      39 @EXPORT = qw(CheckFileType ConvertCygwinPath ExpandFileNames FileModificationTimeAndDate FormattedFileModificationTimeAndDate FileSize FormatFileSize GetMayaChemToolsLibDirName GetUsageFromPod ParseFileName);
      40 @EXPORT_OK = qw();
      41 %EXPORT_TAGS = (all  => [@EXPORT, @EXPORT_OK]);
      42
      43 # Setup package variables...
      44 my($MayaChemToolsLibDir);
      45
      46 # Check to see path contains cygdrive and convert it into windows path...
      47 sub ConvertCygwinPath {
      48   my($Path) = @_;
      49   my($NewPath, $OSName);
      50
      51   $NewPath = $Path; $OSName = $^O;
      52   if ($OSName =~ /cygwin/i && $Path =~ /cygdrive/i ) {
      53     my(@PathParts) = split "\/", $Path;
      54     my($Drive) = $PathParts[2];
      55     shift @PathParts; shift @PathParts; shift @PathParts;
      56     $NewPath = join "\/", @PathParts;
      57     $NewPath = $Drive. ":\/" . $NewPath;
      58   }
      59   return $NewPath;
      60 }
      61
      62 # Based on the file name extension, figure out its type.
      63 sub CheckFileType {
      64   my($FileName, $FileExts) = @_;
      65   my($Status, @FileExtsList, $Index, $Ext);
      66
      67   $Status = 0;
      68   @FileExtsList = split " ", $FileExts;
      69   for $Index (0 .. $#FileExtsList) {
      70     $Ext = $FileExtsList[$Index];
      71     if ($FileName =~ /(\.$Ext)$/i) {
      72       $Status = 1;
      73     }
      74   }
      75   return ($Status);
      76 }
      77
      78 # Expand file names using specified directory and/or file names along with any
      79 # file extensions containing one or more wild cards. And return the expanded
      80 # list.
      81 #
      82 # IncludeDirName controls whether directory prefixes are included in expanded
      83 # file names. Default is to always append directory name before expanded file
      84 # name.
      85 #
      86 # Notes:
      87 #   . Multiple file extensions are delimited by spaces.
      88 #   . Wild card, *, is supported in directory and file names along with file
      89 #     extensions.
      90 #   . For a specified directory name in the files list, all the files in the
      91 #     directory are retrieved using Perl opendir function and files filtered using file
      92 #     extensions. The file names "." and ".." returned by opendir are ignored.
      93 #   . For file names containing wild cards with and without any explicit file
      94 #     extension specification in the file name, all the files in the directory are retrieved
      95 #     using Perl opendir function and files filtered using file name along with any
      96 #     file extension. The file names "." and ".." returned by opendir are ignored.
      97 #
      98 sub ExpandFileNames {
      99   my($Files, $FileExts, $IncludeDirName) = @_;
     100   my($FileName, $Index, $Delimiter, $FileExtsPattern, @FilesList, @DirFileNames);
     101
     102   # Check whether to include directory name in expanded file names...
     103   $IncludeDirName = defined $IncludeDirName ? $IncludeDirName : 1;
     104
     105   # Setup file externsions...
     106   $FileExtsPattern = "";
     107   if ($FileExts) {
     108     $FileExtsPattern = join "|", split " ", $FileExts;
     109     if ($FileExtsPattern =~ /\*/) {
     110       # Replace * by .*? for greedy match...
     111       $FileExtsPattern =~ s/\*/\.\*\?/g;
     112     }
     113   }
     114
     115   @FilesList = ();
     116
     117   FILEINDEX: for ($Index = 0; $Index < @$Files; $Index++) {
     118     $FileName = @$Files[$Index];
     119     $Delimiter = "\/";
     120     if ($FileName =~ /\\/ ) {
     121       $Delimiter = "\\";
     122     }
     123
     124     if (-d $FileName) {
     125       my($DirName, $DirNamePrefix);
     126
     127       $DirName = $FileName;
     128       $DirNamePrefix = $IncludeDirName ? "$DirName$Delimiter" : "";
     129
     130       # glob doesn't appear to work during command line invocation from Windows.
     131       # So, use opendir to make it work...
     132       #
     133       # push @FilesList,  map {glob("$DirName/*.$_")} split " ", $FileExts;
     134       #
     135       @DirFileNames = ();
     136       if (!opendir DIRNAME, $DirName) {
     137         carp "Warning: Ignoring directory $DirName: Couldn't open it: $! ...";
     138         next FILEINDEX;
     139       }
     140
     141       # Collect file names without '.' and '..' as readdir function places them on the list...
     142       #
     143       @DirFileNames = map { "$DirNamePrefix$_"  } grep { !/^(\.|\.\.)$/ } readdir DIRNAME;
     144       closedir DIRNAME;
     145
     146       # Collect files with any specified file extensions...
     147       if ($FileExtsPattern) {
     148         @DirFileNames = grep { /\.$FileExtsPattern$/ } @DirFileNames;
     149       }
     150
     151       push @FilesList, @DirFileNames;
     152     }
     153     elsif ($FileName =~ /\*/) {
     154       my($FileDir, $Name, $FileExt, $DirNamePrefix);
     155
     156       # Filenames are not expanded during command line invocation from Windows...
     157       ($FileDir, $Name, $FileExt) = ParseFileName($FileName);
     158
     159       $DirNamePrefix = $IncludeDirName ? "$FileDir$Delimiter" : "";
     160
     161       @DirFileNames = ();
     162       if (!opendir FILEDIR, $FileDir) {
     163         carp "Warning: Ignoring files $FileName: Couldn't open directory $FileDir: $! ...";
     164         next FILEINDEX;
     165       }
     166
     167       # Collect file names without '.' and '..' as readdir function places them on the list...
     168       #
     169       @DirFileNames = map { "$DirNamePrefix$_"  } grep { !/^(\.|\.\.)$/ } readdir FILEDIR;
     170       closedir FILEDIR;
     171
     172       if (length($Name) > 1) {
     173         # Replace * by .*? for greedy match...
     174         $Name =~ s/\*/\.\*\?/g;
     175         @DirFileNames =  grep { /$Name/ } @DirFileNames;
     176       }
     177
     178       if ($FileExt) {
     179         $FileExt =~ s/\*/\.\*\?/g;
     180         @DirFileNames =  grep { /\.$FileExt$/ } @DirFileNames;
     181       }
     182       elsif ($FileExtsPattern) {
     183         @DirFileNames = grep { /\.$FileExtsPattern$/ } @DirFileNames;
     184       }
     185
     186       push @FilesList, @DirFileNames;
     187     }
     188     else {
     189       push @FilesList, $FileName;
     190     }
     191   }
     192   return @FilesList;
     193 }
     194
     195 # Formatted file modification time...
     196 sub FormattedFileModificationTimeAndDate {
     197   my($FileName) = @_;
     198   my($TimeString, $DateString) = ('') x 2;
     199
     200   if (! -e $FileName) {
     201     return ($TimeString, $DateString);
     202   }
     203   my($Hours, $Mins, $Secs, $DayName, $MonthName, $Month, $Year) = FileModificationTimeAndDate($FileName);
     204
     205   # Setup time suffix...
     206   my($TimeSuffix) = '';
     207   if ($Hours < 12) {
     208     $TimeSuffix = 'AM';
     209   }
     210   elsif ($Hours > 12) {
     211     $TimeSuffix = 'PM';
     212     $Hours = $Hours - 12;
     213   }
     214   elsif ($Hours == 12 && ($Mins > 0 || $Secs > 0)) {
     215     $TimeSuffix = 'PM';
     216   }
     217   elsif ($Hours == 12 && $Mins == 0 && $Secs == 0) {
     218     $TimeSuffix = 'Noon';
     219   }
     220
     221   $Month = TextUtil::AddNumberSuffix($Month);
     222
     223   $TimeString = "${DayName} ${Hours}:${Mins}:${Secs} ${TimeSuffix}";
     224   $DateString = "${MonthName} ${Month}, ${Year}";
     225
     226   return ($TimeString, $DateString);
     227 }
     228
     229 # File modifcation time and date...
     230 sub FileModificationTimeAndDate {
     231   my($FileName) = @_;
     232   my($Hours, $Mins, $Secs, $DayName, $MonthName, $Month, $Year) = ('') x 7;
     233
     234   if (! -e $FileName) {
     235     return ($Hours, $Mins, $Secs, $DayName, $MonthName, $Month, $Year);
     236   }
     237
     238   my($CTimeString, $FileStatRef, $TimeStamp);
     239   $FileStatRef = stat($FileName);
     240
     241   $CTimeString = Time::localtime::ctime($FileStatRef->mtime);
     242
     243   # ctime returns: Thu Aug 3 10:13:53 2006
     244   ($DayName, $MonthName, $Month, $TimeStamp, $Year) = split /[ ]+/, $CTimeString;
     245   ($Hours, $Mins, $Secs) = split /\:/, $TimeStamp;
     246
     247   return ($Hours, $Mins, $Secs, $DayName, $MonthName, $Month, $Year);
     248 }
     249
     250 # Format file size...
     251 sub FormatFileSize {
     252   my($Precision, $Size);
     253
     254   $Precision = 1;
     255   if (@_ == 2) {
     256     ($Size, $Precision) = @_;
     257   }
     258   else {
     259     ($Size) = @_;
     260   }
     261   my($SizeDenominator, $SizeSuffix);
     262   FORMAT: {
     263       if ($Size < 1024) { $SizeDenominator = 1; $SizeSuffix = 'bytes'; last FORMAT;}
     264       if ($Size < (1024*1024)) { $SizeDenominator = 1024; $SizeSuffix = 'KB'; last FORMAT;}
     265       if ($Size < (1024*1024*1024)) { $SizeDenominator = 1024*1024; $SizeSuffix = 'MB'; last FORMAT;}
     266       if ($Size < (1024*1024*1024*1024)) { $SizeDenominator = 1024*1024*1024; $SizeSuffix = 'GB'; last FORMAT;}
     267       $SizeDenominator = 1; $SizeSuffix = 'bytes';
     268     }
     269   $Size /= $SizeDenominator;
     270   $Size = sprintf("%.${Precision}f", $Size) + 0;
     271   $Size = "$Size $SizeSuffix";
     272
     273   return $Size;
     274 }
     275
     276 # Get file size in bytes...
     277 sub FileSize {
     278   my($File) = @_;
     279
     280   if (! -e $File) {
     281     return undef;
     282   }
     283   return (-s $File)
     284 }
     285
     286 # Get MayaChemTool's lib directory name using @INC to extract
     287 # <MAYACHEMTOOLS>/lib directory location: first entry in @INC path should contain
     288 # MayaChemTools modules location
     289 #
     290 sub GetMayaChemToolsLibDirName {
     291
     292   if (defined $MayaChemToolsLibDir) {
     293     return $MayaChemToolsLibDir;
     294   }
     295
     296   $MayaChemToolsLibDir = "";
     297   if ($INC[0] =~ /MayaChemTools/i) {
     298     $MayaChemToolsLibDir = $INC[0];
     299   }
     300   else {
     301     # Go through rest of the entries...
     302     my($Index);
     303     INDEX: for $Index (1 .. $#INC) {
     304       if ($INC[$Index] =~ /MayaChemTools/i) {
     305         $MayaChemToolsLibDir = $INC[$Index];
     306         last INDEX;
     307       }
     308     }
     309     if (!$MayaChemToolsLibDir) {
     310       carp "Warning: MayaChemTools lib directory location doesn't appear to exist in library search path specified by \@INC ...";
     311     }
     312   }
     313   return $MayaChemToolsLibDir;
     314 }
     315
     316 # Get Usage from Pod...
     317 sub GetUsageFromPod {
     318   my($Usage, $ScriptPath);
     319
     320   ($ScriptPath) = @_;
     321   $Usage = "Script usage not available: pod2text or pod2text.bat doesn't exist in your Perl installation and direct invocation of Pod::Text also failed\n";
     322
     323   # Get pod documentation: try pod2text first followed by perdoc.bat in case it fails to
     324   # to handle ActiveState Perl...
     325   my($PodStatus);
     326   $PodStatus = (open CMD, "pod2text $ScriptPath|") ? 1 : ((open CMD, "pod2text.bat $ScriptPath|") ? 1 : 0);
     327   if (!$PodStatus) {
     328     # Try direct invocation of Pod::Text before giving up...
     329     my($PodTextCmd);
     330     $PodTextCmd = "perl -e \'use Pod::Text (); \$TextFormatter = Pod::Text->new(); \$TextFormatter->parse_from_file(\"$ScriptPath\");\'";
     331     $PodStatus = (open CMD, "$PodTextCmd|") ? 1 : 0;
     332     if (!$PodStatus) {
     333       return $Usage;
     334     }
     335   }
     336   my($ProcessingSection, $InParametersSection, $InOptionsSection, @LineWords);
     337   $ProcessingSection = 0; $InParametersSection = 0; $InOptionsSection = 0;
     338   PODLINE: while (<CMD>) {
     339     if (/^SYNOPSIS/) {
     340       $_ = <CMD>; chomp; s/^ +//g;
     341       (@LineWords) = split / /;
     342       $Usage = qq(Usage: $LineWords[0] [-options]... );
     343       shift @LineWords;
     344       $Usage .= join(" ", @LineWords) . "\n";
     345     }
     346     elsif (/^(DESCRIPTION|PARAMETERS|OPTIONS|EXAMPLES|AUTHOR|SEE ALSO|COPYRIGHT)/i) {
     347       # Various sections...
     348       chomp;
     349       $Usage .= ucfirst(lc($_)) . ":\n";
     350       $ProcessingSection = 1;
     351       $InOptionsSection = /^OPTIONS/ ? 1 : 0;
     352       $InParametersSection = /^PARAMETERS/ ? 1 : 0;
     353     }
     354     elsif ($InParametersSection|$InOptionsSection) {
     355       if (/^[ ]+\-/ || /^[ ]{4,4}/) {
     356         # Start of option line: any number of spaces followed by - sign.
     357         # Put back in <> which pod2text replaced to **
     358         my($OptionLine) = qq($_);
     359            OPTIONLINE: while (<CMD>) {
     360           if (/^(    )/) {
     361             $OptionLine .= qq($_);
     362           }
     363           else {
     364             $OptionLine =~ s/\*(([a-zA-Z0-9])|(\[)|(\#)|(\"))/"\<" . substr($&, -1, 1)/e;
     365             $OptionLine =~ s/(([a-zA-Z0-9])|(\])|(\#)|(\"))\*/substr($&, 0, 1) . "\>"/e;
     366             $Usage .= qq($OptionLine$_);
     367             last OPTIONLINE;
     368           }
     369         }
     370       }
     371     }
     372     else {
     373       if ($ProcessingSection) { $Usage .= qq($_); }
     374     }
     375   }
     376   close CMD;
     377
     378   # Take out **which pod2text puts in for <>
     379   $Usage =~ s/\*(([a-zA-Z0-9;#-])|(\")|(\()|(\[)|(\.))/substr($&, -1, 1)/eg;
     380   $Usage =~ s/(([a-zA-Z0-9;#-])|(\")|(\))|(\])|(\.))\*/substr($&, 0, 1)/eg;
     381
     382   return $Usage;
     383 }
     384
     385 # Split full file name into directory path, file name, and the extension.
     386 sub ParseFileName {
     387   my($FullName) = @_;
     388   my($FileDir, $FileName, $FileExt, @FullFileNameParts, @FileNameParts, $Delimiter);
     389
     390   $Delimiter = "\/";
     391   if ($FullName =~ /\\/ ) {
     392     $Delimiter = "\\";
     393     $FullName =~ s/\\/\//g;
     394   }
     395   $FileDir = ""; $FileName = ""; $FileExt = "";
     396   @FullFileNameParts = (); @FileNameParts = ();
     397
     398   @FullFileNameParts = split "\/", $FullName;
     399   @FileNameParts = split /\./, $FullFileNameParts[$#FullFileNameParts];
     400
     401   # Setup file dir...
     402   if (@FullFileNameParts == 1) {
     403     $FileDir = "\.";
     404   }
     405   else {
     406     pop @FullFileNameParts;
     407     $FileDir = join $Delimiter, @FullFileNameParts;
     408   }
     409
     410   # Setup file name and ext...
     411   if (@FileNameParts == 1) {
     412     $FileName = $FileNameParts[0];
     413     $FileExt = "";
     414   }
     415   elsif (@FileNameParts == 2) {
     416     $FileName = $FileNameParts[0];
     417     $FileExt = $FileNameParts[1];
     418   }
     419   elsif (@FileNameParts > 2) {
     420     # Use the last entry as file extension and the rest for file name...
     421     $FileExt = $FileNameParts[$#FileNameParts];
     422     pop @FileNameParts;
     423     $FileName = join '.', @FileNameParts;
     424   }
     425   return ($FileDir, $FileName, $FileExt);
     426 }
     427