1 package FileUtil; 2 # 3 # $RCSfile: FileUtil.pm,v $ 4 # $Date: 2008/04/25 00:00:45 $ 5 # $Revision: 1.24 $ 6 # 7 # Author: Manish Sud <msud@san.rr.com> 8 # 9 # Copyright (C) 2004-2008 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 use 5.006; 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($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); 37 38 $VERSION = '1.00'; 39 @ISA = qw(Exporter); 40 @EXPORT = qw(CheckFileType ConvertCygwinPath ExpandFileNames FileModificationTimeAndDate FormattedFileModificationTimeAndDate FileSize FormatFileSize GetMayaChemToolsLibDirName GetUsageFromPod ParseFileName); 41 @EXPORT_OK = qw(); 42 %EXPORT_TAGS = (all => [@EXPORT, @EXPORT_OK]); 43 44 # Check to see path contains cygdrive and convert it into windows path... 45 sub ConvertCygwinPath { 46 my($Path) = @_; 47 my($NewPath, $OSName); 48 49 $NewPath = $Path; $OSName = $^O; 50 if ($OSName =~ /cygwin/i && $Path =~ /cygdrive/i ) { 51 my(@PathParts) = split "\/", $Path; 52 my($Drive) = $PathParts[2]; 53 shift @PathParts; shift @PathParts; shift @PathParts; 54 $NewPath = join "\/", @PathParts; 55 $NewPath = $Drive. ":\/" . $NewPath; 56 } 57 return $NewPath; 58 } 59 60 # Based on the file name extension, figure out its type. 61 sub CheckFileType { 62 my($FileName, $FileExts) = @_; 63 my($Status, @FileExtsList, $Index, $Ext); 64 65 $Status = 0; 66 @FileExtsList = split " ", $FileExts; 67 for $Index (0 .. $#FileExtsList) { 68 $Ext = $FileExtsList[$Index]; 69 if ($FileName =~ /(\.$Ext)$/i) { 70 $Status = 1; 71 } 72 } 73 return ($Status); 74 } 75 76 # For any directory name specified in Files array reference parameter, generate 77 # all files names in that directory which correspond to the extensions specified. 78 # And combine them with rest of the names. Return the expanded list. 79 sub ExpandFileNames { 80 my($Files, $FileExts) = @_; 81 my($FileName, @FilesList, $Index, $Delimiter); 82 83 for ($Index = 0; $Index < @$Files; $Index++) { 84 $FileName = @$Files[$Index]; 85 $Delimiter = "\/"; 86 if ($FileName =~ /\\/ ) { 87 $Delimiter = "\\"; 88 } 89 if (-d $FileName && $FileExts) { 90 my($DirName) = $FileName; 91 # glob doesn't appear to work during command line invocation from Windows... 92 # So, use opendir to make it work... 93 # 94 # push @FilesList, map {glob("$DirName/*.$_")} split " ", $FileExts; 95 if (opendir DIRNAME, $DirName) { 96 # Collect files with specified file extensions... 97 my($FileExtsPattern) = join "|", map { "\.$_" } split " ", $FileExts; 98 push @FilesList, grep /$FileExtsPattern/, map { "$DirName$Delimiter$_" } readdir DIRNAME; 99 closedir DIRNAME; 100 } 101 else { 102 carp "Warning: Ignoring directory $DirName: Couldn't open it: $! ..."; 103 } 104 } 105 elsif ($FileName =~ /\*/) { 106 # Filenames are not expanded during command line invocation from Windows... 107 my($FileDir, $Name, $FileExt) = ParseFileName($FileName); 108 if (opendir FILEDIR, $FileDir) { 109 if (length($Name) == 1) { 110 push @FilesList, grep /\.$FileExt/, map { "$FileDir$Delimiter$_" } readdir FILEDIR; 111 } 112 else { 113 push @FilesList, grep /\.$FileExt/, grep /$Name/, map { "$FileDir$Delimiter$_" } readdir FILEDIR; 114 } 115 closedir FILEDIR; 116 } 117 else { 118 carp "Warning: Ignoring files $FileName: Couldn't open directory $FileDir: $! ..."; 119 } 120 } 121 else { 122 push @FilesList, $FileName; 123 } 124 } 125 return @FilesList; 126 } 127 128 # Formatted file modification time... 129 sub FormattedFileModificationTimeAndDate { 130 my($FileName) = @_; 131 my($TimeString, $DateString) = ('') x 2; 132 133 if (! -e $FileName) { 134 return ($TimeString, $DateString); 135 } 136 my($Hours, $Mins, $Secs, $DayName, $MonthName, $Month, $Year) = FileModificationTimeAndDate($FileName); 137 138 # Setup time suffix... 139 my($TimeSuffix) = ''; 140 if ($Hours < 12) { 141 $TimeSuffix = 'AM'; 142 } 143 elsif ($Hours > 12) { 144 $TimeSuffix = 'PM'; 145 $Hours = $Hours - 12; 146 } 147 elsif ($Hours == 12 && ($Mins > 0 || $Secs > 0)) { 148 $TimeSuffix = 'PM'; 149 } 150 elsif ($Hours == 12 && $Mins == 0 && $Secs == 0) { 151 $TimeSuffix = 'Noon'; 152 } 153 154 $Month = TextUtil::AddNumberSuffix($Month); 155 156 $TimeString = "${DayName} ${Hours}:${Mins}:${Secs} ${TimeSuffix}"; 157 $DateString = "${MonthName} ${Month}, ${Year}"; 158 159 return ($TimeString, $DateString); 160 } 161 162 # File modifcation time and date... 163 sub FileModificationTimeAndDate { 164 my($FileName) = @_; 165 my($Hours, $Mins, $Secs, $DayName, $MonthName, $Month, $Year) = ('') x 7; 166 167 if (! -e $FileName) { 168 return ($Hours, $Mins, $Secs, $DayName, $MonthName, $Month, $Year); 169 } 170 171 my($CTimeString, $FileStatRef, $TimeStamp); 172 $FileStatRef = stat($FileName); 173 174 $CTimeString = Time::localtime::ctime($FileStatRef->mtime); 175 176 # ctime returns: Thu Aug 3 10:13:53 2006 177 ($DayName, $MonthName, $Month, $TimeStamp, $Year) = split /[ ]+/, $CTimeString; 178 ($Hours, $Mins, $Secs) = split /\:/, $TimeStamp; 179 180 return ($Hours, $Mins, $Secs, $DayName, $MonthName, $Month, $Year); 181 } 182 183 # Format file size... 184 sub FormatFileSize { 185 my($Precision, $Size); 186 187 $Precision = 1; 188 if (@_ == 2) { 189 ($Size, $Precision) = @_; 190 } 191 else { 192 ($Size) = @_; 193 } 194 my($SizeDenominator, $SizeSuffix); 195 FORMAT: { 196 if ($Size < 1024) { $SizeDenominator = 1; $SizeSuffix = 'bytes'; last FORMAT;} 197 if ($Size < (1024*1024)) { $SizeDenominator = 1024; $SizeSuffix = 'KB'; last FORMAT;} 198 if ($Size < (1024*1024*1024)) { $SizeDenominator = 1024*1024; $SizeSuffix = 'MB'; last FORMAT;} 199 if ($Size < (1024*1024*1024*1024)) { $SizeDenominator = 1024*1024*1024; $SizeSuffix = 'GB'; last FORMAT;} 200 $SizeDenominator = 1; $SizeSuffix = 'bytes'; 201 } 202 $Size /= $SizeDenominator; 203 $Size = sprintf("%.${Precision}f", $Size) + 0; 204 $Size = "$Size $SizeSuffix"; 205 206 return $Size; 207 } 208 209 # Get file size in bytes... 210 sub FileSize { 211 my($File) = @_; 212 213 if (! -e $File) { 214 return undef; 215 } 216 return (-s $File) 217 } 218 219 # Get MayaChemTool's lib directory name using @INC to extract 220 # <MAYACHEMTOOLS>/lib directory location: first entry in @INC path should contain 221 # MayaChemTools modules location 222 # 223 sub GetMayaChemToolsLibDirName { 224 my($MayaChemToolsLibDir); 225 226 $MayaChemToolsLibDir = ""; 227 if ($INC[0] =~ /MayaChemTools/i) { 228 $MayaChemToolsLibDir = $INC[0]; 229 } 230 else { 231 # Go through rest of the entries... 232 my($Index); 233 INDEX: for $Index (1 .. $#INC) { 234 if ($INC[$Index] =~ /MayaChemTools/i) { 235 $MayaChemToolsLibDir = $INC[$Index]; 236 last INDEX; 237 } 238 } 239 if (!$MayaChemToolsLibDir) { 240 carp "Warning: MayaChemTools lib directory location doesn't appear to exist in library search path specified by \@INC ..."; 241 } 242 } 243 return $MayaChemToolsLibDir; 244 } 245 246 # Get Usage from Pod... 247 sub GetUsageFromPod { 248 my($Usage, $ScriptPath); 249 250 ($ScriptPath) = @_; 251 $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"; 252 253 # Get pod documentation: try pod2text first followed by perdoc.bat in case it fails to 254 # to handle ActiveState Perl... 255 my($PodStatus); 256 $PodStatus = (open CMD, "pod2text $ScriptPath|") ? 1 : ((open CMD, "pod2text.bat $ScriptPath|") ? 1 : 0); 257 if (!$PodStatus) { 258 # Try direct invocation of Pod::Text before giving up... 259 my($PodTextCmd); 260 $PodTextCmd = "perl -e \'use Pod::Text (); \$TextFormatter = Pod::Text->new(); \$TextFormatter->parse_from_file(\"$ScriptPath\");\'"; 261 $PodStatus = (open CMD, "$PodTextCmd|") ? 1 : 0; 262 if (!$PodStatus) { 263 return $Usage; 264 } 265 } 266 my($ProcessingSection, $InParametersSection, $InOptionsSection, @LineWords); 267 $ProcessingSection = 0; $InParametersSection = 0; $InOptionsSection = 0; 268 PODLINE: while (<CMD>) { 269 if (/^SYNOPSIS/) { 270 $_ = <CMD>; chomp; s/^ +//g; 271 (@LineWords) = split / /; 272 $Usage = qq(Usage: $LineWords[0] [-options]... ); 273 shift @LineWords; 274 $Usage .= join(" ", @LineWords) . "\n"; 275 } 276 elsif (/^(DESCRIPTION|PARAMETERS|OPTIONS|EXAMPLES|AUTHOR|SEE ALSO|COPYRIGHT)/i) { 277 # Various sections... 278 chomp; 279 $Usage .= ucfirst(lc($_)) . ":\n"; 280 $ProcessingSection = 1; 281 $InOptionsSection = /^OPTIONS/ ? 1 : 0; 282 $InParametersSection = /^PARAMETERS/ ? 1 : 0; 283 } 284 elsif ($InParametersSection|$InOptionsSection) { 285 if (/^[ ]+\-/ || /^[ ]{4,4}/) { 286 # Start of option line: any number of spaces followed by - sign. 287 # Put back in <> which pod2text replaced to ** 288 my($OptionLine) = qq($_); 289 OPTIONLINE: while (<CMD>) { 290 if (/^( )/) { 291 $OptionLine .= qq($_); 292 } 293 else { 294 $OptionLine =~ s/\*(([a-zA-Z0-9])|(\[)|(\#)|(\"))/"\<" . substr($&, -1, 1)/e; 295 $OptionLine =~ s/(([a-zA-Z0-9])|(\])|(\#)|(\"))\*/substr($&, 0, 1) . "\>"/e; 296 $Usage .= qq($OptionLine$_); 297 last OPTIONLINE; 298 } 299 } 300 } 301 } 302 else { 303 if ($ProcessingSection) { $Usage .= qq($_); } 304 } 305 } 306 close CMD; 307 308 # Take out **which pod2text puts in for <> 309 $Usage =~ s/\*(([a-zA-Z0-9;#-])|(\")|(\()|(\[)|(\.))/substr($&, -1, 1)/eg; 310 $Usage =~ s/(([a-zA-Z0-9;#-])|(\")|(\))|(\])|(\.))\*/substr($&, 0, 1)/eg; 311 312 return $Usage; 313 } 314 315 # Split full file name into directory path, file name, and the extension. 316 sub ParseFileName { 317 my($FullName) = @_; 318 my($FileDir, $FileName, $FileExt, @FullFileNameParts, @FileNameParts, $Delimiter); 319 320 $Delimiter = "\/"; 321 if ($FullName =~ /\\/ ) { 322 $Delimiter = "\\"; 323 $FullName =~ s/\\/\//g; 324 } 325 $FileDir = ""; $FileName = ""; $FileExt = ""; 326 @FullFileNameParts = (); @FileNameParts = (); 327 328 @FullFileNameParts = split "\/", $FullName; 329 @FileNameParts = split /\./, $FullFileNameParts[$#FullFileNameParts]; 330 331 # Setup file dir... 332 if (@FileNameParts == 1) { 333 $FileDir = $FullName; 334 } 335 else { 336 if (@FullFileNameParts == 1) { 337 $FileDir = "\.$Delimiter"; 338 } 339 else { 340 pop @FullFileNameParts; 341 $FileDir = join $Delimiter, @FullFileNameParts; 342 } 343 } 344 345 # Setup file name and ext... 346 if (@FileNameParts == 2) { 347 $FileName = $FileNameParts[0]; 348 $FileExt = $FileNameParts[1]; 349 } 350 elsif (@FileNameParts > 2) { 351 # Use the last entry as file extension and the rest for file name... 352 $FileExt = $FileNameParts[$#FileNameParts]; 353 pop @FileNameParts; 354 $FileName = join '.', @FileNameParts; 355 } 356 return ($FileDir, $FileName, $FileExt); 357 } 358
