Permalink
Cannot retrieve contributors at this time
executable file
145 lines (130 sloc)
4.15 KB
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| #!/usr/bin/perl -w | |
| # | |
| # File: scripts/validate | |
| # | |
| # Description: Run various code validation tests before exiftool release | |
| # | |
| # Created: 2010/01/23 - P. Harvey | |
| # | |
| use strict; | |
| BEGIN { push @INC, 'lib' } | |
| use Image::ExifTool; | |
| use Image::ExifTool::Charset; | |
| my $err = 0; | |
| sub Warn(@) | |
| { | |
| warn @_; | |
| $err = 1; | |
| } | |
| # check for test code | |
| my $tmp = `grep -rw TEST lib exiftool windows_exiftool`; | |
| if ($tmp) { | |
| Warn("Test code found!:\n$tmp"); | |
| } | |
| # check for other exiftool distributions in this directory | |
| $tmp = `ls -d Image-ExifTool-?.?? 2> /dev/null`; | |
| if ($tmp) { | |
| Warn("Another exiftool release exists!:\n$tmp"); | |
| } | |
| # check for "use x" in text comments (breaks perl2exe) | |
| $tmp = `grep -rE '^[ ]+use ' exiftool lib | grep -v ';'`; | |
| if ($tmp) { | |
| Warn("Possible use of 'use' in comment (breaks perl2exe)!:\n$tmp"); | |
| } | |
| # check for EncodeExifText used in PrintConvInv (must be RawConvInv) | |
| $tmp = `grep -r EncodeExifText lib | grep -E '(PrintConvInv|ValueConvInv)'`; | |
| if ($tmp) { | |
| Warn("EncodeExifText should only be used in RawConvInv!:\n$tmp"); | |
| } | |
| # check for use of \G without /g (problem with Perl 5.00505) | |
| $tmp = `grep -r '\\\\G' exiftool lib | grep ~ | grep -vE '(/s?g|\\}s?g)'`; | |
| if ($tmp) { | |
| Warn("USING \\G WITHOUT /g IN REGULAR EXPRESSION!:\n$tmp"); | |
| } | |
| # check for "defined HASH" | |
| $tmp = `grep -r "defined %" lib exiftool windows_exiftool`; | |
| if ($tmp) { | |
| Warn("$tmp^^^ Defined HASH is deprecated in Perl 5.11! ^^^\n"); | |
| } | |
| # | |
| # validate character sets | |
| # | |
| my %test; | |
| foreach (keys %Image::ExifTool::Charset::csType) { | |
| my $csType = $Image::ExifTool::Charset::csType{$_}; | |
| # only type 0x100 and 0x101 should be made available for public consumption, | |
| # other types are used only internally. (0x080 types are not made public | |
| # because the conversion routines are usually not called unless the string | |
| # contains a codepoint greater than 0x7f) | |
| $test{$_} = 1 if $csType <= 0x101 and $_ ne 'ASCII'; | |
| my $module = "Image::ExifTool::Charset::$_"; | |
| unless (eval "require $module") { | |
| $csType & 0x001 and Warn("Error loading Charset $_\n"); | |
| next; | |
| } | |
| no strict 'refs'; | |
| my $conv = \%$module; | |
| use strict 'refs'; | |
| my $type = 0x001; # has a lookup table | |
| my $char; | |
| foreach $char (keys %$conv) { | |
| $char < 0x80 and $type |= 0x080; # remaps chars < 0x80 | |
| $type |= ($char < 0x100 ? 0x100 : 0x200); # byte width | |
| my $to = $$conv{$char}; | |
| ref $to and $type |= 0x800, next; # variable width or multi-char | |
| } | |
| # variable-width types are 0x800 | |
| if (($type & 0x300) == 0x300 or ($type & 0x300 and $type & 0x800)) { | |
| $type &= ~0x300; | |
| $type |= 0x800; | |
| } | |
| # known 2-byte fixed-width types which map chars < 0x100 | |
| if (/^(Symbol)$/) { | |
| $type &= ~0xf00; | |
| $type |= 0x200; | |
| } | |
| $type |= 0x002 if $_ eq 'MacArabic' or $type > 0x401; # inverse not supported | |
| if ($type != $csType) { | |
| my $str = sprintf("0x%.3x should be 0x%.3x", $csType , $type); | |
| Warn("Incorrect csType for Charset $_ ($str)\n"); | |
| } | |
| } | |
| foreach (values %Image::ExifTool::charsetName) { | |
| $test{$_} or Warn("Charset $_ is not defined in Charset.pm or not valid for API\n"); | |
| $test{$_} = 2; | |
| } | |
| foreach (keys %test) { | |
| $test{$_} == 2 or Warn("Charset $_ not defined in %Image::ExifTool::charsetName\n"); | |
| } | |
| # | |
| # check to be sure Minolta.pm and Sony.pm lens lists are synchronized | |
| # | |
| my %lens; | |
| foreach (split /\n/, `grep "'Sony E " lib/Image/ExifTool/Minolta.pm`) { | |
| next if /^\s*#/; | |
| next unless /'([^']+)',/; | |
| if ($lens{$1}) { | |
| Warn("Duplicate lens in Minolta.pm: $1\n"); | |
| } else { | |
| $lens{$1} = 1; | |
| } | |
| } | |
| foreach (split /\n/, `grep "'Sony E " lib/Image/ExifTool/Sony.pm`) { | |
| # (commented out lenses in Sony.pm are OK) | |
| # next if /^\s*#/; | |
| next unless /'([^']+)',/; | |
| my $lens = $1; | |
| $lens =~ s/ or .*//; | |
| if (not $lens{$lens}) { | |
| Warn("Missing lens in Sony.pm: $lens\n"); | |
| } elsif ($lens{$lens} == 2) { | |
| Warn("Duplicate lens in Sony.pm: $lens\n"); | |
| } else { | |
| $lens{$lens} = 2; | |
| } | |
| } | |
| foreach (sort keys %lens) { | |
| $lens{$_} != 2 and Warn("Missing lens in Minolta.pm: $_\n"); | |
| } | |
| exit $err; | |
| # end |