tools/findBadSkeletonBindings.pl

   1 #!/bin/perl
   2 use strict;
   3
   4 use Iff;
   5
   6 my %filenamesToProcess;
   7 my $debug = 0;
   8 my %skeletonNames;
   9
  10 sub collectFileNamesToProcess
  11 {
  12         foreach my $filenameGlob (@_)
  13         {
  14                 my @filenames = glob($filenameGlob);
  15                 foreach my $filename (@filenames)
  16                 {
  17                         $filenamesToProcess{$filename} = 1;
  18                 }
  19         }
  20 }
  21
  22 sub printFileNames
  23 {
  24         print "Filenames:\n";
  25         my @sortedFileNames = sort {$a cmp $b} keys %filenamesToProcess;
  26         foreach my $filename (@sortedFileNames)
  27         {
  28                 print "$filename\n";
  29         }
  30
  31         print "Total: ", scalar(@sortedFileNames), " files\n";
  32 }
  33
  34 sub iffCallbackCollectSkeletons
  35 {
  36         my $iff = shift;
  37         my $blockname = shift;
  38         my $isChunk = shift;
  39
  40         if ($isChunk && ($blockname eq "SKTI"))
  41         {
  42                 while ($iff->getChunkLengthLeft() > 0)
  43                 {
  44                         my $skeletonTemplateName = $iff->read_string();
  45                         my $attachmentTransformName = $iff->read_string();
  46
  47                         # @todo: catch multiple counts of the same skeleton template name.
  48                         $skeletonNames{$skeletonTemplateName} = 1;
  49                 }
  50         }
  51
  52         return 1;
  53 }
  54
  55 sub processSatIff
  56 {
  57         # Setup args.
  58         my $satFileName = shift;
  59         my $iff = shift;
  60
  61         # Collect skeleton templates referenced by this iff.
  62         %skeletonNames = ();
  63         $iff->walkIff(\&iffCallbackCollectSkeletons);
  64
  65         # Process skeleton template names.
  66         my $faceSkeletonCount = 0;
  67
  68         foreach my $skeletonTemplateName (sort {$a cmp $b} keys %skeletonNames)
  69         {
  70                 my $workingSkeletonName = $skeletonTemplateName;
  71
  72                 # Strip off directories in the skeleton template name.
  73                 $workingSkeletonName =~ s!\\!/!;
  74                 $workingSkeletonName =~ s!^.+/!!;
  75
  76                 # Strip off .skt part.
  77                 $workingSkeletonName =~ s!.skt$!!;
  78                 print "workingSkeletonName=[$workingSkeletonName]\n" if $debug;
  79
  80                 if ($workingSkeletonName eq "all_b")
  81                 {
  82                         #ignore all_b skeleton.
  83                 }
  84                 elsif ($workingSkeletonName =~ m/([^_]+)_([^_]+)_face/)
  85                 {
  86                         ++$faceSkeletonCount;
  87
  88                         my $speciesAbbrev = $1;
  89                         my $genderAbbrev = $2;
  90
  91                         my $invalidSatName = 0;
  92
  93                         my $shouldContainForSpecies = '(^|_)' . $speciesAbbrev . '_';
  94                         if (!($satFileName =~ m/$shouldContainForSpecies/))
  95                         {
  96                                 ++$invalidSatName;
  97                         }
  98
  99                         my $satShouldContainForGender = '_' . $genderAbbrev . '(_|.sat)';
 100                         if (!($satFileName =~ m/$satShouldContainForGender/))
 101                         {
 102                                 ++$invalidSatName;
 103                         }
 104
 105                         if ($invalidSatName > 0)
 106                         {
 107                                 # The SAT file references species/gender specific skeleton template but the SAT filename doesn't indicate the species/gender dependency.\n";
 108                                 print "$satFileName\t$skeletonTemplateName\tspecies/gender skeleton referenced, invalid SAT name.\n";
 109                         }
 110                 }
 111                 else
 112                 {
 113                         # Try matching the whole working skeleton name within the sat, indicating that the skeleton and sat are joined.
 114                         my $validSatNamePattern = '(^|_)' . $workingSkeletonName . '(_|.sat)';
 115                         if (!($satFileName =~ m/$validSatNamePattern/))
 116                         {
 117                                 print "$satFileName\t$skeletonTemplateName\tunexpected skeleton template name\n";
 118                         }
 119                 }
 120         }
 121
 122         print "$satFileName\t****\treferenced $faceSkeletonCount face skeletons\n" if $faceSkeletonCount > 1;
 123 }
 124
 125 sub processFiles
 126 {
 127         foreach my $filename (@_)
 128         {
 129                 # Open the file, create an Iff instance from it.
 130                 my $fileHandle;
 131                 open($fileHandle, "<$filename") or die "cannot open file [$filename]: $!";
 132
 133                 my $iff = Iff->createFromFileHandle($fileHandle);
 134
 135                 close($fileHandle);
 136
 137                 # Handle Iff contents.
 138                 my $initialName = $iff->getCurrentName();
 139                 if (($initialName ne "SMAT") || !$iff->isCurrentForm())
 140                 {
 141                         print "$filename: not a .SAT file, ignoring\n";
 142                 }
 143                 else
 144                 {
 145                         $iff->enterForm();
 146                         processSatIff($filename, $iff);
 147                         $iff->exitForm();
 148                 }
 149
 150         }
 151 }
 152
 153 # Print usage.
 154 die "Usage: perl findBadSkeletonBindings.pl <.sat fileglob> [ <.sat fileglob> [...]]\n" if (@ARGV == 0);
 155
 156 # Collect files to process.
 157 collectFileNamesToProcess(@ARGV);
 158 printFileNames() if $debug;
 159 processFiles(sort {$a cmp $b} keys %filenamesToProcess);