MayaChemTools

   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