ShortenFiles.pl
上传用户:zhuqijet
上传日期:2013-06-25
资源大小:10074k
文件大小:6k
- #!/usr/bin/perl
- #
- # ShortenFiles.pl
- #
- # Shorten file names to fit Mac HFS 31 character name limit. Names
- # are shortened using a table of hints.
- #
- #
- # $Log: ShortenFiles.pl,v $
- # Revision 1.6 2001/10/19 20:55:41 jberry
- # Add new file name shortening hints; chmod +x
- #
- # Revision 1.5 2001/06/10 19:37:40 jberry
- # Neaten formatting of output.
- #
- # Revision 1.4 2000/09/06 21:55:40 jberry
- # Allow ShortenFiles to work even when the destination directory already exists
- #
- #
- use Config;
- use FindBin;
- use File::Find;
- use File::Path;
- # Constants
- $kMaxLength = 31;
- # Globals
- $gScriptBase = $FindBin::RealBin;
- $gPathSep = GetPathSeparator();
- $gSrcBase = $gScriptBase.$gPathSep."src";
- $gDstBase = $gScriptBase.$gPathSep."MacSrc";
- # Map from unshortened to shortened name
- %gBadMap;
- # Hints for shortening names.
- # Hints are considered in order of occurance in list
- # until the name is adaquately shortened or there
- # are no more hints, in which case the name is
- # more rudely truncated.
- @gHints =
- (
- ["Exception", "Except" ],
- ["Implementation", "Impl" ],
- ["Reference", "Ref" ],
- ["Documentation", "Doc" ],
- ["Document", "Doc" ],
- ["Definition", "Def" ],
- ["Count", "Cnt" ],
- ["Entity", "Ent" ],
- ["Character", "Char" ],
- ["Processing", "Proc" ],
- ["Instruction", "Instr" ],
- ["Parent", "Par" ],
- ["Fragment", "Frag" ],
- ["Construction", "Constr" ],
- ["Default", "Def" ],
- ["Processor", "Proc" ],
- ["Compare", "Comp" ],
- ["Execution", "Exe" ],
- ["Functor", "Func" ],
- ["Collation", "Col" ],
- ["Element", "El" ],
- ["Datatype", "DT" ],
- ["Numeric", "Num" ],
- );
- sub GetPathSeparator
- {
- if ($^O eq 'MSWin32')
- {
- return '\';
- }
- elsif ($^O eq 'MacOS')
- {
- return ':';
- }
- else
- {
- return '/';
- }
- }
- sub ShortenName
- {
- $newName = $_;
-
- LOOP:
- while (length($newName) > $kMaxLength)
- {
- foreach $hint (@gHints)
- {
- $pattern = $hint->[0];
- $replacement = $hint->[1];
- if ($newName =~ s/$pattern/$replacement/)
- {
- #print "tmatched ".$hint->[0]."; replaced with ".$hint->[1]."n";
- next LOOP;
- }
- }
-
- # No hint found, so we need to shorten the name manually
- $kill = length($newName) - $kMaxLength + 1;
- substr($newName, $kMaxLength / 2, $kill) = "_";
- #print "tshorten manuallyn";
- }
-
- return $newName;
- }
- sub Gather
- {
- $path = $File::Find::name;
- $name = $_;
-
- if (-f $path)
- {
- if (length($name) > $kMaxLength)
- {
- #print "$name is too longn";
- $newName = ShortenName($name);
- #print "--> ".$newName."n";
-
- # Add an entry to our bad map
- $gBadMap{$name} = $newName
- }
- }
- else
- {
- #print "NOT A FILE: $File::Find::dir".$_."n";
- }
- }
- sub GatherBadFiles
- {
- find(&Gather, $gSrcBase);
- }
- sub Copy
- {
- # Caller wants $_ the same across this call
- $save_ = $_;
-
- $_ = "" if ($_ eq '.');
-
- # remap the destination name as needed
- $srcName = $_;
- $dstName = $srcName;
- if (exists $gBadMap{$srcName})
- {
- $dstName = $gBadMap{$srcName};
- print "Renaming file $srcNament--> $dstNamen";
- }
-
- $srcPath = $File::Find::name;
- $dstPath = $srcPath;
-
- # Interpolate paths
- $dstPath =~ s/$srcName$/$dstName/;
- $dstPath =~ s/^$gSrcBase/$gDstBase/;
-
- #print "srcName $srcName, dstName $dstName, srcPath $srcPath, dstPath $dstPathn";
-
- if (-d $srcPath)
- {
- # make the dst directory if it doesn't already exist
- if (not -e $dstPath)
- {
- print "Making directory $dstPathn";
- mkpath($dstPath);
- }
- }
- else
- {
- # Copy the file, fixing up includes as we go
-
- # Open files
- open(SRC, "< $srcPath") or die "can't open $srcPath: $!";
- open(DST, "> $dstPath") or die "can't open $dstPath: $!";
-
- # Copy the file a line at a time
- while (<SRC>)
- {
- # Look for an include line
- if ( /^(s*)#(s*)include(s*)<(s*)(.*)(s*)>(.*)/
- || /^(s*)#(s*)include(s*)"(s*)(.*)(s*)"(.*)/
- )
- {
- # We've got the include file name (path).
- # Now isolate just the leaf of that
- $includePath = $5;
-
- $includePath =~ /^([^/]*/)*([^/]+)$/;
- $includeLeaf = $2;
-
- # Check for the include file in our bad map, replacing
- # it as necessary
- if (exists $gBadMap{$includeLeaf})
- {
- $dup = $_;
- $was = $includeLeaf;
- $sub = $gBadMap{$was};
-
- s/^(.*)include(.*)$was(.*)/$1include$2$sub$3/;
- print "file $srcName: changed include $includePathnt--> $_";
- #print "Change $dup to $_";
- }
- }
-
- # Output the modified (or not) line
- (print DST $_) or die "can't write to $dstPath: $!";
- }
-
- # Close 'dem files
- close(SRC) or die "can't close $srcPath: $!";
- close(DST) or die "can't close $dstPath: $!";
- }
-
- $_ = $save_;
- }
- sub CopyFiles
- {
- find(&Copy, $gSrcBase);
- }
- # Tell what we know:
- print "n";
- print "Script: $0n";
- print "Source Directory: $gSrcBasen";
- print "Destination Directory: $gDstBasen";
- print "n";
- #-- Scan phase
- #NOTE: we actually don't limit our processing to the file types listed here!!!
- #for each .cpp or .hpp or .c or .cc file in tree
- # if name too long
- # shorten the name
- # store it in a map
- # end if
- #end for
- # Gather up the bad files into global map gBadMap
- print "Scanning...n";
- undef %gBadMap;
- GatherBadFiles($srcBase);
- # Print bad map
- #print "BadMap:n";
- #foreach $key (sort(keys %gBadMap)) {
- # print $key, '=', $gBadMap{$key}, "n";
- #}
- #-- Copy/Modify phase
- #for each file in tree
- # copy file to new directory, scanning for include as we go
- # if include contains a name from the map
- # then replace it
- #end for
- print "Copying...n";
- CopyFiles($srcBase, $dstBase);
- print "nDonen";