1 package FileUtil; 2 # 3 # $RCSfile: FileUtil.pm,v $ 4 # $Date: 2011/12/16 00:04:11 $ 5 # $Revision: 1.34 $ 6 # 7 # Author: Manish Sud <msud@san.rr.com> 8 # 9 # Copyright (C) 2004-2012 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 # 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 my($MayaChemToolsLibDir); 289 290 $MayaChemToolsLibDir = ""; 291 if ($INC[0] =~ /MayaChemTools/i) { 292 $MayaChemToolsLibDir = $INC[0]; 293 } 294 else { 295 # Go through rest of the entries... 296 my($Index); 297 INDEX: for $Index (1 .. $#INC) { 298 if ($INC[$Index] =~ /MayaChemTools/i) { 299 $MayaChemToolsLibDir = $INC[$Index]; 300 last INDEX; 301 } 302 } 303 if (!$MayaChemToolsLibDir) { 304 carp "Warning: MayaChemTools lib directory location doesn't appear to exist in library search path specified by \@INC ..."; 305 } 306 } 307 return $MayaChemToolsLibDir; 308 } 309 310 # Get Usage from Pod... 311 sub GetUsageFromPod { 312 my($Usage, $ScriptPath); 313 314 ($ScriptPath) = @_; 315 $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"; 316 317 # Get pod documentation: try pod2text first followed by perdoc.bat in case it fails to 318 # to handle ActiveState Perl... 319 my($PodStatus); 320 $PodStatus = (open CMD, "pod2text $ScriptPath|") ? 1 : ((open CMD, "pod2text.bat $ScriptPath|") ? 1 : 0); 321 if (!$PodStatus) { 322 # Try direct invocation of Pod::Text before giving up... 323 my($PodTextCmd); 324 $PodTextCmd = "perl -e \'use Pod::Text (); \$TextFormatter = Pod::Text->new(); \$TextFormatter->parse_from_file(\"$ScriptPath\");\'"; 325 $PodStatus = (open CMD, "$PodTextCmd|") ? 1 : 0; 326 if (!$PodStatus) { 327 return $Usage; 328 } 329 } 330 my($ProcessingSection, $InParametersSection, $InOptionsSection, @LineWords); 331 $ProcessingSection = 0; $InParametersSection = 0; $InOptionsSection = 0; 332 PODLINE: while (<CMD>) { 333 if (/^SYNOPSIS/) { 334 $_ = <CMD>; chomp; s/^ +//g; 335 (@LineWords) = split / /; 336 $Usage = qq(Usage: $LineWords[0] [-options]... ); 337 shift @LineWords; 338 $Usage .= join(" ", @LineWords) . "\n"; 339 } 340 elsif (/^(DESCRIPTION|PARAMETERS|OPTIONS|EXAMPLES|AUTHOR|SEE ALSO|COPYRIGHT)/i) { 341 # Various sections... 342 chomp; 343 $Usage .= ucfirst(lc($_)) . ":\n"; 344 $ProcessingSection = 1; 345 $InOptionsSection = /^OPTIONS/ ? 1 : 0; 346 $InParametersSection = /^PARAMETERS/ ? 1 : 0; 347 } 348 elsif ($InParametersSection|$InOptionsSection) { 349 if (/^[ ]+\-/ || /^[ ]{4,4}/) { 350 # Start of option line: any number of spaces followed by - sign. 351 # Put back in <> which pod2text replaced to ** 352 my($OptionLine) = qq($_); 353 OPTIONLINE: while (<CMD>) { 354 if (/^( )/) { 355 $OptionLine .= qq($_); 356 } 357 else { 358 $OptionLine =~ s/\*(([a-zA-Z0-9])|(\[)|(\#)|(\"))/"\<" . substr($&, -1, 1)/e; 359 $OptionLine =~ s/(([a-zA-Z0-9])|(\])|(\#)|(\"))\*/substr($&, 0, 1) . "\>"/e; 360 $Usage .= qq($OptionLine$_); 361 last OPTIONLINE; 362 } 363 } 364 } 365 } 366 else { 367 if ($ProcessingSection) { $Usage .= qq($_); } 368 } 369 } 370 close CMD; 371 372 # Take out **which pod2text puts in for <> 373 $Usage =~ s/\*(([a-zA-Z0-9;#-])|(\")|(\()|(\[)|(\.))/substr($&, -1, 1)/eg; 374 $Usage =~ s/(([a-zA-Z0-9;#-])|(\")|(\))|(\])|(\.))\*/substr($&, 0, 1)/eg; 375 376 return $Usage; 377 } 378 379 # Split full file name into directory path, file name, and the extension. 380 sub ParseFileName { 381 my($FullName) = @_; 382 my($FileDir, $FileName, $FileExt, @FullFileNameParts, @FileNameParts, $Delimiter); 383 384 $Delimiter = "\/"; 385 if ($FullName =~ /\\/ ) { 386 $Delimiter = "\\"; 387 $FullName =~ s/\\/\//g; 388 } 389 $FileDir = ""; $FileName = ""; $FileExt = ""; 390 @FullFileNameParts = (); @FileNameParts = (); 391 392 @FullFileNameParts = split "\/", $FullName; 393 @FileNameParts = split /\./, $FullFileNameParts[$#FullFileNameParts]; 394 395 # Setup file dir... 396 if (@FullFileNameParts == 1) { 397 $FileDir = "\."; 398 } 399 else { 400 pop @FullFileNameParts; 401 $FileDir = join $Delimiter, @FullFileNameParts; 402 } 403 404 # Setup file name and ext... 405 if (@FileNameParts == 1) { 406 $FileName = $FileNameParts[0]; 407 $FileExt = ""; 408 } 409 elsif (@FileNameParts == 2) { 410 $FileName = $FileNameParts[0]; 411 $FileExt = $FileNameParts[1]; 412 } 413 elsif (@FileNameParts > 2) { 414 # Use the last entry as file extension and the rest for file name... 415 $FileExt = $FileNameParts[$#FileNameParts]; 416 pop @FileNameParts; 417 $FileName = join '.', @FileNameParts; 418 } 419 return ($FileDir, $FileName, $FileExt); 420 } 421