1 package FileUtil; 2 # 3 # File: FileUtil.pm 4 # Author: Manish Sud <msud@san.rr.com> 5 # 6 # Copyright (C) 2025 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