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