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