source: josm/trunk/tools/japicc/japi-compliance-checker.pl @ 12016

Last change on this file since 12016 was 11682, checked in by Don-vip, 3 years ago

update to japi-compliance-checker 2.1

File size: 154.4 KB
Line 
1#!/usr/bin/perl
2###########################################################################
3# Java API Compliance Checker (JAPICC) 2.1
4# A tool for checking backward compatibility of a Java library API
5#
6# Written by Andrey Ponomarenko
7#
8# Copyright (C) 2011-2017 Andrey Ponomarenko's ABI Laboratory
9#
10# PLATFORMS
11# =========
12#  Linux, FreeBSD, Mac OS X, MS Windows
13#
14# REQUIREMENTS
15# ============
16#  Linux, FreeBSD, Mac OS X
17#    - JDK or OpenJDK - development files (javap, javac)
18#    - Perl 5 (5.8 or newer)
19#
20#  MS Windows
21#    - JDK or OpenJDK (javap, javac)
22#    - Active Perl 5 (5.8 or newer)
23#
24# This program is free software: you can redistribute it and/or modify
25# it under the terms of the GNU General Public License or the GNU Lesser
26# General Public License as published by the Free Software Foundation.
27#
28# This program is distributed in the hope that it will be useful,
29# but WITHOUT ANY WARRANTY; without even the implied warranty of
30# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
31# GNU General Public License for more details.
32#
33# You should have received a copy of the GNU General Public License
34# and the GNU Lesser General Public License along with this program.
35# If not, see <http://www.gnu.org/licenses/>.
36###########################################################################
37use Getopt::Long;
38Getopt::Long::Configure ("posix_default", "no_ignore_case", "permute");
39use File::Path qw(mkpath rmtree);
40use File::Temp qw(tempdir);
41use File::Basename qw(dirname);
42use Cwd qw(abs_path cwd);
43use Data::Dumper;
44
45my $TOOL_VERSION = "2.1";
46my $API_DUMP_VERSION = "2.1";
47my $API_DUMP_VERSION_MIN = "2.0";
48
49# Internal modules
50my $MODULES_DIR = getModules();
51push(@INC, dirname($MODULES_DIR));
52
53# Basic modules
54my %LoadedModules = ();
55loadModule("Basic");
56loadModule("Input");
57loadModule("Path");
58loadModule("Logging");
59loadModule("Utils");
60loadModule("TypeAttr");
61loadModule("Filter");
62loadModule("SysFiles");
63loadModule("Descriptor");
64loadModule("Mangling");
65
66# Rules DB
67my %RULES_PATH = (
68"Binary" => $MODULES_DIR."/RulesBin.xml",
69"Source" => $MODULES_DIR."/RulesSrc.xml");
70
71my $CmdName = getFilename($0);
72
73my %HomePage = (
74    "Dev"=>"https://github.com/lvc/japi-compliance-checker",
75    "Doc"=>"https://lvc.github.io/japi-compliance-checker/"
76);
77
78my $ShortUsage = "Java API Compliance Checker (JAPICC) $TOOL_VERSION
79A tool for checking backward compatibility of a Java library API
80Copyright (C) 2017 Andrey Ponomarenko's ABI Laboratory
81License: GNU LGPL or GNU GPL
82
83Usage: $CmdName [options]
84Example: $CmdName OLD.jar NEW.jar
85
86More info: $CmdName --help";
87
88if($#ARGV==-1)
89{
90    printMsg("INFO", $ShortUsage);
91    exit(0);
92}
93
94GetOptions("h|help!" => \$In::Opt{"Help"},
95  "v|version!" => \$In::Opt{"ShowVersion"},
96  "dumpversion!" => \$In::Opt{"DumpVersion"},
97# general options
98  "l|lib|library=s" => \$In::Opt{"TargetLib"},
99  "d1|old|o=s" => \$In::Desc{1}{"Path"},
100  "d2|new|n=s" => \$In::Desc{2}{"Path"},
101# extra options
102  "client|app=s" => \$In::Opt{"ClientPath"},
103  "binary|bin!" => \$In::Opt{"BinaryOnly"},
104  "source|src!" => \$In::Opt{"SourceOnly"},
105  "v1|version1|vnum=s" => \$In::Desc{1}{"TargetVersion"},
106  "v2|version2=s" => \$In::Desc{2}{"TargetVersion"},
107  "s|strict!" => \$In::Opt{"StrictCompat"},
108  "keep-internal!" => \$In::Opt{"KeepInternal"},
109  "skip-internal-packages|skip-internal=s" => \$In::Opt{"SkipInternalPackages"},
110  "skip-internal-types=s" => \$In::Opt{"SkipInternalTypes"},
111  "dump|dump-api=s" => \$In::Opt{"DumpAPI"},
112  "classes-list=s" => \$In::Opt{"ClassListPath"},
113  "annotations-list=s" => \$In::Opt{"AnnotationsListPath"},
114  "skip-annotations-list=s" => \$In::Opt{"SkipAnnotationsListPath"},
115  "skip-deprecated!" => \$In::Opt{"SkipDeprecated"},
116  "skip-classes=s" => \$In::Opt{"SkipClassesList"},
117  "skip-packages=s" => \$In::Opt{"SkipPackagesList"},
118  "short" => \$In::Opt{"ShortMode"},
119  "dump-path=s" => \$In::Opt{"OutputDumpPath"},
120  "report-path=s" => \$In::Opt{"OutputReportPath"},
121  "bin-report-path=s" => \$In::Opt{"BinaryReportPath"},
122  "src-report-path=s" => \$In::Opt{"SourceReportPath"},
123  "quick!" => \$In::Opt{"Quick"},
124  "sort!" => \$In::Opt{"SortDump"},
125  "show-access!" => \$In::Opt{"ShowAccess"},
126  "limit-affected=s" => \$In::Opt{"AffectLimit"},
127  "hide-templates!" => \$In::Opt{"HideTemplates"},
128  "show-packages!" => \$In::Opt{"ShowPackages"},
129  "compact!" => \$In::Opt{"Compact"},
130  "added-annotations!" => \$In::Opt{"AddedAnnotations"},
131  "removed-annotations!" => \$In::Opt{"RemovedAnnotations"},
132  "count-methods=s" => \$In::Opt{"CountMethods"},
133  "dep1=s" => \$In::Desc{1}{"DepDump"},
134  "dep2=s" => \$In::Desc{2}{"DepDump"},
135  "old-style!" => \$In::Opt{"OldStyle"},
136# other options
137  "test!" => \$In::Opt{"TestTool"},
138  "debug!" => \$In::Opt{"Debug"},
139  "title=s" => \$In::Opt{"TargetTitle"},
140  "jdk-path=s" => \$In::Opt{"JdkPath"},
141  "external-css=s" => \$In::Opt{"ExternCss"},
142  "external-js=s" => \$In::Opt{"ExternJs"},
143# deprecated
144  "minimal!" => \$In::Opt{"Minimal"},
145  "hide-packages!" => \$In::Opt{"HidePackages"},
146# private
147  "all-affected!" => \$In::Opt{"AllAffected"}
148) or errMsg();
149
150if(@ARGV)
151{ 
152    if($#ARGV==1)
153    { # japi-compliance-checker OLD.jar NEW.jar
154        $In::Desc{1}{"Path"} = $ARGV[0];
155        $In::Desc{2}{"Path"} = $ARGV[1];
156    }
157    else {
158        errMsg();
159    }
160}
161
162sub errMsg()
163{
164    printMsg("INFO", "\n".$ShortUsage);
165    exit(getErrorCode("Error"));
166}
167
168my $HelpMessage = "
169NAME:
170  Java API Compliance Checker ($CmdName)
171  Check backward compatibility of a Java library API
172
173DESCRIPTION:
174  Java API Compliance Checker (JAPICC) is a tool for checking backward
175  binary/source compatibility of a Java library API. The tool checks class
176  declarations of old and new versions and analyzes changes that may break
177  compatibility: removed class members, added abstract methods, etc.
178 
179  Break of the binary compatibility may result in crash or incorrect behavior
180  of existing clients built with an old library version if they run with a
181  new one. Break of the source compatibility may result in recompilation
182  errors with a new library version.
183
184  The tool is intended for developers of software libraries and maintainers
185  of operating systems who are interested in ensuring backward compatibility,
186  i.e. allow old clients to run or to be recompiled with newer library
187  versions.
188
189  This tool is free software: you can redistribute it and/or modify it
190  under the terms of the GNU LGPL or GNU GPL.
191
192USAGE:
193  $CmdName [options]
194
195EXAMPLE 1:
196  $CmdName OLD.jar NEW.jar
197
198EXAMPLE 2:
199  $CmdName -lib NAME -old OLD.xml -new NEW.xml
200  OLD.xml and NEW.xml are XML-descriptors:
201
202    <version>
203        1.0
204    </version>
205   
206    <archives>
207        /path1/to/JAR(s)/
208        /path2/to/JAR(s)/
209        ...
210    </archives>
211
212INFORMATION OPTIONS:
213  -h|-help
214      Print this help.
215
216  -v|-version
217      Print version information.
218
219  -dumpversion
220      Print the tool version ($TOOL_VERSION) and don't do anything else.
221
222GENERAL OPTIONS:
223  -l|-library NAME
224      Library name (without version).
225
226  -old|-d1 PATH
227      Descriptor of the 1st (old) library version.
228      It may be one of the following:
229     
230         1. Java archive (*.jar)
231         2. XML-descriptor (VERSION.xml file):
232
233              <version>
234                  1.0
235              </version>
236             
237              <archives>
238                  /path1/to/JAR(s)/
239                  /path2/to/JAR(s)/
240                   ...
241              </archives>
242
243                 ...
244         
245         3. API dump generated by -dump option
246
247      If you are using *.jar as a descriptor then you should
248      specify version numbers with -v1 and -v2 options too.
249      If version numbers are not specified then the tool will
250      try to detect them automatically.
251
252  -new|-d2 PATH
253      Descriptor of the 2nd (new) library version.
254
255EXTRA OPTIONS:
256  -client|-app PATH
257      This option allows to specify the client Java archive that should be
258      checked for portability to the new library version.
259
260  -binary|-bin
261      Show \"Binary\" compatibility problems only.
262      Generate report to \"bin_compat_report.html\".
263
264  -source|-src
265      Show \"Source\" compatibility problems only.
266      Generate report to \"src_compat_report.html\".
267
268  -v1|-version1 NUM
269      Specify 1st API version outside the descriptor. This option is needed
270      if you have prefered an alternative descriptor type (see -d1 option).
271     
272      In general case you should specify it in the XML descriptor:
273          <version>
274              VERSION
275          </version>
276
277  -v2|-version2 NUM
278      Specify 2nd library version outside the descriptor.
279
280  -vnum NUM
281      Specify the library version in the generated API dump.
282
283  -s|-strict
284      Treat all API compatibility warnings as problems.
285
286  -keep-internal
287      Do not skip checking of these packages:
288        *impl*
289        *internal*
290        *examples*
291 
292  -skip-internal-packages PATTERN
293      Do not check packages matched by the pattern.
294 
295  -skip-internal-types PATTERN
296      Do not check types (classes and interfaces) matched by the pattern.
297 
298  -dump|-dump-api PATH
299      Dump library API to gzipped TXT format file. You can transfer it
300      anywhere and pass instead of the descriptor. Also it may be used
301      for debugging the tool.
302     
303  -classes-list PATH
304      This option allows to specify a file with a list
305      of classes that should be checked, other classes will not be checked.
306 
307  -annotations-list PATH
308      Specifies a file with a list of annotations. The tool will check only
309      classes annotated by the annotations from the list. Other classes
310      will not be checked.
311 
312  -skip-annotations-list PATH
313      Skip checking of classes annotated by the annotations in the list.
314     
315  -skip-deprecated
316      Skip analysis of deprecated methods and classes.
317     
318  -skip-classes PATH
319      This option allows to specify a file with a list
320      of classes that should not be checked.
321     
322  -skip-packages PATH
323      This option allows to specify a file with a list
324      of packages that should not be checked.
325     
326  -short
327      Do not list added/removed methods.
328 
329  -dump-path PATH
330      Specify a *.dump file path where to generate an API dump.
331      Default:
332          api_dumps/LIB_NAME/VERSION/API.dump
333
334  -report-path PATH
335      Path to compatibility report.
336      Default:
337          compat_reports/LIB_NAME/V1_to_V2/compat_report.html
338
339  -bin-report-path PATH
340      Path to \"Binary\" compatibility report.
341      Default:
342          compat_reports/LIB_NAME/V1_to_V2/bin_compat_report.html
343
344  -src-report-path PATH
345      Path to \"Source\" compatibility report.
346      Default:
347          compat_reports/LIB_NAME/V1_to_V2/src_compat_report.html
348
349  -quick
350      Quick analysis.
351      Disabled:
352        - analysis of method parameter names
353        - analysis of class field values
354        - analysis of usage of added abstract methods
355        - distinction of deprecated methods and classes
356
357  -sort
358      Enable sorting of data in API dumps.
359     
360  -show-access
361      Show access level of non-public methods listed in the report.
362     
363  -hide-templates
364      Hide template parameters in the report.
365 
366  -hide-packages
367  -minimal
368      Do nothing.
369 
370  -show-packages
371      Show package names in the report.
372     
373  -limit-affected LIMIT
374      The maximum number of affected methods listed under the description
375      of the changed type in the report.
376 
377  -compact
378      Try to simplify formatting and reduce size of the report (for a big
379      set of changes).
380 
381  -added-annotations
382      Apply filters by annotations only to new version of the library.
383 
384  -removed-annotations
385      Apply filters by annotations only to old version of the library.
386 
387  -count-methods PATH
388      Count total public methods in the API dump.
389 
390  -dep1 PATH
391  -dep2 PATH
392      Path to the API dump of the required dependency archive. It will
393      be used to resolve overwritten methods and more.
394 
395  -old-style
396      Generate old-style report.
397
398OTHER OPTIONS:
399  -test
400      Run internal tests. Create two incompatible versions of a sample library
401      and run the tool to check them for compatibility. This option allows to
402      check if the tool works correctly in the current environment.
403
404  -debug
405      Debugging mode. Print debug info on the screen. Save intermediate
406      analysis stages in the debug directory:
407          debug/LIB_NAME/VER/
408
409      Also consider using -dump option for debugging the tool.
410
411  -title NAME
412      Change library name in the report title to NAME. By default
413      will be displayed a name specified by -l option.
414
415  -jdk-path PATH
416      Path to the JDK install tree (e.g. /usr/lib/jvm/java-7-openjdk-amd64).
417
418  -external-css PATH
419      Generate CSS styles file to PATH. This helps to save space when
420      generating thousands of reports.
421
422  -external-js PATH
423      Generate JS script file to PATH.
424
425REPORT:
426    Compatibility report will be generated to:
427        compat_reports/LIB_NAME/V1_to_V2/compat_report.html
428
429EXIT CODES:
430    0 - Compatible. The tool has run without any errors.
431    non-zero - Incompatible or the tool has run with errors.
432
433MORE INFO:
434    ".$HomePage{"Doc"}."
435    ".$HomePage{"Dev"};
436
437sub helpMsg() {
438    printMsg("INFO", $HelpMessage."\n");
439}
440
441#Aliases
442my (%MethodInfo, %TypeInfo, %TName_Tid) = ();
443
444#Separate checked and unchecked exceptions
445my %KnownRuntimeExceptions= map {$_=>1} (
446    "java.lang.AnnotationTypeMismatchException",
447    "java.lang.ArithmeticException",
448    "java.lang.ArrayStoreException",
449    "java.lang.BufferOverflowException",
450    "java.lang.BufferUnderflowException",
451    "java.lang.CannotRedoException",
452    "java.lang.CannotUndoException",
453    "java.lang.ClassCastException",
454    "java.lang.CMMException",
455    "java.lang.ConcurrentModificationException",
456    "java.lang.DataBindingException",
457    "java.lang.DOMException",
458    "java.lang.EmptyStackException",
459    "java.lang.EnumConstantNotPresentException",
460    "java.lang.EventException",
461    "java.lang.IllegalArgumentException",
462    "java.lang.IllegalMonitorStateException",
463    "java.lang.IllegalPathStateException",
464    "java.lang.IllegalStateException",
465    "java.lang.ImagingOpException",
466    "java.lang.IncompleteAnnotationException",
467    "java.lang.IndexOutOfBoundsException",
468    "java.lang.JMRuntimeException",
469    "java.lang.LSException",
470    "java.lang.MalformedParameterizedTypeException",
471    "java.lang.MirroredTypeException",
472    "java.lang.MirroredTypesException",
473    "java.lang.MissingResourceException",
474    "java.lang.NegativeArraySizeException",
475    "java.lang.NoSuchElementException",
476    "java.lang.NoSuchMechanismException",
477    "java.lang.NullPointerException",
478    "java.lang.ProfileDataException",
479    "java.lang.ProviderException",
480    "java.lang.RasterFormatException",
481    "java.lang.RejectedExecutionException",
482    "java.lang.SecurityException",
483    "java.lang.SystemException",
484    "java.lang.TypeConstraintException",
485    "java.lang.TypeNotPresentException",
486    "java.lang.UndeclaredThrowableException",
487    "java.lang.UnknownAnnotationValueException",
488    "java.lang.UnknownElementException",
489    "java.lang.UnknownEntityException",
490    "java.lang.UnknownTypeException",
491    "java.lang.UnmodifiableSetException",
492    "java.lang.UnsupportedOperationException",
493    "java.lang.WebServiceException",
494    "java.lang.WrongMethodTypeException"
495);
496
497#java.lang.Object
498my %JavaObjectMethod = (
499   
500    "java/lang/Object.clone:()Ljava/lang/Object;" => 1,
501    "java/lang/Object.equals:(Ljava/lang/Object;)Z" => 1,
502    "java/lang/Object.finalize:()V" => 1,
503    "java/lang/Object.getClass:()Ljava/lang/Class;" => 1,
504    "java/lang/Object.hashCode:()I" => 1,
505    "java/lang/Object.notify:()V" => 1,
506    "java/lang/Object.notifyAll:()V" => 1,
507    "java/lang/Object.toString:()Ljava/lang/String;" => 1,
508    "java/lang/Object.wait:()V" => 1,
509    "java/lang/Object.wait:(J)V" => 1,
510    "java/lang/Object.wait:(JI)V" => 1
511);
512
513#Global variables
514my %Cache;
515my %RESULT;
516my $TOP_REF = "<a class='top_ref' href='#Top'>to the top</a>";
517
518#Types
519my %CheckedTypes;
520
521#Classes
522my %LibArchives;
523my %Class_Methods;
524my %Class_AbstractMethods;
525my %Class_Fields;
526my %ClassMethod_AddedUsed;
527my %Class_Constructed;
528
529#Methods
530my %CheckedMethods;
531my %MethodUsed;
532
533#Merging
534my %AddedMethod_Abstract;
535my %RemovedMethod_Abstract;
536my %ChangedReturnFromVoid;
537my %CompatRules;
538my %IncompleteRules;
539
540#Report
541my %TypeChanges;
542
543#Recursion locks
544my @RecurTypes;
545
546#Problem descriptions
547my %CompatProblems;
548my %TotalAffected;
549
550#Speedup
551my %TypeProblemsIndex;
552
553#Rerort
554my $ContentID = 1;
555my $ContentSpanStart = "<span class=\"section\" onclick=\"sC(this, 'CONTENT_ID')\">\n";
556my $ContentSpanStart_Affected = "<span class=\"sect_aff\" onclick=\"sC(this, 'CONTENT_ID')\">\n";
557my $ContentSpanEnd = "</span>\n";
558my $ContentDivStart = "<div id=\"CONTENT_ID\" style=\"display:none;\">\n";
559my $ContentDivEnd = "</div>\n";
560my $Content_Counter = 0;
561
562sub getModules()
563{
564    my $TOOL_DIR = dirname($0);
565    if(not $TOOL_DIR)
566    { # patch for MS Windows
567        $TOOL_DIR = ".";
568    }
569    my @SEARCH_DIRS = (
570        # tool's directory
571        abs_path($TOOL_DIR),
572        # relative path to modules
573        abs_path($TOOL_DIR)."/../share/japi-compliance-checker",
574        # install path
575        'MODULES_INSTALL_PATH'
576    );
577    foreach my $DIR (@SEARCH_DIRS)
578    {
579        if($DIR!~/\A(\/|\w+:[\/\\])/)
580        { # relative path
581            $DIR = abs_path($TOOL_DIR)."/".$DIR;
582        }
583        if(-d $DIR."/modules") {
584            return $DIR."/modules";
585        }
586    }
587   
588    print STDERR "ERROR: can't find modules (Did you installed the tool by 'make install' command?)\n";
589    exit(9); # Module_Error
590}
591
592sub loadModule($)
593{
594    my $Name = $_[0];
595    if(defined $LoadedModules{$Name}) {
596        return;
597    }
598    my $Path = $MODULES_DIR."/Internals/$Name.pm";
599    if(not -f $Path)
600    {
601        print STDERR "can't access \'$Path\'\n";
602        exit(2);
603    }
604    require $Path;
605    $LoadedModules{$Name} = 1;
606}
607
608sub readModule($$)
609{
610    my ($Module, $Name) = @_;
611    my $Path = $MODULES_DIR."/Internals/$Module/".$Name;
612    if(not -f $Path) {
613        exitStatus("Module_Error", "can't access \'$Path\'");
614    }
615    return readFile($Path);
616}
617
618sub mergeClasses()
619{
620    my %ReportedRemoved = undef;
621   
622    foreach my $ClassName (keys(%{$Class_Methods{1}}))
623    {
624        next if(not $ClassName);
625        my $Type1 = getType($TName_Tid{1}{$ClassName}, 1);
626       
627        if($Type1->{"Type"}!~/class|interface/) {
628            next;
629        }
630       
631        if(defined $Type1->{"Access"}
632        and $Type1->{"Access"}=~/private/) {
633            next;
634        }
635       
636        if(not classFilter($Type1, 1, 0)) {
637            next;
638        }
639       
640        my $Type2_Id = $TName_Tid{2}{$ClassName};
641        if(not $Type2_Id)
642        { # classes and interfaces with public methods
643            foreach my $Method (keys(%{$Class_Methods{1}{$ClassName}}))
644            {
645                if(not methodFilter($Method, 1)) {
646                    next;
647                }
648               
649                $CheckedTypes{$ClassName} = 1;
650                $CheckedMethods{$Method} = 1;
651               
652                if($Type1->{"Type"} eq "class")
653                {
654                    %{$CompatProblems{$Method}{"Removed_Class"}{"this"}} = (
655                        "Type_Name"=>$ClassName,
656                        "Target"=>$ClassName);
657                }
658                else
659                {
660                    %{$CompatProblems{$Method}{"Removed_Interface"}{"this"}} = (
661                        "Type_Name"=>$ClassName,
662                        "Target"=>$ClassName);
663                }
664               
665                $ReportedRemoved{$ClassName} = 1;
666            }
667        }
668    }
669   
670    foreach my $Class_Id (keys(%{$TypeInfo{1}}))
671    {
672        my $Class1 = getType($Class_Id, 1);
673       
674        if($Class1->{"Type"}!~/class|interface/) {
675            next;
676        }
677       
678        if(defined $Class1->{"Access"}
679        and $Class1->{"Access"}=~/private/) {
680            next;
681        }
682       
683        if(not classFilter($Class1, 1, 1)) {
684            next;
685        }
686       
687        my $ClassName = $Class1->{"Name"};
688       
689        if(my $Class2_Id = $TName_Tid{2}{$ClassName})
690        { # classes and interfaces with public static fields
691            if(not defined $Class_Methods{1}{$ClassName})
692            {
693                my $Class2 = getType($Class2_Id, 2);
694               
695                foreach my $Field (keys(%{$Class1->{"Fields"}}))
696                {
697                    my $FieldInfo = $Class1->{"Fields"}{$Field};
698                   
699                    my $FAccess = $FieldInfo->{"Access"};
700                    if($FAccess=~/private/) {
701                        next;
702                    }
703                   
704                    if($FieldInfo->{"Static"})
705                    {
706                        $CheckedTypes{$ClassName} = 1;
707                       
708                        if(not defined $Class2->{"Fields"}{$Field})
709                        {
710                            %{$CompatProblems{".client_method"}{"Removed_NonConstant_Field"}{$Field}}=(
711                                "Target"=>$Field,
712                                "Type_Name"=>$ClassName,
713                                "Type_Type"=>$Class1->{"Type"},
714                                "Field_Type"=>getTypeName($FieldInfo->{"Type"}, 1));
715                        }
716                    }
717                }
718            }
719        }
720        else
721        { # removed
722            if(defined $Class1->{"Annotation"})
723            {
724                %{$CompatProblems{".client_method"}{"Removed_Annotation"}{"this"}} = (
725                    "Type_Name"=>$ClassName,
726                    "Target"=>$ClassName);
727            }
728           
729            if(not defined $Class_Methods{1}{$ClassName})
730            {
731                # classes and interfaces with public static fields
732                if(not defined $ReportedRemoved{$ClassName})
733                {
734                    foreach my $Field (keys(%{$Class1->{"Fields"}}))
735                    {
736                        my $FieldInfo = $Class1->{"Fields"}{$Field};
737                       
738                        my $FAccess = $FieldInfo->{"Access"};
739                        if($FAccess=~/private/) {
740                            next;
741                        }
742                       
743                        if($FieldInfo->{"Static"})
744                        {
745                            $CheckedTypes{$ClassName} = 1;
746                           
747                            if($Class1->{"Type"} eq "class")
748                            {
749                                %{$CompatProblems{".client_method"}{"Removed_Class"}{"this"}} = (
750                                    "Type_Name"=>$ClassName,
751                                    "Target"=>$ClassName);
752                            }
753                            else
754                            {
755                                %{$CompatProblems{".client_method"}{"Removed_Interface"}{"this"}} = (
756                                    "Type_Name"=>$ClassName,
757                                    "Target"=>$ClassName);
758                            }
759                        }
760                    }
761                }
762            }
763        }
764    }
765}
766
767sub findFieldPair($$)
768{
769    my ($Field_Pos, $Pair_Type) = @_;
770    foreach my $Pair_Name (sort keys(%{$Pair_Type->{"Fields"}}))
771    {
772        if(defined $Pair_Type->{"Fields"}{$Pair_Name})
773        {
774            if($Pair_Type->{"Fields"}{$Pair_Name}{"Pos"} eq $Field_Pos) {
775                return $Pair_Name;
776            }
777        }
778    }
779    return "lost";
780}
781
782my %Severity_Val=(
783    "High"=>3,
784    "Medium"=>2,
785    "Low"=>1,
786    "Safe"=>-1
787);
788
789sub isRecurType($$)
790{
791    foreach (@RecurTypes)
792    {
793        if($_->{"Tid1"} eq $_[0]
794        and $_->{"Tid2"} eq $_[1])
795        {
796            return 1;
797        }
798    }
799    return 0;
800}
801
802sub pushType($$)
803{
804    my %TypeDescriptor = (
805        "Tid1"  => $_[0],
806        "Tid2"  => $_[1]);
807    push(@RecurTypes, \%TypeDescriptor);
808}
809
810sub getSFormat($)
811{
812    my $Name = $_[0];
813    $Name=~s/\./\//g;
814    return $Name;
815}
816
817sub getConstantValue($$)
818{
819    my ($Value, $ValueType) = @_;
820   
821    if(not defined $Value) {
822        return undef;
823    }
824   
825    if($Value eq "\@EMPTY_STRING\@") {
826        return "\"\"";
827    }
828    elsif($ValueType eq "java.lang.String") {
829        return "\"".$Value."\"";
830    }
831   
832    return $Value;
833}
834
835sub getInvoked($)
836{
837    my $TName = $_[0];
838   
839    if(my @Invoked = sort keys(%{$ClassMethod_AddedUsed{$TName}}))
840    {
841        my $MFirst = $Invoked[0];
842        my $MSignature = unmangle($MFirst);
843        $MSignature=~s/\A.+\.(\w+\()/$1/g; # short name
844        my $InvokedBy = $ClassMethod_AddedUsed{$TName}{$MFirst};
845        return ($MSignature, $InvokedBy);
846    }
847   
848    return ();
849}
850
851sub mergeTypes($$)
852{
853    my ($Type1_Id, $Type2_Id) = @_;
854    return {} if(not $Type1_Id or not $Type2_Id);
855   
856    if(defined $Cache{"mergeTypes"}{$Type1_Id}{$Type2_Id})
857    { # already merged
858        return $Cache{"mergeTypes"}{$Type1_Id}{$Type2_Id};
859    }
860   
861    if(isRecurType($Type1_Id, $Type2_Id))
862    { # do not follow to recursive declarations
863        return {};
864    }
865   
866    my %Type1 = %{getType($Type1_Id, 1)};
867    my %Type2 = %{getType($Type2_Id, 2)};
868   
869    return {} if(not $Type1{"Name"} or not $Type2{"Name"});
870    return {} if(not $Type1{"Archive"} or not $Type2{"Archive"});
871    return {} if($Type1{"Name"} ne $Type2{"Name"});
872   
873    if(not classFilter(\%Type1, 1, 0)) {
874        return {};
875    }
876   
877    $CheckedTypes{$Type1{"Name"}} = 1;
878   
879    my %SubProblems = ();
880   
881    if($Type1{"BaseType"} and $Type2{"BaseType"})
882    { # check base type (arrays)
883        return mergeTypes($Type1{"BaseType"}, $Type2{"BaseType"});
884    }
885   
886    if($Type2{"Type"}!~/(class|interface)/) {
887        return {};
888    }
889   
890    if($Type1{"Type"} eq "class" and not $Class_Constructed{1}{$Type1_Id})
891    { # class cannot be constructed or inherited by clients
892        return {};
893    }
894   
895    if($Type1{"Type"} eq "class"
896    and $Type2{"Type"} eq "interface")
897    {
898        %{$SubProblems{"Class_Became_Interface"}{""}}=(
899            "Type_Name"=>$Type1{"Name"});
900       
901        return ($Cache{"mergeTypes"}{$Type1_Id}{$Type2_Id} = \%SubProblems);
902    }
903    if($Type1{"Type"} eq "interface"
904    and $Type2{"Type"} eq "class")
905    {
906        %{$SubProblems{"Interface_Became_Class"}{""}}=(
907            "Type_Name"=>$Type1{"Name"});
908       
909        return ($Cache{"mergeTypes"}{$Type1_Id}{$Type2_Id} = \%SubProblems);
910    }
911    if(not $Type1{"Final"}
912    and $Type2{"Final"})
913    {
914        %{$SubProblems{"Class_Became_Final"}{""}}=(
915            "Type_Name"=>$Type1{"Name"},
916            "Target"=>$Type1{"Name"});
917    }
918    if(not $Type1{"Abstract"}
919    and $Type2{"Abstract"})
920    {
921        %{$SubProblems{"Class_Became_Abstract"}{""}}=(
922            "Type_Name"=>$Type1{"Name"});
923    }
924   
925    pushType($Type1_Id, $Type2_Id);
926   
927    foreach my $AddedMethod (keys(%{$AddedMethod_Abstract{$Type1{"Name"}}}))
928    {
929        if($Type1{"Type"} eq "class")
930        {
931            if($Type1{"Abstract"})
932            {
933                if(my @InvokedBy = sort keys(%{$MethodUsed{2}{$AddedMethod}}))
934                {
935                    %{$SubProblems{"Abstract_Class_Added_Abstract_Method_Invoked_By_Others"}{getSFormat($AddedMethod)}} = (
936                        "Type_Name"=>$Type1{"Name"},
937                        "Type_Type"=>$Type1{"Type"},
938                        "Target"=>$AddedMethod,
939                        "Invoked_By"=>$InvokedBy[0]);
940                }
941                else
942                {
943                    %{$SubProblems{"Abstract_Class_Added_Abstract_Method"}{getSFormat($AddedMethod)}} = (
944                        "Type_Name"=>$Type1{"Name"},
945                        "Type_Type"=>$Type1{"Type"},
946                        "Target"=>$AddedMethod);
947                }
948            }
949            else
950            {
951                %{$SubProblems{"NonAbstract_Class_Added_Abstract_Method"}{getSFormat($AddedMethod)}} = (
952                    "Type_Name"=>$Type1{"Name"},
953                    "Type_Type"=>$Type1{"Type"},
954                    "Target"=>$AddedMethod);
955            }
956        }
957        else
958        {
959            if(my @InvokedBy = sort keys(%{$MethodUsed{2}{$AddedMethod}}))
960            {
961                %{$SubProblems{"Interface_Added_Abstract_Method_Invoked_By_Others"}{getSFormat($AddedMethod)}} = (
962                    "Type_Name"=>$Type1{"Name"},
963                    "Type_Type"=>$Type1{"Type"},
964                    "Target"=>$AddedMethod,
965                    "Invoked_By"=>$InvokedBy[0]);
966            }
967            else
968            {
969                %{$SubProblems{"Interface_Added_Abstract_Method"}{getSFormat($AddedMethod)}} = (
970                    "Type_Name"=>$Type1{"Name"},
971                    "Type_Type"=>$Type1{"Type"},
972                    "Target"=>$AddedMethod);
973            }
974        }
975    }
976    foreach my $RemovedMethod (keys(%{$RemovedMethod_Abstract{$Type1{"Name"}}}))
977    {
978        if($Type1{"Type"} eq "class")
979        {
980            %{$SubProblems{"Class_Removed_Abstract_Method"}{getSFormat($RemovedMethod)}} = (
981                "Type_Name"=>$Type1{"Name"},
982                "Type_Type"=>$Type1{"Type"},
983                "Target"=>$RemovedMethod);
984        }
985        else
986        {
987            %{$SubProblems{"Interface_Removed_Abstract_Method"}{getSFormat($RemovedMethod)}} = (
988                "Type_Name"=>$Type1{"Name"},
989                "Type_Type"=>$Type1{"Type"},
990                "Target"=>$RemovedMethod);
991        }
992    }
993    if($Type1{"Type"} eq "class"
994    and $Type2{"Type"} eq "class")
995    {
996        my $SuperClass1 = getType($Type1{"SuperClass"}, 1);
997        my $SuperClass2 = getType($Type2{"SuperClass"}, 2);
998       
999        my $SuperClassName1 = $SuperClass1->{"Name"};
1000        my $SuperClassName2 = $SuperClass2->{"Name"};
1001       
1002        if($SuperClassName2 ne $SuperClassName1)
1003        {
1004            if($SuperClassName1 eq "java.lang.Object"
1005            or not $SuperClassName1)
1006            {
1007              # Java 6: java.lang.Object
1008              # Java 7: none
1009                if($SuperClassName2 ne "java.lang.Object")
1010                {
1011                    if($SuperClass2->{"Abstract"}
1012                    and $Type1{"Abstract"} and $Type2{"Abstract"}
1013                    and keys(%{$Class_AbstractMethods{2}{$SuperClassName2}}))
1014                    {
1015                        if(my ($Invoked, $InvokedBy) = getInvoked($Type1{"Name"}))
1016                        {
1017                            %{$SubProblems{"Abstract_Class_Added_Super_Abstract_Class_Invoked_By_Others"}{""}} = (
1018                                "Type_Name"=>$Type1{"Name"},
1019                                "Target"=>$SuperClassName2,
1020                                "Invoked"=>$Invoked,
1021                                "Invoked_By"=>$InvokedBy);
1022                        }
1023                        else
1024                        {
1025                            %{$SubProblems{"Abstract_Class_Added_Super_Abstract_Class"}{""}} = (
1026                                "Type_Name"=>$Type1{"Name"},
1027                                "Target"=>$SuperClassName2);
1028                        }
1029                    }
1030                    else
1031                    {
1032                        %{$SubProblems{"Added_Super_Class"}{""}} = (
1033                            "Type_Name"=>$Type1{"Name"},
1034                            "Target"=>$SuperClassName2);
1035                    }
1036                }
1037            }
1038            elsif($SuperClassName2 eq "java.lang.Object"
1039            or not $SuperClassName2)
1040            {
1041              # Java 6: java.lang.Object
1042              # Java 7: none
1043                if($SuperClassName1 ne "java.lang.Object")
1044                {
1045                    %{$SubProblems{"Removed_Super_Class"}{""}} = (
1046                        "Type_Name"=>$Type1{"Name"},
1047                        "Target"=>$SuperClassName1);
1048                }
1049            }
1050            else
1051            {
1052                %{$SubProblems{"Changed_Super_Class"}{""}} = (
1053                    "Type_Name"=>$Type1{"Name"},
1054                    "Target"=>$SuperClassName1,
1055                    "Old_Value"=>$SuperClassName1,
1056                    "New_Value"=>$SuperClassName2);
1057            }
1058        }
1059    }
1060    my %SuperInterfaces_Old = map {getTypeName($_, 1) => 1} keys(%{$Type1{"SuperInterface"}});
1061    my %SuperInterfaces_New = map {getTypeName($_, 2) => 1} keys(%{$Type2{"SuperInterface"}});
1062    foreach my $SuperInterface (keys(%SuperInterfaces_New))
1063    {
1064        if(not $SuperInterfaces_Old{$SuperInterface})
1065        {
1066            my $HaveMethods = keys(%{$Class_AbstractMethods{2}{$SuperInterface}});
1067            my $HaveFields = keys(%{$Class_Fields{2}{$SuperInterface}});
1068           
1069            if($Type1{"Type"} eq "interface")
1070            {
1071                if($HaveMethods
1072                or $SuperInterface=~/\Ajava\./)
1073                {
1074                    if($HaveMethods and checkDefaultImpl(2, $SuperInterface, $Type2{"Name"}))
1075                    {
1076                        %{$SubProblems{"Interface_Added_Super_Interface_With_Implemented_Methods"}{getSFormat($SuperInterface)}} = (
1077                            "Type_Name"=>$Type1{"Name"},
1078                            "Target"=>$SuperInterface);
1079                    }
1080                    else
1081                    {
1082                        if(my ($Invoked, $InvokedBy) = getInvoked($Type1{"Name"}))
1083                        {
1084                            %{$SubProblems{"Interface_Added_Super_Interface_Used_By_Others"}{getSFormat($SuperInterface)}} = (
1085                                "Type_Name"=>$Type1{"Name"},
1086                                "Target"=>$SuperInterface,
1087                                "Invoked"=>$Invoked,
1088                                "Invoked_By"=>$InvokedBy);
1089                        }
1090                        else
1091                        {
1092                            %{$SubProblems{"Interface_Added_Super_Interface"}{getSFormat($SuperInterface)}} = (
1093                                "Type_Name"=>$Type1{"Name"},
1094                                "Target"=>$SuperInterface);
1095                        }
1096                    }
1097                }
1098                elsif($HaveFields)
1099                {
1100                    %{$SubProblems{"Interface_Added_Super_Constant_Interface"}{getSFormat($SuperInterface)}} = (
1101                        "Type_Name"=>$Type2{"Name"},
1102                        "Target"=>$SuperInterface);
1103                }
1104                else
1105                {
1106                    # empty interface
1107                }
1108            }
1109            else
1110            {
1111                if($Type1{"Abstract"} and $Type2{"Abstract"})
1112                {
1113                    if($HaveMethods and checkDefaultImpl(2, $SuperInterface, $Type2{"Name"}))
1114                    {
1115                        %{$SubProblems{"Abstract_Class_Added_Super_Interface_With_Implemented_Methods"}{getSFormat($SuperInterface)}} = (
1116                            "Type_Name"=>$Type1{"Name"},
1117                            "Target"=>$SuperInterface);
1118                    }
1119                    else
1120                    {
1121                        if(my ($Invoked, $InvokedBy) = getInvoked($Type1{"Name"}))
1122                        {
1123                            %{$SubProblems{"Abstract_Class_Added_Super_Interface_Invoked_By_Others"}{getSFormat($SuperInterface)}} = (
1124                                "Type_Name"=>$Type1{"Name"},
1125                                "Target"=>$SuperInterface,
1126                                "Invoked"=>$Invoked,
1127                                "Invoked_By"=>$InvokedBy);
1128                        }
1129                        else
1130                        {
1131                            %{$SubProblems{"Abstract_Class_Added_Super_Interface"}{getSFormat($SuperInterface)}} = (
1132                                "Type_Name"=>$Type1{"Name"},
1133                                "Target"=>$SuperInterface);
1134                        }
1135                    }
1136                }
1137            }
1138        }
1139    }
1140    foreach my $SuperInterface (keys(%SuperInterfaces_Old))
1141    {
1142        if(not $SuperInterfaces_New{$SuperInterface})
1143        {
1144            my $HaveMethods = keys(%{$Class_AbstractMethods{1}{$SuperInterface}});
1145            my $HaveFields = keys(%{$Class_Fields{1}{$SuperInterface}});
1146           
1147            if($Type1{"Type"} eq "interface")
1148            {
1149                if($HaveMethods
1150                or $SuperInterface=~/\Ajava\./)
1151                {
1152                    %{$SubProblems{"Interface_Removed_Super_Interface"}{getSFormat($SuperInterface)}} = (
1153                        "Type_Name"=>$Type1{"Name"},
1154                        "Type_Type"=>"interface",
1155                        "Target"=>$SuperInterface);
1156                }
1157                elsif($HaveFields)
1158                {
1159                    %{$SubProblems{"Interface_Removed_Super_Constant_Interface"}{getSFormat($SuperInterface)}} = (
1160                        "Type_Name"=>$Type1{"Name"},
1161                        "Target"=>$SuperInterface);
1162                }
1163                else {
1164                    # empty interface
1165                }
1166            }
1167            else
1168            {
1169                %{$SubProblems{"Class_Removed_Super_Interface"}{getSFormat($SuperInterface)}} = (
1170                    "Type_Name"=>$Type1{"Name"},
1171                    "Type_Type"=>"class",
1172                    "Target"=>$SuperInterface);
1173            }
1174        }
1175    }
1176   
1177    foreach my $Field_Name (sort keys(%{$Type1{"Fields"}}))
1178    {# check older fields
1179        my $Access1 = $Type1{"Fields"}{$Field_Name}{"Access"};
1180        if($Access1=~/private/) {
1181            next;
1182        }
1183       
1184        my $Field_Pos1 = $Type1{"Fields"}{$Field_Name}{"Pos"};
1185        my $FieldType1_Id = $Type1{"Fields"}{$Field_Name}{"Type"};
1186        my $FieldType1_Name = getTypeName($FieldType1_Id, 1);
1187       
1188        if(not $Type2{"Fields"}{$Field_Name})
1189        {# removed fields
1190            my $StraightPair_Name = findFieldPair($Field_Pos1, \%Type2);
1191            if($StraightPair_Name ne "lost" and not $Type1{"Fields"}{$StraightPair_Name}
1192            and $FieldType1_Name eq getTypeName($Type2{"Fields"}{$StraightPair_Name}{"Type"}, 2))
1193            {
1194                if(my $Constant = getConstantValue($Type1{"Fields"}{$Field_Name}{"Value"}, $FieldType1_Name))
1195                {
1196                    %{$SubProblems{"Renamed_Constant_Field"}{$Field_Name}}=(
1197                        "Target"=>$Field_Name,
1198                        "Type_Name"=>$Type1{"Name"},
1199                        "Old_Value"=>$Field_Name,
1200                        "New_Value"=>$StraightPair_Name,
1201                        "Field_Type"=>$FieldType1_Name,
1202                        "Field_Value"=>$Constant);
1203                }
1204                else
1205                {
1206                    %{$SubProblems{"Renamed_Field"}{$Field_Name}}=(
1207                        "Target"=>$Field_Name,
1208                        "Type_Name"=>$Type1{"Name"},
1209                        "Old_Value"=>$Field_Name,
1210                        "New_Value"=>$StraightPair_Name,
1211                        "Field_Type"=>$FieldType1_Name);
1212                }
1213            }
1214            else
1215            {
1216                if(my $Constant = getConstantValue($Type1{"Fields"}{$Field_Name}{"Value"}, $FieldType1_Name))
1217                { # has a compile-time constant value
1218                    %{$SubProblems{"Removed_Constant_Field"}{$Field_Name}}=(
1219                        "Target"=>$Field_Name,
1220                        "Type_Name"=>$Type1{"Name"},
1221                        "Field_Value"=>$Constant,
1222                        "Field_Type"=>$FieldType1_Name,
1223                        "Type_Type"=>$Type1{"Type"});
1224                }
1225                else
1226                {
1227                    %{$SubProblems{"Removed_NonConstant_Field"}{$Field_Name}}=(
1228                        "Target"=>$Field_Name,
1229                        "Type_Name"=>$Type1{"Name"},
1230                        "Type_Type"=>$Type1{"Type"},
1231                        "Field_Type"=>$FieldType1_Name);
1232                }
1233            }
1234            next;
1235        }
1236       
1237        my $FieldType2_Id = $Type2{"Fields"}{$Field_Name}{"Type"};
1238        my $FieldType2_Name = getTypeName($FieldType2_Id, 2);
1239       
1240        if(not $Type1{"Fields"}{$Field_Name}{"Static"}
1241        and $Type2{"Fields"}{$Field_Name}{"Static"})
1242        {
1243            if(not $Type1{"Fields"}{$Field_Name}{"Value"})
1244            {
1245                %{$SubProblems{"NonConstant_Field_Became_Static"}{$Field_Name}}=(
1246                    "Target"=>$Field_Name,
1247                    "Field_Type"=>$FieldType1_Name,
1248                    "Type_Name"=>$Type1{"Name"});
1249            }
1250        }
1251        elsif($Type1{"Fields"}{$Field_Name}{"Static"}
1252        and not $Type2{"Fields"}{$Field_Name}{"Static"})
1253        {
1254            if($Type1{"Fields"}{$Field_Name}{"Value"})
1255            {
1256                %{$SubProblems{"Constant_Field_Became_NonStatic"}{$Field_Name}}=(
1257                    "Target"=>$Field_Name,
1258                    "Field_Type"=>$FieldType1_Name,
1259                    "Type_Name"=>$Type1{"Name"});
1260            }
1261            else
1262            {
1263                %{$SubProblems{"NonConstant_Field_Became_NonStatic"}{$Field_Name}}=(
1264                    "Target"=>$Field_Name,
1265                    "Field_Type"=>$FieldType1_Name,
1266                    "Type_Name"=>$Type1{"Name"});
1267            }
1268        }
1269        if(not $Type1{"Fields"}{$Field_Name}{"Final"}
1270        and $Type2{"Fields"}{$Field_Name}{"Final"})
1271        {
1272            %{$SubProblems{"Field_Became_Final"}{$Field_Name}}=(
1273                "Target"=>$Field_Name,
1274                "Field_Type"=>$FieldType1_Name,
1275                "Type_Name"=>$Type1{"Name"});
1276        }
1277        elsif($Type1{"Fields"}{$Field_Name}{"Final"}
1278        and not $Type2{"Fields"}{$Field_Name}{"Final"})
1279        {
1280            %{$SubProblems{"Field_Became_NonFinal"}{$Field_Name}}=(
1281                "Target"=>$Field_Name,
1282                "Field_Type"=>$FieldType1_Name,
1283                "Type_Name"=>$Type1{"Name"});
1284        }
1285        my $Access2 = $Type2{"Fields"}{$Field_Name}{"Access"};
1286        if($Access1 eq "public" and $Access2=~/protected|private/
1287        or $Access1 eq "protected" and $Access2=~/private/)
1288        {
1289            if($Access2 eq "package-private")
1290            {
1291                %{$SubProblems{"Changed_Field_Access_To_Package_Private"}{$Field_Name}}=(
1292                    "Target"=>$Field_Name,
1293                    "Type_Name"=>$Type1{"Name"},
1294                    "Old_Value"=>$Access1,
1295                    "New_Value"=>$Access2);
1296            }
1297            else
1298            {
1299                %{$SubProblems{"Changed_Field_Access"}{$Field_Name}}=(
1300                    "Target"=>$Field_Name,
1301                    "Type_Name"=>$Type1{"Name"},
1302                    "Old_Value"=>$Access1,
1303                    "New_Value"=>$Access2);
1304            }
1305        }
1306       
1307        my $Value1 = getConstantValue($Type1{"Fields"}{$Field_Name}{"Value"}, $FieldType1_Name);
1308        my $Value2 = getConstantValue($Type2{"Fields"}{$Field_Name}{"Value"}, $FieldType2_Name);
1309       
1310        if($Value1 ne $Value2)
1311        {
1312            if($Value1 and $Value2)
1313            {
1314                if($Type1{"Fields"}{$Field_Name}{"Final"}
1315                and $Type2{"Fields"}{$Field_Name}{"Final"})
1316                {
1317                    if($Field_Name=~/(\A|_)(VERSION|VERNUM|BUILDNUMBER|BUILD)(_|\Z)/i)
1318                    {
1319                        %{$SubProblems{"Changed_Final_Version_Field_Value"}{$Field_Name}}=(
1320                            "Target"=>$Field_Name,
1321                            "Field_Type"=>$FieldType1_Name,
1322                            "Type_Name"=>$Type1{"Name"},
1323                            "Old_Value"=>$Value1,
1324                            "New_Value"=>$Value2);
1325                    }
1326                    else
1327                    {
1328                        %{$SubProblems{"Changed_Final_Field_Value"}{$Field_Name}}=(
1329                            "Target"=>$Field_Name,
1330                            "Field_Type"=>$FieldType1_Name,
1331                            "Type_Name"=>$Type1{"Name"},
1332                            "Old_Value"=>$Value1,
1333                            "New_Value"=>$Value2);
1334                    }
1335                }
1336            }
1337        }
1338       
1339        my %Sub_SubChanges = detectTypeChange($FieldType1_Id, $FieldType2_Id, "Field");
1340        foreach my $Sub_SubProblemType (keys(%Sub_SubChanges))
1341        {
1342            %{$SubProblems{$Sub_SubProblemType}{$Field_Name}}=(
1343                "Target"=>$Field_Name,
1344                "Type_Name"=>$Type1{"Name"});
1345           
1346            foreach my $Attr (keys(%{$Sub_SubChanges{$Sub_SubProblemType}}))
1347            {
1348                $SubProblems{$Sub_SubProblemType}{$Field_Name}{$Attr} = $Sub_SubChanges{$Sub_SubProblemType}{$Attr};
1349            }
1350        }
1351       
1352        if($FieldType1_Id and $FieldType2_Id)
1353        { # check field type change
1354            my $Sub_SubProblems = mergeTypes($FieldType1_Id, $FieldType2_Id);
1355            my %DupProblems = ();
1356           
1357            foreach my $Sub_SubProblemType (sort keys(%{$Sub_SubProblems}))
1358            {
1359                foreach my $Sub_SubLocation (sort {length($a)<=>length($b)} sort keys(%{$Sub_SubProblems->{$Sub_SubProblemType}}))
1360                {
1361                    if(not defined $In::Opt{"AllAffected"})
1362                    {
1363                        if(defined $DupProblems{$Sub_SubProblems->{$Sub_SubProblemType}{$Sub_SubLocation}}) {
1364                            next;
1365                        }
1366                    }
1367                   
1368                    my $NewLocation = ($Sub_SubLocation)?$Field_Name.".".$Sub_SubLocation:$Field_Name;
1369                    $SubProblems{$Sub_SubProblemType}{$NewLocation} = $Sub_SubProblems->{$Sub_SubProblemType}{$Sub_SubLocation};
1370                   
1371                    if(not defined $In::Opt{"AllAffected"})
1372                    {
1373                        $DupProblems{$Sub_SubProblems->{$Sub_SubProblemType}{$Sub_SubLocation}} = 1;
1374                    }
1375                }
1376            }
1377            %DupProblems = ();
1378        }
1379    }
1380   
1381    foreach my $Field_Name (sort keys(%{$Type2{"Fields"}}))
1382    { # check added fields
1383        if($Type2{"Fields"}{$Field_Name}{"Access"}=~/private/) {
1384            next;
1385        }
1386        my $FieldPos2 = $Type2{"Fields"}{$Field_Name}{"Pos"};
1387        my $FieldType2_Id = $Type2{"Fields"}{$Field_Name}{"Type"};
1388        my $FieldType2_Name = getTypeName($FieldType2_Id, 2);
1389       
1390        if(not $Type1{"Fields"}{$Field_Name})
1391        {# added fields
1392            my $StraightPair_Name = findFieldPair($FieldPos2, \%Type1);
1393            if($StraightPair_Name ne "lost" and not $Type2{"Fields"}{$StraightPair_Name}
1394            and getTypeName($Type1{"Fields"}{$StraightPair_Name}{"Type"}, 1) eq $FieldType2_Name)
1395            {
1396                # Already reported as "Renamed_Field" or "Renamed_Constant_Field"
1397            }
1398            else
1399            {
1400                if($Type1{"Type"} eq "interface")
1401                {
1402                    %{$SubProblems{"Interface_Added_Field"}{$Field_Name}}=(
1403                        "Target"=>$Field_Name,
1404                        "Type_Name"=>$Type1{"Name"});
1405                }
1406                else
1407                {
1408                    %{$SubProblems{"Class_Added_Field"}{$Field_Name}}=(
1409                        "Target"=>$Field_Name,
1410                        "Type_Name"=>$Type1{"Name"});
1411                }
1412            }
1413        }
1414    }
1415   
1416    pop(@RecurTypes);
1417    return ($Cache{"mergeTypes"}{$Type1_Id}{$Type2_Id} = \%SubProblems);
1418}
1419
1420sub checkDefaultImpl($$$)
1421{ # Check if all abstract methods of the super class have
1422  # default implementations in the class
1423    my ($LVer, $SuperClassName, $ClassName) = @_;
1424   
1425    foreach my $Method (keys(%{$Class_AbstractMethods{$LVer}{$SuperClassName}}))
1426    {
1427        if(my $Overridden = findMethod_Class($Method, $ClassName, $LVer))
1428        {
1429            if($MethodInfo{$LVer}{$Overridden}{"Abstract"}) {
1430                return 0;
1431            }
1432        }
1433        else {
1434            return 0;
1435        }
1436    }
1437   
1438    return 1;
1439}
1440
1441sub getMSuffix($)
1442{
1443    my $Method = $_[0];
1444    if($Method=~/(\(.*\))/) {
1445        return $1;
1446    }
1447    return "";
1448}
1449
1450sub getMShort($)
1451{
1452    my $Method = $_[0];
1453    if($Method=~/([^\.]+)\:\(/) {
1454        return $1;
1455    }
1456    return "";
1457}
1458
1459sub findMethod($$$$)
1460{
1461    my ($Method, $MethodVersion, $ClassName, $ClassVersion) = @_;
1462    my $ClassId = $TName_Tid{$ClassVersion}{$ClassName};
1463   
1464    if($ClassId)
1465    {
1466        my @Search = ();
1467        if(getTypeType($ClassId, $ClassVersion) eq "class")
1468        {
1469            if(my $SuperClassId = $TypeInfo{$ClassVersion}{$ClassId}{"SuperClass"}) {
1470                push(@Search, $SuperClassId);
1471            }
1472        }
1473       
1474        if(not defined $MethodInfo{$MethodVersion}{$Method}
1475        or $MethodInfo{$MethodVersion}{$Method}{"Abstract"})
1476        {
1477            if(my @SuperInterfaces = sort keys(%{$TypeInfo{$ClassVersion}{$ClassId}{"SuperInterface"}})) {
1478                push(@Search, @SuperInterfaces);
1479            }
1480        }
1481       
1482        foreach my $SuperId (@Search)
1483        {
1484            if($SuperId eq $ClassId) {
1485                next;
1486            }
1487           
1488            my $SuperName = getTypeName($SuperId, $ClassVersion);
1489           
1490            if(my $MethodInClass = findMethod_Class($Method, $SuperName, $ClassVersion)) {
1491                return $MethodInClass;
1492            }
1493            elsif(my $MethodInSuperClasses = findMethod($Method, $MethodVersion, $SuperName, $ClassVersion)) {
1494                return $MethodInSuperClasses;
1495            }
1496        }
1497    }
1498   
1499    my $TargetSuffix = getMSuffix($Method);
1500    my $TargetShortName = getMShort($Method);
1501   
1502    # search in java.lang.Object
1503    foreach my $C (keys(%JavaObjectMethod))
1504    {
1505        if($TargetSuffix eq getMSuffix($C))
1506        {
1507            if($TargetShortName eq getMShort($C)) {
1508                return $C;
1509            }
1510        }
1511    }
1512   
1513    return undef;
1514}
1515
1516sub findMethod_Class($$$)
1517{
1518    my ($Method, $ClassName, $ClassVersion) = @_;
1519    my $TargetSuffix = getMSuffix($Method);
1520    my $TargetShortName = getMShort($Method);
1521   
1522    if(not defined $Class_Methods{$ClassVersion}{$ClassName}) {
1523        return undef;
1524    }
1525   
1526    foreach my $Candidate (sort keys(%{$Class_Methods{$ClassVersion}{$ClassName}}))
1527    { # search for method with the same parameters suffix
1528        next if($MethodInfo{$ClassVersion}{$Candidate}{"Constructor"});
1529        if($TargetSuffix eq getMSuffix($Candidate))
1530        {
1531            if($TargetShortName eq getMShort($Candidate)) {
1532                return $Candidate;
1533            }
1534        }
1535    }
1536   
1537    return undef;
1538}
1539
1540sub prepareData($)
1541{
1542    my $LVer = $_[0];
1543   
1544    if(my $MUsed = $In::API{$LVer}{"MethodUsed"})
1545    {
1546        foreach my $M_Id (keys(%{$MUsed}))
1547        {
1548            my $Name = $MUsed->{$M_Id}{"Name"};
1549            $MethodUsed{$LVer}{$Name} = $MUsed->{$M_Id}{"Used"};
1550        }
1551    }
1552   
1553    foreach my $TypeId (keys(%{$TypeInfo{$LVer}}))
1554    {
1555        my $TypeAttr = $TypeInfo{$LVer}{$TypeId};
1556        my $TName = $TypeAttr->{"Name"};
1557       
1558        $TName_Tid{$LVer}{$TName} = $TypeId;
1559       
1560        if(not $TypeAttr->{"Dep"})
1561        {
1562            if(my $Archive = $TypeAttr->{"Archive"}) {
1563                $LibArchives{$LVer}{$Archive} = 1;
1564            }
1565        }
1566       
1567        foreach my $FieldName (keys(%{$TypeAttr->{"Fields"}}))
1568        {
1569            if($TypeAttr->{"Fields"}{$FieldName}{"Access"}=~/public|protected/) {
1570                $Class_Fields{$LVer}{$TName}{$FieldName} = $TypeAttr->{"Fields"}{$FieldName}{"Type"};
1571            }
1572        }
1573    }
1574   
1575    foreach my $Method (keys(%{$MethodInfo{$LVer}}))
1576    {
1577        my $Name = $MethodInfo{$LVer}{$Method}{"Name"};
1578        $MethodInfo{$LVer}{$Name} = delete($MethodInfo{$LVer}{$Method});
1579    }
1580   
1581    foreach my $Method (keys(%{$MethodInfo{$LVer}}))
1582    {
1583        my $MAttr = $MethodInfo{$LVer}{$Method};
1584       
1585        $MAttr->{"Signature"} = getSignature($Method, $LVer, "Full");
1586       
1587        if(my $ClassId = $MAttr->{"Class"}
1588        and $MAttr->{"Access"}=~/public|protected/)
1589        {
1590            my $CName = getTypeName($ClassId, $LVer);
1591            $Class_Methods{$LVer}{$CName}{$Method} = 1;
1592            if($MAttr->{"Abstract"}) {
1593                $Class_AbstractMethods{$LVer}{$CName}{$Method} = 1;
1594            }
1595        }
1596       
1597        if($MAttr->{"Access"}!~/private/)
1598        {
1599            if($MAttr->{"Constructor"}) {
1600                registerUsage($MAttr->{"Class"}, $LVer);
1601            }
1602            else {
1603                registerUsage($MAttr->{"Return"}, $LVer);
1604            }
1605        }
1606    }
1607}
1608
1609sub mergeMethods()
1610{
1611    foreach my $Method (sort keys(%{$MethodInfo{1}}))
1612    { # compare methods
1613        next if(not defined $MethodInfo{2}{$Method});
1614       
1615        if(not $MethodInfo{1}{$Method}{"Archive"}
1616        or not $MethodInfo{2}{$Method}{"Archive"}) {
1617            next;
1618        }
1619       
1620        if(not methodFilter($Method, 1)) {
1621            next;
1622        }
1623       
1624        my $ClassId1 = $MethodInfo{1}{$Method}{"Class"};
1625        my $Class1_Name = getTypeName($ClassId1, 1);
1626        my $Class1_Type = getTypeType($ClassId1, 1);
1627       
1628        $CheckedTypes{$Class1_Name} = 1;
1629        $CheckedMethods{$Method} = 1;
1630       
1631        if(not $MethodInfo{1}{$Method}{"Static"}
1632        and $Class1_Type eq "class" and not $Class_Constructed{1}{$ClassId1})
1633        { # class cannot be constructed or inherited by clients
1634          # non-static method cannot be called
1635            next;
1636        }
1637       
1638        # checking attributes
1639        if(not $MethodInfo{1}{$Method}{"Static"}
1640        and $MethodInfo{2}{$Method}{"Static"}) {
1641            %{$CompatProblems{$Method}{"Method_Became_Static"}{""}} = ();
1642        }
1643        elsif($MethodInfo{1}{$Method}{"Static"}
1644        and not $MethodInfo{2}{$Method}{"Static"}) {
1645            %{$CompatProblems{$Method}{"Method_Became_NonStatic"}{""}} = ();
1646        }
1647       
1648        if(not $MethodInfo{1}{$Method}{"Synchronized"}
1649        and $MethodInfo{2}{$Method}{"Synchronized"}) {
1650            %{$CompatProblems{$Method}{"Method_Became_Synchronized"}{""}} = ();
1651        }
1652        elsif($MethodInfo{1}{$Method}{"Synchronized"}
1653        and not $MethodInfo{2}{$Method}{"Synchronized"}) {
1654            %{$CompatProblems{$Method}{"Method_Became_NonSynchronized"}{""}} = ();
1655        }
1656       
1657        if(not $MethodInfo{1}{$Method}{"Final"}
1658        and $MethodInfo{2}{$Method}{"Final"})
1659        {
1660            if($MethodInfo{1}{$Method}{"Static"}) {
1661                %{$CompatProblems{$Method}{"Static_Method_Became_Final"}{""}} = ();
1662            }
1663            else {
1664                %{$CompatProblems{$Method}{"NonStatic_Method_Became_Final"}{""}} = ();
1665            }
1666        }
1667       
1668        my $Access1 = $MethodInfo{1}{$Method}{"Access"};
1669        my $Access2 = $MethodInfo{2}{$Method}{"Access"};
1670       
1671        if($Access1 eq "public" and $Access2=~/protected|private/
1672        or $Access1 eq "protected" and $Access2=~/private/)
1673        {
1674            %{$CompatProblems{$Method}{"Changed_Method_Access"}{""}} = (
1675                "Old_Value"=>$Access1,
1676                "New_Value"=>$Access2);
1677        }
1678       
1679        my $Class2_Type = getTypeType($MethodInfo{2}{$Method}{"Class"}, 2);
1680       
1681        if($Class1_Type eq "class"
1682        and $Class2_Type eq "class")
1683        {
1684            if(not $MethodInfo{1}{$Method}{"Abstract"}
1685            and $MethodInfo{2}{$Method}{"Abstract"})
1686            {
1687                %{$CompatProblems{$Method}{"Method_Became_Abstract"}{""}} = ();
1688                %{$CompatProblems{$Method}{"Class_Method_Became_Abstract"}{"this.".getSFormat($Method)}} = (
1689                    "Type_Name"=>$Class1_Name,
1690                    "Target"=>$Method);
1691            }
1692            elsif($MethodInfo{1}{$Method}{"Abstract"}
1693            and not $MethodInfo{2}{$Method}{"Abstract"})
1694            {
1695                %{$CompatProblems{$Method}{"Method_Became_NonAbstract"}{""}} = ();
1696                %{$CompatProblems{$Method}{"Class_Method_Became_NonAbstract"}{"this.".getSFormat($Method)}} = (
1697                    "Type_Name"=>$Class1_Name,
1698                    "Target"=>$Method);
1699            }
1700        }
1701        elsif($Class1_Type eq "interface"
1702        and $Class2_Type eq "interface")
1703        {
1704            if(not $MethodInfo{1}{$Method}{"Abstract"}
1705            and $MethodInfo{2}{$Method}{"Abstract"})
1706            {
1707                %{$CompatProblems{$Method}{"Method_Became_NonDefault"}{""}} = ();
1708                %{$CompatProblems{$Method}{"Interface_Method_Became_NonDefault"}{"this.".getSFormat($Method)}} = (
1709                    "Type_Name"=>$Class1_Name,
1710                    "Target"=>$Method);
1711            }
1712            elsif($MethodInfo{1}{$Method}{"Abstract"}
1713            and not $MethodInfo{2}{$Method}{"Abstract"})
1714            {
1715                %{$CompatProblems{$Method}{"Method_Became_Default"}{""}} = ();
1716                %{$CompatProblems{$Method}{"Interface_Method_Became_Default"}{"this.".getSFormat($Method)}} = (
1717                    "Type_Name"=>$Class1_Name,
1718                    "Target"=>$Method);
1719            }
1720        }
1721       
1722        my %Exceptions_Old = map {getTypeName($_, 1) => $_} keys(%{$MethodInfo{1}{$Method}{"Exceptions"}});
1723        my %Exceptions_New = map {getTypeName($_, 2) => $_} keys(%{$MethodInfo{2}{$Method}{"Exceptions"}});
1724        foreach my $Exception (keys(%Exceptions_Old))
1725        {
1726            if(not $Exceptions_New{$Exception})
1727            {
1728                my $EType = getType($Exceptions_Old{$Exception}, 1);
1729                my $SuperClass = $EType->{"SuperClass"};
1730               
1731                if($KnownRuntimeExceptions{$Exception}
1732                or defined $SuperClass and getTypeName($SuperClass, 1) eq "java.lang.RuntimeException")
1733                {
1734                    if(not $MethodInfo{1}{$Method}{"Abstract"}
1735                    and not $MethodInfo{2}{$Method}{"Abstract"})
1736                    {
1737                        %{$CompatProblems{$Method}{"Removed_Unchecked_Exception"}{"this.".getSFormat($Exception)}} = (
1738                            "Type_Name"=>$Class1_Name,
1739                            "Target"=>$Exception);
1740                    }
1741                }
1742                else
1743                {
1744                    if($MethodInfo{1}{$Method}{"Abstract"}
1745                    and $MethodInfo{2}{$Method}{"Abstract"})
1746                    {
1747                        %{$CompatProblems{$Method}{"Abstract_Method_Removed_Checked_Exception"}{"this.".getSFormat($Exception)}} = (
1748                            "Type_Name"=>$Class1_Name,
1749                            "Target"=>$Exception);
1750                    }
1751                    else
1752                    {
1753                        %{$CompatProblems{$Method}{"NonAbstract_Method_Removed_Checked_Exception"}{"this.".getSFormat($Exception)}} = (
1754                            "Type_Name"=>$Class1_Name,
1755                            "Target"=>$Exception);
1756                    }
1757                }
1758            }
1759        }
1760       
1761        foreach my $Exception (keys(%Exceptions_New))
1762        {
1763            if(not $Exceptions_Old{$Exception})
1764            {
1765                my $EType = getType($Exceptions_New{$Exception}, 2);
1766                my $SuperClass = $EType->{"SuperClass"};
1767               
1768                if($KnownRuntimeExceptions{$Exception}
1769                or defined $SuperClass and getTypeName($SuperClass, 2) eq "java.lang.RuntimeException")
1770                {
1771                    if(not $MethodInfo{1}{$Method}{"Abstract"}
1772                    and not $MethodInfo{2}{$Method}{"Abstract"})
1773                    {
1774                        %{$CompatProblems{$Method}{"Added_Unchecked_Exception"}{"this.".getSFormat($Exception)}} = (
1775                            "Type_Name"=>$Class1_Name,
1776                            "Target"=>$Exception);
1777                    }
1778                }
1779                else
1780                {
1781                    if($MethodInfo{1}{$Method}{"Abstract"}
1782                    and $MethodInfo{2}{$Method}{"Abstract"})
1783                    {
1784                        %{$CompatProblems{$Method}{"Abstract_Method_Added_Checked_Exception"}{"this.".getSFormat($Exception)}} = (
1785                            "Type_Name"=>$Class1_Name,
1786                            "Target"=>$Exception);
1787                    }
1788                    else
1789                    {
1790                        %{$CompatProblems{$Method}{"NonAbstract_Method_Added_Checked_Exception"}{"this.".getSFormat($Exception)}} = (
1791                            "Type_Name"=>$Class1_Name,
1792                            "Target"=>$Exception);
1793                    }
1794                }
1795            }
1796        }
1797       
1798        if(defined $MethodInfo{1}{$Method}{"Param"})
1799        {
1800            foreach my $ParamPos (sort {int($a) <=> int($b)} keys(%{$MethodInfo{1}{$Method}{"Param"}}))
1801            { # checking parameters
1802                mergeParameters($Method, $ParamPos, $ParamPos);
1803            }
1804        }
1805       
1806        # check object type
1807        my $ObjectType1_Id = $MethodInfo{1}{$Method}{"Class"};
1808        my $ObjectType2_Id = $MethodInfo{2}{$Method}{"Class"};
1809        if($ObjectType1_Id and $ObjectType2_Id)
1810        {
1811            my $SubProblems = mergeTypes($ObjectType1_Id, $ObjectType2_Id);
1812            foreach my $SubProblemType (keys(%{$SubProblems}))
1813            {
1814                foreach my $SubLocation (keys(%{$SubProblems->{$SubProblemType}}))
1815                {
1816                    my $NewLocation = ($SubLocation)?"this.".$SubLocation:"this";
1817                    $CompatProblems{$Method}{$SubProblemType}{$NewLocation} = $SubProblems->{$SubProblemType}{$SubLocation};
1818                }
1819            }
1820        }
1821        # check return type
1822        my $ReturnType1_Id = $MethodInfo{1}{$Method}{"Return"};
1823        my $ReturnType2_Id = $MethodInfo{2}{$Method}{"Return"};
1824        if($ReturnType1_Id and $ReturnType2_Id)
1825        {
1826            my $SubProblems = mergeTypes($ReturnType1_Id, $ReturnType2_Id);
1827            foreach my $SubProblemType (keys(%{$SubProblems}))
1828            {
1829                foreach my $SubLocation (keys(%{$SubProblems->{$SubProblemType}}))
1830                {
1831                    my $NewLocation = ($SubLocation)?"retval.".$SubLocation:"retval";
1832                    $CompatProblems{$Method}{$SubProblemType}{$NewLocation} = $SubProblems->{$SubProblemType}{$SubLocation};
1833                }
1834            }
1835        }
1836    }
1837}
1838
1839sub mergeParameters($$$)
1840{
1841    my ($Method, $ParamPos1, $ParamPos2) = @_;
1842    if(not $Method or not defined $MethodInfo{1}{$Method}{"Param"}
1843    or not defined $MethodInfo{2}{$Method}{"Param"}) {
1844        return;
1845    }
1846   
1847    my $ParamType1_Id = $MethodInfo{1}{$Method}{"Param"}{$ParamPos1}{"Type"};
1848    my $ParamType2_Id = $MethodInfo{2}{$Method}{"Param"}{$ParamPos2}{"Type"};
1849   
1850    if(not $ParamType1_Id or not $ParamType2_Id) {
1851        return;
1852    }
1853   
1854    my $Parameter_Name = $MethodInfo{1}{$Method}{"Param"}{$ParamPos1}{"Name"};
1855    my $Parameter_Location = ($Parameter_Name)?$Parameter_Name:showPos($ParamPos1)." Parameter";
1856   
1857    # checking type declaration changes
1858    my $SubProblems = mergeTypes($ParamType1_Id, $ParamType2_Id);
1859    foreach my $SubProblemType (keys(%{$SubProblems}))
1860    {
1861        foreach my $SubLocation (keys(%{$SubProblems->{$SubProblemType}}))
1862        {
1863            my $NewLocation = ($SubLocation)?$Parameter_Location.".".$SubLocation:$Parameter_Location;
1864            $CompatProblems{$Method}{$SubProblemType}{$NewLocation} = $SubProblems->{$SubProblemType}{$SubLocation};
1865        }
1866    }
1867}
1868
1869sub detectTypeChange($$$)
1870{
1871    my ($Type1_Id, $Type2_Id, $Prefix) = @_;
1872    my %LocalProblems = ();
1873   
1874    my $Type1 = getType($Type1_Id, 1);
1875    my $Type2 = getType($Type2_Id, 2);
1876   
1877    my $Type1_Name = $Type1->{"Name"};
1878    my $Type2_Name = $Type2->{"Name"};
1879   
1880    my $Type1_Base = undef;
1881    my $Type2_Base = undef;
1882   
1883    if($Type1->{"Type"} eq "array") {
1884        $Type1_Base = getOneStepBaseType($Type1_Id, 1);
1885    }
1886    else {
1887        $Type1_Base = getBaseType($Type1_Id, 1);
1888    }
1889   
1890    if($Type2->{"Type"} eq "array") {
1891        $Type2_Base = getOneStepBaseType($Type2_Id, 2);
1892    }
1893    else {
1894        $Type2_Base = getBaseType($Type2_Id, 2);
1895    }
1896   
1897    return () if(not $Type1_Name or not $Type2_Name);
1898    return () if(not $Type1_Base->{"Name"} or not $Type2_Base->{"Name"});
1899    if($Type1_Base->{"Name"} ne $Type2_Base->{"Name"} and $Type1_Name eq $Type2_Name)
1900    {# base type change
1901        %{$LocalProblems{"Changed_".$Prefix."_BaseType"}}=(
1902            "Old_Value"=>$Type1_Base->{"Name"},
1903            "New_Value"=>$Type2_Base->{"Name"});
1904    }
1905    elsif($Type1_Name ne $Type2_Name)
1906    {# type change
1907        %{$LocalProblems{"Changed_".$Prefix."_Type"}}=(
1908            "Old_Value"=>$Type1_Name,
1909            "New_Value"=>$Type2_Name);
1910    }
1911    return %LocalProblems;
1912}
1913
1914sub specChars($)
1915{
1916    my $Str = $_[0];
1917    if(not defined $Str
1918    or $Str eq "") {
1919        return "";
1920    }
1921    $Str=~s/\&([^#]|\Z)/&amp;$1/g;
1922    $Str=~s/</&lt;/g;
1923    $Str=~s/\-\>/&#45;&gt;/g; # &minus;
1924    $Str=~s/>/&gt;/g;
1925    $Str=~s/([^ ])( )([^ ])/$1\@ALONE_SP\@$3/g;
1926    $Str=~s/ /&#160;/g; # &nbsp;
1927    $Str=~s/\@ALONE_SP\@/ /g;
1928    $Str=~s/\n/<br\/>/g;
1929    $Str=~s/\"/&quot;/g;
1930    $Str=~s/\'/&#39;/g;
1931    return $Str;
1932}
1933
1934sub blackName($)
1935{
1936    my $N = $_[0];
1937    return "<span class='iname_b'>".$N."</span>";
1938}
1939
1940sub highLight_ItalicColor($$)
1941{
1942    my ($M, $V) = @_;
1943    return getSignature($M, $V, "Full|HTML|Italic|Color");
1944}
1945
1946sub getSignature($$$)
1947{
1948    my ($Method, $LVer, $Kind) = @_;
1949    if(defined $Cache{"getSignature"}{$LVer}{$Method}{$Kind}) {
1950        return $Cache{"getSignature"}{$LVer}{$Method}{$Kind};
1951    }
1952   
1953    # settings
1954    my ($Full, $Html, $Simple, $Italic, $Color,
1955    $ShowParams, $ShowClass, $ShowAttr, $Desc, $Target) = (0, 0, 0, 0, 0, 0, 0, 0, 0, undef);
1956   
1957    if($Kind=~/Full/) {
1958        $Full = 1;
1959    }
1960    if($Kind=~/HTML/) {
1961        $Html = 1;
1962    }
1963    if($Kind=~/Simple/) {
1964        $Simple = 1;
1965    }
1966    if($Kind=~/Italic/) {
1967        $Italic = 1;
1968    }
1969    if($Kind=~/Color/) {
1970        $Color = 1;
1971    }
1972    if($Kind=~/Target=(\d+)/) {
1973        $Target = $1;
1974    }
1975    if($Kind=~/Param/) {
1976        $ShowParams = 1;
1977    }
1978    if($Kind=~/Class/) {
1979        $ShowClass = 1;
1980    }
1981    if($Kind=~/Attr/) {
1982        $ShowAttr = 1;
1983    }
1984    if($Kind=~/Desc/) {
1985        $Desc = 1;
1986    }
1987   
1988    if(not defined $MethodInfo{$LVer}{$Method}{"ShortName"})
1989    { # from java.lang.Object
1990        if($Html or $Simple) {
1991            return specChars($Method);
1992        }
1993        else {
1994            return $Method;
1995        }
1996    }
1997   
1998    my $Signature = $MethodInfo{$LVer}{$Method}{"ShortName"};
1999    if($Full or $ShowClass)
2000    {
2001        my $Class = getTypeName($MethodInfo{$LVer}{$Method}{"Class"}, $LVer);
2002       
2003        if($In::Opt{"HideTemplates"}) {
2004            $Class=~s/<.*>//g;
2005        }
2006       
2007        if($Html) {
2008            $Class = specChars($Class);
2009        }
2010       
2011        $Signature = $Class.".".$Signature;
2012    }
2013    my @Params = ();
2014   
2015    if(defined $MethodInfo{$LVer}{$Method}{"Param"})
2016    {
2017        foreach my $PPos (sort {int($a)<=>int($b)}
2018        keys(%{$MethodInfo{$LVer}{$Method}{"Param"}}))
2019        {
2020            my $PTid = $MethodInfo{$LVer}{$Method}{"Param"}{$PPos}{"Type"};
2021            if(my $PTName = getTypeName($PTid, $LVer))
2022            {
2023                if($In::Opt{"HideTemplates"}) {
2024                    $PTName=~s/<.*>//g;
2025                }
2026               
2027                if(not $In::Opt{"ShowPackages"}) {
2028                    $PTName=~s/(\A|\<\s*|\,\s*)[a-z0-9\.]+\./$1/g;
2029                }
2030               
2031                if($Html) {
2032                    $PTName = specChars($PTName);
2033                }
2034               
2035                if($Full or $ShowParams)
2036                {
2037                    my $PName = $MethodInfo{$LVer}{$Method}{"Param"}{$PPos}{"Name"};
2038                   
2039                    if($Simple) {
2040                        $PName = "<i>$PName</i>";
2041                    }
2042                    elsif($Html)
2043                    {
2044                        my $Style = "param";
2045                       
2046                        if(defined $Target
2047                        and $Target==$PPos) {
2048                            $PName = "<span class='focus_p'>$PName</span>";
2049                        }
2050                        elsif($Color) {
2051                            $PName = "<span class='color_p'>$PName</span>";
2052                        }
2053                        else {
2054                            $PName = "<i>$PName</i>";
2055                        }
2056                    }
2057                   
2058                    push(@Params, $PTName." ".$PName);
2059                }
2060                else {
2061                    push(@Params, $PTName);
2062                }
2063            }
2064        }
2065    }
2066   
2067    if($Simple) {
2068        $Signature = "<b>".$Signature."</b>";
2069    }
2070   
2071    if($Html and not $Simple)
2072    {
2073        $Signature .= "&#160;";
2074        if($Desc) {
2075            $Signature .= "<span class='sym_pd'>";
2076        }
2077        else {
2078            $Signature .= "<span class='sym_p'>";
2079        }
2080        if(@Params)
2081        {
2082            foreach my $Pos (0 .. $#Params)
2083            {
2084                my $Name = "";
2085               
2086                if($Pos==0) {
2087                    $Name .= "(&#160;";
2088                }
2089               
2090                $Name .= $Params[$Pos];
2091               
2092                $Name = "<span>".$Name."</span>";
2093               
2094                if($Pos==$#Params) {
2095                    $Name .= "&#160;)";
2096                }
2097                else {
2098                    $Name .= ", ";
2099                }
2100               
2101                $Signature .= $Name;
2102            }
2103        }
2104        else {
2105            $Signature .= "(&#160;)";
2106        }
2107        $Signature .= "</span>";
2108    }
2109    else
2110    {
2111        if(@Params) {
2112            $Signature .= " ( ".join(", ", @Params)." )";
2113        }
2114        else {
2115            $Signature .= " ( )";
2116        }
2117    }
2118   
2119    if($Full or $ShowAttr)
2120    {
2121        if($MethodInfo{$LVer}{$Method}{"Static"}) {
2122            $Signature .= " [static]";
2123        }
2124        elsif($MethodInfo{$LVer}{$Method}{"Abstract"}) {
2125            $Signature .= " [abstract]";
2126        }
2127    }
2128   
2129    if($Full)
2130    {
2131        if($In::Opt{"ShowAccess"})
2132        {
2133            if(my $Access = $MethodInfo{$LVer}{$Method}{"Access"})
2134            {
2135                if($Access ne "public") {
2136                    $Signature .= " [".$Access."]";
2137                }
2138            }
2139        }
2140       
2141        if(my $ReturnId = $MethodInfo{$LVer}{$Method}{"Return"})
2142        {
2143            my $RName = getTypeName($ReturnId, $LVer);
2144           
2145            if($In::Opt{"HideTemplates"}) {
2146                $RName=~s/<.*>//g;
2147            }
2148           
2149            if(not $In::Opt{"ShowPackages"}) {
2150                $RName=~s/(\A|\<\s*|\,\s*)[a-z0-9\.]+\./$1/g;
2151            }
2152           
2153            if($Simple) {
2154                $Signature .= " <b>:</b> ".specChars($RName);
2155            }
2156            elsif($Html) {
2157                $Signature .= "<span class='sym_p nowrap'> &#160;<b>:</b>&#160;&#160;".specChars($RName)."</span>";
2158            }
2159            else {
2160                $Signature .= " : ".$RName;
2161            }
2162        }
2163       
2164        if(not $In::Opt{"SkipDeprecated"})
2165        {
2166            if($MethodInfo{$LVer}{$Method}{"Deprecated"}) {
2167                $Signature .= " *DEPRECATED*";
2168            }
2169        }
2170    }
2171   
2172    $Signature=~s/java\.lang\.//g;
2173   
2174    if($Html)
2175    {
2176        if(not $In::Opt{"SkipDeprecated"}) {
2177            $Signature=~s!(\*deprecated\*)!<span class='deprecated'>$1</span>!ig;
2178        }
2179       
2180        $Signature=~s!(\[static\]|\[abstract\]|\[public\]|\[private\]|\[protected\])!<span class='attr'>$1</span>!g;
2181    }
2182   
2183    if($Simple) {
2184        $Signature=~s/\[\]/\[ \]/g;
2185    }
2186    elsif($Html)
2187    {
2188        $Signature=~s!\[\]![&#160;]!g;
2189        $Signature=~s!operator=!operator&#160;=!g;
2190    }
2191   
2192    return ($Cache{"getSignature"}{$LVer}{$Method}{$Kind} = $Signature);
2193}
2194
2195sub getReportHeader($)
2196{
2197    my $Level = $_[0];
2198    my $Report_Header = "<h1>";
2199    if($Level eq "Source") {
2200        $Report_Header .= "Source compatibility";
2201    }
2202    elsif($Level eq "Binary") {
2203        $Report_Header .= "Binary compatibility";
2204    }
2205    else {
2206        $Report_Header .= "API compatibility";
2207    }
2208    $Report_Header .= " report for the <span style='color:Blue;'>".$In::Opt{"TargetTitle"}."</span> library between <span style='color:Red;'>".$In::Desc{1}{"Version"}."</span> and <span style='color:Red;'>".$In::Desc{2}{"Version"}."</span> versions";
2209    if($In::Opt{"ClientPath"}) {
2210        $Report_Header .= " (concerning portability of the client: <span style='color:Blue;'>".getFilename($In::Opt{"ClientPath"})."</span>)";
2211    }
2212    $Report_Header .= "</h1>\n";
2213    return $Report_Header;
2214}
2215
2216sub getSourceInfo()
2217{
2218    my $CheckedArchives = "<a name='Checked_Archives'></a>";
2219    if($In::Opt{"OldStyle"}) {
2220        $CheckedArchives .= "<h2>Java Archives (".keys(%{$LibArchives{1}}).")</h2>";
2221    }
2222    else {
2223        $CheckedArchives .= "<h2>Java Archives <span class='gray'>&nbsp;".keys(%{$LibArchives{1}})."&nbsp;</span></h2>";
2224    }
2225    $CheckedArchives .= "\n<hr/><div class='jar_list'>\n";
2226    foreach my $ArchivePath (sort {lc($a) cmp lc($b)}  keys(%{$LibArchives{1}})) {
2227        $CheckedArchives .= getFilename($ArchivePath)."<br/>\n";
2228    }
2229    $CheckedArchives .= "</div><br/>$TOP_REF<br/>\n";
2230    return $CheckedArchives;
2231}
2232
2233sub getTypeProblemsCount($$)
2234{
2235    my ($TargetSeverity, $Level) = @_;
2236    my $Type_Problems_Count = 0;
2237   
2238    foreach my $Type_Name (sort keys(%{$TypeChanges{$Level}}))
2239    {
2240        my %Kinds_Target = ();
2241        foreach my $Kind (sort keys(%{$TypeChanges{$Level}{$Type_Name}}))
2242        {
2243            if($CompatRules{$Level}{$Kind}{"Severity"} ne $TargetSeverity) {
2244                next;
2245            }
2246           
2247            foreach my $Location (sort keys(%{$TypeChanges{$Level}{$Type_Name}{$Kind}}))
2248            {
2249                my $Target = $TypeChanges{$Level}{$Type_Name}{$Kind}{$Location}{"Target"};
2250               
2251                if($Kinds_Target{$Kind}{$Target}) {
2252                    next;
2253                }
2254               
2255                $Kinds_Target{$Kind}{$Target} = 1;
2256                $Type_Problems_Count += 1;
2257            }
2258        }
2259    }
2260   
2261    return $Type_Problems_Count;
2262}
2263
2264sub showNum($)
2265{
2266    if($_[0])
2267    {
2268        my $Num = cutNum($_[0], 2, 0);
2269        if($Num eq "0")
2270        {
2271            foreach my $P (3 .. 7)
2272            {
2273                $Num = cutNum($_[0], $P, 1);
2274                if($Num ne "0") {
2275                    last;
2276                }
2277            }
2278        }
2279        if($Num eq "0") {
2280            $Num = $_[0];
2281        }
2282        return $Num;
2283    }
2284    return $_[0];
2285}
2286
2287sub cutNum($$$)
2288{
2289    my ($num, $digs_to_cut, $z) = @_;
2290    if($num!~/\./)
2291    {
2292        $num .= ".";
2293        foreach (1 .. $digs_to_cut-1) {
2294            $num .= "0";
2295        }
2296    }
2297    elsif($num=~/\.(.+)\Z/ and length($1)<$digs_to_cut-1)
2298    {
2299        foreach (1 .. $digs_to_cut - 1 - length($1)) {
2300            $num .= "0";
2301        }
2302    }
2303    elsif($num=~/\d+\.(\d){$digs_to_cut,}/) {
2304      $num=sprintf("%.".($digs_to_cut-1)."f", $num);
2305    }
2306    $num=~s/\.[0]+\Z//g;
2307    if($z) {
2308        $num=~s/(\.[1-9]+)[0]+\Z/$1/g;
2309    }
2310    return $num;
2311}
2312
2313sub getSummary($)
2314{
2315    my $Level = $_[0];
2316    my ($Added, $Removed, $M_Problems_High, $M_Problems_Medium, $M_Problems_Low,
2317    $T_Problems_High, $T_Problems_Medium, $T_Problems_Low, $M_Other, $T_Other) = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
2318   
2319    %{$RESULT{$Level}} = (
2320        "Problems"=>0,
2321        "Warnings"=>0,
2322        "Affected"=>0);
2323   
2324    foreach my $Method (sort keys(%CompatProblems))
2325    {
2326        foreach my $Kind (sort keys(%{$CompatProblems{$Method}}))
2327        {
2328            if($CompatRules{$Level}{$Kind}{"Kind"} eq "Methods")
2329            {
2330                my $Severity = $CompatRules{$Level}{$Kind}{"Severity"};
2331                foreach my $Loc (sort keys(%{$CompatProblems{$Method}{$Kind}}))
2332                {
2333                    if($Kind eq "Added_Method")
2334                    {
2335                        if($Level eq "Source")
2336                        {
2337                            if($ChangedReturnFromVoid{$Method}) {
2338                                next;
2339                            }
2340                        }
2341                        $Added+=1;
2342                    }
2343                    elsif($Kind eq "Removed_Method")
2344                    {
2345                        if($Level eq "Source")
2346                        {
2347                            if($ChangedReturnFromVoid{$Method}) {
2348                                next;
2349                            }
2350                        }
2351                        $Removed+=1;
2352                        $TotalAffected{$Level}{$Method} = $Severity;
2353                    }
2354                    else
2355                    {
2356                        if($Severity eq "Safe") {
2357                            $M_Other += 1;
2358                        }
2359                        elsif($Severity eq "High") {
2360                            $M_Problems_High+=1;
2361                        }
2362                        elsif($Severity eq "Medium") {
2363                            $M_Problems_Medium+=1;
2364                        }
2365                        elsif($Severity eq "Low") {
2366                            $M_Problems_Low+=1;
2367                        }
2368                        if(($Severity ne "Low" or $In::Opt{"StrictCompat"})
2369                        and $Severity ne "Safe") {
2370                            $TotalAffected{$Level}{$Method} = $Severity;
2371                        }
2372                    }
2373                }
2374            }
2375        }
2376    }
2377   
2378    my %MethodTypeIndex = ();
2379   
2380    foreach my $Method (sort keys(%CompatProblems))
2381    {
2382        foreach my $Kind (sort keys(%{$CompatProblems{$Method}}))
2383        {
2384            if($CompatRules{$Level}{$Kind}{"Kind"} eq "Types")
2385            {
2386                my $Severity = $CompatRules{$Level}{$Kind}{"Severity"};
2387                if(($Severity ne "Low" or $In::Opt{"StrictCompat"})
2388                and $Severity ne "Safe")
2389                {
2390                    if(my $Sev = $TotalAffected{$Level}{$Method})
2391                    {
2392                        if($Severity_Val{$Severity}>$Severity_Val{$Sev}) {
2393                            $TotalAffected{$Level}{$Method} = $Severity;
2394                        }
2395                    }
2396                    else {
2397                        $TotalAffected{$Level}{$Method} = $Severity;
2398                    }
2399                }
2400               
2401                my $MK = $CompatProblems{$Method}{$Kind};
2402                my (@Locs1, @Locs2) = ();
2403                foreach my $Loc (sort {length($a)<=>length($b)} sort keys(%{$MK}))
2404                {
2405                    if(index($Loc, "retval")==0 or index($Loc, "this")==0) {
2406                        push(@Locs2, $Loc);
2407                    }
2408                    else {
2409                        push(@Locs1, $Loc);
2410                    }
2411                }
2412                foreach my $Loc (@Locs1, @Locs2)
2413                {
2414                    my $Type = $MK->{$Loc}{"Type_Name"};
2415                    my $Target = $MK->{$Loc}{"Target"};
2416                   
2417                    if(defined $MethodTypeIndex{$Method}{$Type}{$Kind}{$Target})
2418                    { # one location for one type and target
2419                        next;
2420                    }
2421                    $MethodTypeIndex{$Method}{$Type}{$Kind}{$Target} = 1;
2422                   
2423                    $TypeChanges{$Level}{$Type}{$Kind}{$Loc} = $MK->{$Loc};
2424                    $TypeProblemsIndex{$Level}{$Type}{$Kind}{$Loc}{$Method} = 1;
2425                }
2426            }
2427        }
2428    }
2429   
2430    %MethodTypeIndex = (); # clear memory
2431   
2432    $T_Problems_High = getTypeProblemsCount("High", $Level);
2433    $T_Problems_Medium = getTypeProblemsCount("Medium", $Level);
2434    $T_Problems_Low = getTypeProblemsCount("Low", $Level);
2435    $T_Other = getTypeProblemsCount("Safe", $Level);
2436   
2437    my $SCount = keys(%CheckedMethods)-$Added;
2438    if($SCount)
2439    {
2440        my %Weight = (
2441            "High" => 100,
2442            "Medium" => 50,
2443            "Low" => 25
2444        );
2445        foreach (keys(%{$TotalAffected{$Level}})) {
2446            $RESULT{$Level}{"Affected"}+=$Weight{$TotalAffected{$Level}{$_}};
2447        }
2448        $RESULT{$Level}{"Affected"} = $RESULT{$Level}{"Affected"}/$SCount;
2449    }
2450    else {
2451        $RESULT{$Level}{"Affected"} = 0;
2452    }
2453    $RESULT{$Level}{"Affected"} = showNum($RESULT{$Level}{"Affected"});
2454    if($RESULT{$Level}{"Affected"}>=100) {
2455        $RESULT{$Level}{"Affected"} = 100;
2456    }
2457   
2458    my ($TestInfo, $TestResults, $Problem_Summary) = ();
2459   
2460    # test info
2461    $TestInfo .= "<h2>Test Info</h2><hr/>\n";
2462    $TestInfo .= "<table class='summary'>\n";
2463    $TestInfo .= "<tr><th>Library Name</th><td>".$In::Opt{"TargetTitle"}."</td></tr>\n";
2464    $TestInfo .= "<tr><th>Version #1</th><td>".$In::Desc{1}{"Version"}."</td></tr>\n";
2465    $TestInfo .= "<tr><th>Version #2</th><td>".$In::Desc{2}{"Version"}."</td></tr>\n";
2466   
2467    if($In::Opt{"JoinReport"})
2468    {
2469        if($Level eq "Binary") {
2470            $TestInfo .= "<tr><th>Subject</th><td width='150px'>Binary Compatibility</td></tr>\n"; # Run-time
2471        }
2472        if($Level eq "Source") {
2473            $TestInfo .= "<tr><th>Subject</th><td width='150px'>Source Compatibility</td></tr>\n"; # Build-time
2474        }
2475    }
2476    $TestInfo .= "</table>\n";
2477   
2478    # test results
2479    $TestResults .= "<h2>Test Results</h2><hr/>\n";
2480    $TestResults .= "<table class='summary'>\n";
2481   
2482    my $Checked_Archives_Link = "0";
2483    $Checked_Archives_Link = "<a href='#Checked_Archives' style='color:Blue;'>".keys(%{$LibArchives{1}})."</a>" if(keys(%{$LibArchives{1}})>0);
2484   
2485    $TestResults .= "<tr><th>Total JARs</th><td>$Checked_Archives_Link</td></tr>\n";
2486    $TestResults .= "<tr><th>Total Methods / Classes</th><td>".keys(%CheckedMethods)." / ".keys(%CheckedTypes)."</td></tr>\n";
2487   
2488    $RESULT{$Level}{"Problems"} += $Removed+$M_Problems_High+$T_Problems_High+$T_Problems_Medium+$M_Problems_Medium;
2489    if($In::Opt{"StrictCompat"}) {
2490        $RESULT{$Level}{"Problems"}+=$T_Problems_Low+$M_Problems_Low;
2491    }
2492    else {
2493        $RESULT{$Level}{"Warnings"}+=$T_Problems_Low+$M_Problems_Low;
2494    }
2495   
2496    my $META_DATA = "kind:".lc($Level).";";
2497    $META_DATA .= $RESULT{$Level}{"Problems"}?"verdict:incompatible;":"verdict:compatible;";
2498    $TestResults .= "<tr><th>Compatibility</th>\n";
2499   
2500    my $BC_Rate = showNum(100 - $RESULT{$Level}{"Affected"});
2501   
2502    if($RESULT{$Level}{"Problems"})
2503    {
2504        my $Cl = "incompatible";
2505        if($BC_Rate>=90) {
2506            $Cl = "warning";
2507        }
2508        elsif($BC_Rate>=80) {
2509            $Cl = "almost_compatible";
2510        }
2511       
2512        $TestResults .= "<td class=\'$Cl\'>".$BC_Rate."%</td>\n";
2513    }
2514    else
2515    {
2516        $TestResults .= "<td class=\'compatible\'>100%</td>\n";
2517    }
2518   
2519    $TestResults .= "</tr>\n";
2520    $TestResults .= "</table>\n";
2521   
2522    $META_DATA .= "affected:".$RESULT{$Level}{"Affected"}.";";# in percents
2523   
2524    # Problem Summary
2525    $Problem_Summary .= "<h2>Problem Summary</h2><hr/>\n";
2526    $Problem_Summary .= "<table class='summary'>\n";
2527    $Problem_Summary .= "<tr><th></th><th style='text-align:center;'>Severity</th><th style='text-align:center;'>Count</th></tr>\n";
2528   
2529    my $Added_Link = "0";
2530    if($Added>0)
2531    {
2532        if($In::Opt{"ShortMode"}) {
2533            $Added_Link = $Added;
2534        }
2535        else
2536        {
2537            if($In::Opt{"JoinReport"}) {
2538                $Added_Link = "<a href='#".$Level."_Added' style='color:Blue;'>$Added</a>";
2539            }
2540            else {
2541                $Added_Link = "<a href='#Added' style='color:Blue;'>$Added</a>";
2542            }
2543        }
2544    }
2545    $META_DATA .= "added:$Added;";
2546    $Problem_Summary .= "<tr><th>Added Methods</th><td>-</td><td".getStyle("M", "Added", $Added).">$Added_Link</td></tr>\n";
2547   
2548    my $Removed_Link = "0";
2549    if($Removed>0)
2550    {
2551        if($In::Opt{"ShortMode"}) {
2552            $Removed_Link = $Removed;
2553        }
2554        else
2555        {
2556            if($In::Opt{"JoinReport"}) {
2557                $Removed_Link = "<a href='#".$Level."_Removed' style='color:Blue;'>$Removed</a>"
2558            }
2559            else {
2560                $Removed_Link = "<a href='#Removed' style='color:Blue;'>$Removed</a>"
2561            }
2562        }
2563    }
2564    $META_DATA .= "removed:$Removed;";
2565    $Problem_Summary .= "<tr><th>Removed Methods</th>";
2566    $Problem_Summary .= "<td>High</td><td".getStyle("M", "Removed", $Removed).">$Removed_Link</td></tr>\n";
2567   
2568    my $TH_Link = "0";
2569    $TH_Link = "<a href='#".getAnchor("Type", $Level, "High")."' style='color:Blue;'>$T_Problems_High</a>" if($T_Problems_High>0);
2570    $META_DATA .= "type_problems_high:$T_Problems_High;";
2571    $Problem_Summary .= "<tr><th rowspan='3'>Problems with<br/>Data Types</th>";
2572    $Problem_Summary .= "<td>High</td><td".getStyle("T", "High", $T_Problems_High).">$TH_Link</td></tr>\n";
2573   
2574    my $TM_Link = "0";
2575    $TM_Link = "<a href='#".getAnchor("Type", $Level, "Medium")."' style='color:Blue;'>$T_Problems_Medium</a>" if($T_Problems_Medium>0);
2576    $META_DATA .= "type_problems_medium:$T_Problems_Medium;";
2577    $Problem_Summary .= "<tr><td>Medium</td><td".getStyle("T", "Medium", $T_Problems_Medium).">$TM_Link</td></tr>\n";
2578   
2579    my $TL_Link = "0";
2580    $TL_Link = "<a href='#".getAnchor("Type", $Level, "Low")."' style='color:Blue;'>$T_Problems_Low</a>" if($T_Problems_Low>0);
2581    $META_DATA .= "type_problems_low:$T_Problems_Low;";
2582    $Problem_Summary .= "<tr><td>Low</td><td".getStyle("T", "Low", $T_Problems_Low).">$TL_Link</td></tr>\n";
2583   
2584    my $MH_Link = "0";
2585    $MH_Link = "<a href='#".getAnchor("Method", $Level, "High")."' style='color:Blue;'>$M_Problems_High</a>" if($M_Problems_High>0);
2586    $META_DATA .= "method_problems_high:$M_Problems_High;";
2587    $Problem_Summary .= "<tr><th rowspan='3'>Problems with<br/>Methods</th>";
2588    $Problem_Summary .= "<td>High</td><td".getStyle("M", "High", $M_Problems_High).">$MH_Link</td></tr>\n";
2589   
2590    my $MM_Link = "0";
2591    $MM_Link = "<a href='#".getAnchor("Method", $Level, "Medium")."' style='color:Blue;'>$M_Problems_Medium</a>" if($M_Problems_Medium>0);
2592    $META_DATA .= "method_problems_medium:$M_Problems_Medium;";
2593    $Problem_Summary .= "<tr><td>Medium</td><td".getStyle("M", "Medium", $M_Problems_Medium).">$MM_Link</td></tr>\n";
2594   
2595    my $ML_Link = "0";
2596    $ML_Link = "<a href='#".getAnchor("Method", $Level, "Low")."' style='color:Blue;'>$M_Problems_Low</a>" if($M_Problems_Low>0);
2597    $META_DATA .= "method_problems_low:$M_Problems_Low;";
2598    $Problem_Summary .= "<tr><td>Low</td><td".getStyle("M", "Low", $M_Problems_Low).">$ML_Link</td></tr>\n";
2599   
2600    # Safe Changes
2601    if($T_Other)
2602    {
2603        my $TS_Link = "<a href='#".getAnchor("Type", $Level, "Safe")."' style='color:Blue;'>$T_Other</a>";
2604        $Problem_Summary .= "<tr><th>Other Changes<br/>in Data Types</th><td>-</td><td".getStyle("T", "Safe", $T_Other).">$TS_Link</td></tr>\n";
2605    }
2606   
2607    if($M_Other)
2608    {
2609        my $MS_Link = "<a href='#".getAnchor("Method", $Level, "Safe")."' style='color:Blue;'>$M_Other</a>";
2610        $Problem_Summary .= "<tr><th>Other Changes<br/>in Methods</th><td>-</td><td".getStyle("M", "Safe", $M_Other).">$MS_Link</td></tr>\n";
2611    }
2612    $META_DATA .= "checked_methods:".keys(%CheckedMethods).";";
2613    $META_DATA .= "checked_types:".keys(%CheckedTypes).";";
2614    $META_DATA .= "tool_version:$TOOL_VERSION";
2615    $Problem_Summary .= "</table>\n";
2616    return ($TestInfo.$TestResults.$Problem_Summary, $META_DATA);
2617}
2618
2619sub getStyle($$$)
2620{
2621    my ($Subj, $Act, $Num) = @_;
2622    my %Style = (
2623        "Added"=>"new",
2624        "Removed"=>"failed",
2625        "Safe"=>"passed",
2626        "Low"=>"warning",
2627        "Medium"=>"failed",
2628        "High"=>"failed"
2629    );
2630   
2631    if($Num>0) {
2632        return " class='".$Style{$Act}."'";
2633    }
2634   
2635    return "";
2636}
2637
2638sub getAnchor($$$)
2639{
2640    my ($Kind, $Level, $Severity) = @_;
2641    if($In::Opt{"JoinReport"})
2642    {
2643        if($Severity eq "Safe") {
2644            return "Other_".$Level."_Changes_In_".$Kind."s";
2645        }
2646        else {
2647            return $Kind."_".$Level."_Problems_".$Severity;
2648        }
2649    }
2650    else
2651    {
2652        if($Severity eq "Safe") {
2653            return "Other_Changes_In_".$Kind."s";
2654        }
2655        else {
2656            return $Kind."_Problems_".$Severity;
2657        }
2658    }
2659}
2660
2661sub getReportAdded($)
2662{
2663    if($In::Opt{"ShortMode"}) {
2664        return "";
2665    }
2666   
2667    my $Level = $_[0];
2668    my ($ADDED_METHODS, %MethodAddedInArchiveClass);
2669    foreach my $Method (sort keys(%CompatProblems))
2670    {
2671        foreach my $Kind (sort keys(%{$CompatProblems{$Method}}))
2672        {
2673            if($Kind eq "Added_Method")
2674            {
2675                my $ArchiveName = $MethodInfo{2}{$Method}{"Archive"};
2676                my $ClassName = getShortName($MethodInfo{2}{$Method}{"Class"}, 2);
2677                if($Level eq "Source")
2678                {
2679                    if($ChangedReturnFromVoid{$Method}) {
2680                        next;
2681                    }
2682                }
2683                $MethodAddedInArchiveClass{$ArchiveName}{$ClassName}{$Method} = 1;
2684            }
2685        }
2686    }
2687    my $Added_Number = 0;
2688    foreach my $ArchiveName (sort {lc($a) cmp lc($b)} keys(%MethodAddedInArchiveClass))
2689    {
2690        foreach my $ClassName (sort {lc($a) cmp lc($b)} keys(%{$MethodAddedInArchiveClass{$ArchiveName}}))
2691        {
2692            my %NameSpace_Method = ();
2693            foreach my $Method (keys(%{$MethodAddedInArchiveClass{$ArchiveName}{$ClassName}})) {
2694                $NameSpace_Method{$MethodInfo{2}{$Method}{"Package"}}{$Method} = 1;
2695            }
2696           
2697            my $ShowClass = $ClassName;
2698            $ShowClass=~s/<.*>//g;
2699           
2700            foreach my $NameSpace (sort keys(%NameSpace_Method))
2701            {
2702                $ADDED_METHODS .= "<span class='jar'>$ArchiveName</span>, <span class='cname'>".specChars($ShowClass).".class</span><br/>\n";
2703               
2704                if($NameSpace) {
2705                    $ADDED_METHODS .= "<span class='pkg_t'>package</span> <span class='pkg'>$NameSpace</span><br/>\n";
2706                }
2707               
2708                if($In::Opt{"Compact"}) {
2709                    $ADDED_METHODS .= "<div class='symbols'>";
2710                }
2711               
2712                my @SortedMethods = sort {lc($MethodInfo{2}{$a}{"Signature"}) cmp lc($MethodInfo{2}{$b}{"Signature"})} keys(%{$NameSpace_Method{$NameSpace}});
2713                foreach my $Method (@SortedMethods)
2714                {
2715                    $Added_Number += 1;
2716                   
2717                    my $Signature = undef;
2718                   
2719                    if($In::Opt{"Compact"}) {
2720                        $Signature = getSignature($Method, 2, "Full|HTML|Simple");
2721                    }
2722                    else {
2723                        $Signature = highLight_ItalicColor($Method, 2);
2724                    }
2725                   
2726                    if($NameSpace) {
2727                        $Signature=~s/(\W|\A)\Q$NameSpace\E\.(\w)/$1$2/g;
2728                    }
2729                   
2730                    if($In::Opt{"Compact"}) {
2731                        $ADDED_METHODS .= "&nbsp;".$Signature."<br/>\n";
2732                    }
2733                    else {
2734                        $ADDED_METHODS .= insertIDs($ContentSpanStart.$Signature.$ContentSpanEnd."<br/>\n".$ContentDivStart."<span class='mngl'>".specChars($Method)."</span><br/><br/>".$ContentDivEnd."\n");
2735                    }
2736                }
2737               
2738                if($In::Opt{"Compact"}) {
2739                    $ADDED_METHODS .= "</div>";
2740                }
2741               
2742                $ADDED_METHODS .= "<br/>\n";
2743            }
2744           
2745        }
2746    }
2747    if($ADDED_METHODS)
2748    {
2749        my $Anchor = "<a name='Added'></a>";
2750        if($In::Opt{"JoinReport"}) {
2751            $Anchor = "<a name='".$Level."_Added'></a>";
2752        }
2753        if($In::Opt{"OldStyle"}) {
2754            $ADDED_METHODS = "<h2>Added Methods ($Added_Number)</h2><hr/>\n".$ADDED_METHODS;
2755        }
2756        else {
2757            $ADDED_METHODS = "<h2>Added Methods <span".getStyle("M", "Added", $Added_Number).">&nbsp;$Added_Number&nbsp;</span></h2><hr/>\n".$ADDED_METHODS;
2758        }
2759        $ADDED_METHODS = $Anchor.$ADDED_METHODS.$TOP_REF."<br/>\n";
2760    }
2761    return $ADDED_METHODS;
2762}
2763
2764sub getReportRemoved($)
2765{
2766    if($In::Opt{"ShortMode"}) {
2767        return "";
2768    }
2769   
2770    my $Level = $_[0];
2771    my ($REMOVED_METHODS, %MethodRemovedFromArchiveClass);
2772    foreach my $Method (sort keys(%CompatProblems))
2773    {
2774        foreach my $Kind (sort keys(%{$CompatProblems{$Method}}))
2775        {
2776            if($Kind eq "Removed_Method")
2777            {
2778                if($Level eq "Source")
2779                {
2780                    if($ChangedReturnFromVoid{$Method}) {
2781                        next;
2782                    }
2783                }
2784                my $ArchiveName = $MethodInfo{1}{$Method}{"Archive"};
2785                my $ClassName = getShortName($MethodInfo{1}{$Method}{"Class"}, 1);
2786                $MethodRemovedFromArchiveClass{$ArchiveName}{$ClassName}{$Method} = 1;
2787            }
2788        }
2789    }
2790    my $Removed_Number = 0;
2791    foreach my $ArchiveName (sort {lc($a) cmp lc($b)} keys(%MethodRemovedFromArchiveClass))
2792    {
2793        foreach my $ClassName (sort {lc($a) cmp lc($b)} keys(%{$MethodRemovedFromArchiveClass{$ArchiveName}}))
2794        {
2795            my %NameSpace_Method = ();
2796            foreach my $Method (keys(%{$MethodRemovedFromArchiveClass{$ArchiveName}{$ClassName}}))
2797            {
2798                $NameSpace_Method{$MethodInfo{1}{$Method}{"Package"}}{$Method} = 1;
2799            }
2800           
2801            my $ShowClass = $ClassName;
2802            $ShowClass=~s/<.*>//g;
2803           
2804            foreach my $NameSpace (sort keys(%NameSpace_Method))
2805            {
2806                $REMOVED_METHODS .= "<span class='jar'>$ArchiveName</span>, <span class='cname'>".specChars($ShowClass).".class</span><br/>\n";
2807               
2808                if($NameSpace) {
2809                    $REMOVED_METHODS .= "<span class='pkg_t'>package</span> <span class='pkg'>$NameSpace</span><br/>\n";
2810                }
2811               
2812                if($In::Opt{"Compact"}) {
2813                    $REMOVED_METHODS .= "<div class='symbols'>";
2814                }
2815               
2816                my @SortedMethods = sort {lc($MethodInfo{1}{$a}{"Signature"}) cmp lc($MethodInfo{1}{$b}{"Signature"})} keys(%{$NameSpace_Method{$NameSpace}});
2817                foreach my $Method (@SortedMethods)
2818                {
2819                    $Removed_Number += 1;
2820                   
2821                    my $Signature = undef;
2822                   
2823                    if($In::Opt{"Compact"}) {
2824                        $Signature = getSignature($Method, 1, "Full|HTML|Simple");
2825                    }
2826                    else {
2827                        $Signature = highLight_ItalicColor($Method, 1);
2828                    }
2829                   
2830                    if($NameSpace) {
2831                        $Signature=~s/(\W|\A)\Q$NameSpace\E\.(\w)/$1$2/g;
2832                    }
2833                   
2834                    if($In::Opt{"Compact"}) {
2835                        $REMOVED_METHODS .= "&nbsp;".$Signature."<br/>\n";
2836                    }
2837                    else {
2838                        $REMOVED_METHODS .= insertIDs($ContentSpanStart.$Signature.$ContentSpanEnd."<br/>\n".$ContentDivStart."<span class='mngl'>".specChars($Method)."</span><br/><br/>".$ContentDivEnd."\n");
2839                    }
2840                }
2841               
2842                if($In::Opt{"Compact"}) {
2843                    $REMOVED_METHODS .= "</div>";
2844                }
2845               
2846                $REMOVED_METHODS .= "<br/>\n";
2847            }
2848        }
2849    }
2850    if($REMOVED_METHODS)
2851    {
2852        my $Anchor = "<a name='Removed'></a><a name='Withdrawn'></a>";
2853        if($In::Opt{"JoinReport"}) {
2854            $Anchor = "<a name='".$Level."_Removed'></a><a name='".$Level."_Withdrawn'></a>";
2855        }
2856        if($In::Opt{"OldStyle"}) {
2857            $REMOVED_METHODS = "<h2>Removed Methods ($Removed_Number)</h2><hr/>\n".$REMOVED_METHODS;
2858        }
2859        else {
2860            $REMOVED_METHODS = "<h2>Removed Methods <span".getStyle("M", "Removed", $Removed_Number).">&nbsp;$Removed_Number&nbsp;</span></h2><hr/>\n".$REMOVED_METHODS;
2861        }
2862        $REMOVED_METHODS = $Anchor.$REMOVED_METHODS.$TOP_REF."<br/>\n";
2863    }
2864    return $REMOVED_METHODS;
2865}
2866
2867sub readRules($)
2868{
2869    my $Kind = $_[0];
2870    if(not -f $RULES_PATH{$Kind}) {
2871        exitStatus("Module_Error", "can't access \'".$RULES_PATH{$Kind}."\'");
2872    }
2873    my $Content = readFile($RULES_PATH{$Kind});
2874    while(my $Rule = parseTag(\$Content, "rule"))
2875    {
2876        my $RId = parseTag(\$Rule, "id");
2877        my @Properties = ("Severity", "Change", "Effect", "Overcome", "Kind");
2878        foreach my $Prop (@Properties) {
2879            if(my $Value = parseTag(\$Rule, lc($Prop)))
2880            {
2881                $Value=~s/\n[ ]*//;
2882                $CompatRules{$Kind}{$RId}{$Prop} = $Value;
2883            }
2884        }
2885        if($CompatRules{$Kind}{$RId}{"Kind"}=~/\A(Methods|Parameters)\Z/) {
2886            $CompatRules{$Kind}{$RId}{"Kind"} = "Methods";
2887        }
2888        else { # Types, Fields
2889            $CompatRules{$Kind}{$RId}{"Kind"} = "Types";
2890        }
2891    }
2892}
2893
2894sub addMarkup($)
2895{
2896    my $Content = $_[0];
2897   
2898    # auto-markup
2899    $Content=~s/\n[ ]*//; # spaces
2900    $Content=~s!([2-9]\))!<br/>$1!g; # 1), 2), ...
2901    if($Content=~/\ANOTE:/)
2902    { # notes
2903        $Content=~s!(NOTE):!<b>$1</b>:!g;
2904    }
2905    else {
2906        $Content=~s!(NOTE):!<br/><br/><b>$1</b>:!g;
2907    }
2908   
2909    my @Keywords = (
2910        "static",
2911        "abstract",
2912        "default",
2913        "final",
2914        "synchronized"
2915    );
2916   
2917    my $MKeys = join("|", @Keywords);
2918    foreach (@Keywords) {
2919        $MKeys .= "|non-".$_;
2920    }
2921   
2922    $Content=~s!(became\s*)($MKeys)([^\w-]|\Z)!$1<b>$2</b>$3!ig; # intrinsic types, modifiers
2923   
2924    # Markdown
2925    $Content=~s!\*\*([\w\-\@]+)\*\*!<b>$1</b>!ig;
2926    $Content=~s!\*([\w\-]+)\*!<i>$1</i>!ig;
2927   
2928    return $Content;
2929}
2930
2931sub applyMacroses($$$$$)
2932{
2933    my ($Level, $Kind, $Content, $Problem, $AddAttr) = @_;
2934   
2935    $Content = addMarkup($Content);
2936   
2937    # macros
2938    foreach my $Attr (sort {$b cmp $a} (keys(%{$Problem}), keys(%{$AddAttr})))
2939    {
2940        my $Macro = "\@".lc($Attr);
2941        my $Value = undef;
2942       
2943        if(defined $Problem->{$Attr}) {
2944            $Value = $Problem->{$Attr};
2945        }
2946        else {
2947            $Value = $AddAttr->{$Attr};
2948        }
2949       
2950        if(not defined $Value
2951        or $Value eq "") {
2952            next;
2953        }
2954       
2955        if(index($Content, $Macro)==-1) {
2956            next;
2957        }
2958       
2959        if($Attr eq "Param_Pos") {
2960            $Value = showPos($Value);
2961        }
2962       
2963        if($Attr eq "Invoked") {
2964            $Value = blackName(specChars($Value));
2965        }
2966        elsif($Value=~/\s/) {
2967            $Value = "<span class='value'>".specChars($Value)."</span>";
2968        }
2969        else
2970        {
2971            my $Fmt = "Class|HTML|Desc";
2972           
2973            if($Attr ne "Invoked_By")
2974            {
2975                if($Attr eq "Method_Short"
2976                or $Kind!~/Overridden|Moved_Up/) {
2977                    $Fmt = "HTML|Desc";
2978                }
2979            }
2980           
2981            if(defined $MethodInfo{1}{$Value}
2982            and defined $MethodInfo{1}{$Value}{"ShortName"}) {
2983                $Value = blackName(getSignature($Value, 1, $Fmt));
2984            }
2985            elsif(defined $MethodInfo{2}{$Value}
2986            and defined $MethodInfo{2}{$Value}{"ShortName"}) {
2987                $Value = blackName(getSignature($Value, 2, $Fmt));
2988            }
2989            else
2990            {
2991                $Value = specChars($Value);
2992                if($Attr ne "Type_Type") {
2993                    $Value = "<b>".$Value."</b>";
2994                }
2995            }
2996        }
2997        $Content=~s/\Q$Macro\E/$Value/g;
2998    }
2999   
3000    if($Content=~/(\A|[^\@\w])(\@\w+)/)
3001    {
3002        if(not $IncompleteRules{$Level}{$Kind})
3003        { # only one warning
3004            printMsg("WARNING", "incomplete $2 in the rule \"$Kind\" (\"$Level\")");
3005            $IncompleteRules{$Level}{$Kind} = 1;
3006        }
3007    }
3008   
3009    return $Content;
3010}
3011
3012sub getReportMethodProblems($$)
3013{
3014    my ($TargetSeverity, $Level) = @_;
3015    my $METHOD_PROBLEMS = "";
3016    my (%ReportMap, %MethodChanges) = ();
3017   
3018    foreach my $Method (sort keys(%CompatProblems))
3019    {
3020        my $ArchiveName = $MethodInfo{1}{$Method}{"Archive"};
3021        my $ClassName = getShortName($MethodInfo{1}{$Method}{"Class"}, 1);
3022       
3023        foreach my $Kind (sort keys(%{$CompatProblems{$Method}}))
3024        {
3025            if($CompatRules{$Level}{$Kind}{"Kind"} eq "Methods")
3026            {
3027                if($Kind eq "Added_Method"
3028                or $Kind eq "Removed_Method") {
3029                    next;
3030                }
3031               
3032                if(my $Severity = $CompatRules{$Level}{$Kind}{"Severity"})
3033                {
3034                    if($Severity ne $TargetSeverity) {
3035                        next;
3036                    }
3037                   
3038                    $MethodChanges{$Method}{$Kind} = $CompatProblems{$Method}{$Kind};
3039                    $ReportMap{$ArchiveName}{$ClassName}{$Method} = 1;
3040                }
3041            }
3042        }
3043    }
3044    my $ProblemsNum = 0;
3045    foreach my $ArchiveName (sort {lc($a) cmp lc($b)} keys(%ReportMap))
3046    {
3047        foreach my $ClassName (sort {lc($a) cmp lc($b)} keys(%{$ReportMap{$ArchiveName}}))
3048        {
3049            my %NameSpace_Method = ();
3050            foreach my $Method (keys(%{$ReportMap{$ArchiveName}{$ClassName}})) {
3051                $NameSpace_Method{$MethodInfo{1}{$Method}{"Package"}}{$Method} = 1;
3052            }
3053           
3054            my $ShowClass = $ClassName;
3055            $ShowClass=~s/<.*>//g;
3056           
3057            foreach my $NameSpace (sort keys(%NameSpace_Method))
3058            {
3059                $METHOD_PROBLEMS .= "<span class='jar'>$ArchiveName</span>, <span class='cname'>".specChars($ShowClass).".class</span><br/>\n";
3060                if($NameSpace) {
3061                    $METHOD_PROBLEMS .= "<span class='pkg_t'>package</span> <span class='pkg'>$NameSpace</span><br/>\n";
3062                }
3063               
3064                my @SortedMethods = sort {lc($MethodInfo{1}{$a}{"Signature"}) cmp lc($MethodInfo{1}{$b}{"Signature"})} keys(%{$NameSpace_Method{$NameSpace}});
3065                foreach my $Method (@SortedMethods)
3066                {
3067                    my %AddAttr = ();
3068                   
3069                    $AddAttr{"Method_Short"} = $Method;
3070                    $AddAttr{"Class"} = getTypeName($MethodInfo{1}{$Method}{"Class"}, 1);
3071                   
3072                    my $METHOD_REPORT = "";
3073                    my $ProblemNum = 1;
3074                    foreach my $Kind (sort keys(%{$MethodChanges{$Method}}))
3075                    {
3076                        foreach my $Loc (sort keys(%{$MethodChanges{$Method}{$Kind}}))
3077                        {
3078                            my $ProblemAttr = $MethodChanges{$Method}{$Kind}{$Loc};
3079                           
3080                            if(my $Change = applyMacroses($Level, $Kind, $CompatRules{$Level}{$Kind}{"Change"}, $ProblemAttr, \%AddAttr))
3081                            {
3082                                my $Effect = applyMacroses($Level, $Kind, $CompatRules{$Level}{$Kind}{"Effect"}, $ProblemAttr, \%AddAttr);
3083                                $METHOD_REPORT .= "<tr>\n<th>$ProblemNum</th>\n<td>".$Change."</td>\n<td>".$Effect."</td>\n</tr>\n";
3084                                $ProblemNum += 1;
3085                                $ProblemsNum += 1;
3086                            }
3087                        }
3088                    }
3089                    $ProblemNum -= 1;
3090                    if($METHOD_REPORT)
3091                    {
3092                        my $ShowMethod = highLight_ItalicColor($Method, 1);
3093                        if($NameSpace)
3094                        {
3095                            $METHOD_REPORT = cutNs($METHOD_REPORT, $NameSpace);
3096                            $ShowMethod = cutNs($ShowMethod, $NameSpace);
3097                        }
3098                       
3099                        $METHOD_PROBLEMS .= $ContentSpanStart."<span class='ext'>[+]</span> ".$ShowMethod;
3100                        if($In::Opt{"OldStyle"}) {
3101                            $METHOD_PROBLEMS .= " ($ProblemNum)";
3102                        }
3103                        else {
3104                            $METHOD_PROBLEMS .= " <span".getStyle("M", $TargetSeverity, $ProblemNum).">&nbsp;$ProblemNum&nbsp;</span>";
3105                        }
3106                        $METHOD_PROBLEMS .= $ContentSpanEnd."<br/>\n";
3107                        $METHOD_PROBLEMS .= $ContentDivStart;
3108                       
3109                        if(not $In::Opt{"Compact"}) {
3110                            $METHOD_PROBLEMS .= "<span class='mngl pleft'>".specChars($Method)."</span><br/>\n";
3111                        }
3112                       
3113                        $METHOD_PROBLEMS .= "<table class='ptable'><tr><th width='2%'></th><th width='47%'>Change</th><th>Effect</th></tr>$METHOD_REPORT</table><br/>$ContentDivEnd\n";
3114                       
3115                    }
3116                }
3117               
3118                $METHOD_PROBLEMS .= "<br/>";
3119            }
3120        }
3121    }
3122    if($METHOD_PROBLEMS)
3123    {
3124        $METHOD_PROBLEMS = insertIDs($METHOD_PROBLEMS);
3125       
3126        my $Title = "Problems with Methods, $TargetSeverity Severity";
3127        if($TargetSeverity eq "Safe")
3128        { # Safe Changes
3129            $Title = "Other Changes in Methods";
3130        }
3131        if($In::Opt{"OldStyle"}) {
3132            $METHOD_PROBLEMS = "<h2>$Title ($ProblemsNum)</h2><hr/>\n".$METHOD_PROBLEMS;
3133        }
3134        else {
3135            $METHOD_PROBLEMS = "<h2>$Title <span".getStyle("M", $TargetSeverity, $ProblemsNum).">&nbsp;$ProblemsNum&nbsp;</span></h2><hr/>\n".$METHOD_PROBLEMS;
3136        }
3137        $METHOD_PROBLEMS = "<a name='".getAnchor("Method", $Level, $TargetSeverity)."'></a>\n".$METHOD_PROBLEMS;
3138        $METHOD_PROBLEMS .= $TOP_REF."<br/>\n";
3139    }
3140    return $METHOD_PROBLEMS;
3141}
3142
3143sub showType($$$)
3144{
3145    my ($Name, $Html, $LVer) = @_;
3146    my $TType = $TypeInfo{$LVer}{$TName_Tid{$LVer}{$Name}}{"Type"};
3147    if($Html) {
3148        $Name = "<span class='ttype'>".$TType."</span> ".specChars($Name);
3149    }
3150    else {
3151        $Name = $TType." ".$Name;
3152    }
3153    return $Name;
3154}
3155
3156sub getReportTypeProblems($$)
3157{
3158    my ($TargetSeverity, $Level) = @_;
3159    my $TYPE_PROBLEMS = "";
3160   
3161    my %ReportMap = ();
3162    my %TypeChanges_Sev = ();
3163   
3164    foreach my $TypeName (keys(%{$TypeChanges{$Level}}))
3165    {
3166        my $ArchiveName = $TypeInfo{1}{$TName_Tid{1}{$TypeName}}{"Archive"};
3167       
3168        foreach my $Kind (keys(%{$TypeChanges{$Level}{$TypeName}}))
3169        {
3170            if($CompatRules{$Level}{$Kind}{"Severity"} ne $TargetSeverity) {
3171                next;
3172            }
3173           
3174            foreach my $Loc (keys(%{$TypeChanges{$Level}{$TypeName}{$Kind}}))
3175            {
3176                $ReportMap{$ArchiveName}{$TypeName} = 1;
3177                $TypeChanges_Sev{$TypeName}{$Kind}{$Loc} = $TypeChanges{$Level}{$TypeName}{$Kind}{$Loc};
3178            }
3179        }
3180    }
3181   
3182    my $ProblemsNum = 0;
3183    foreach my $ArchiveName (sort {lc($a) cmp lc($b)} keys(%ReportMap))
3184    {
3185        my %NameSpace_Type = ();
3186        foreach my $TypeName (keys(%{$ReportMap{$ArchiveName}})) {
3187            $NameSpace_Type{$TypeInfo{1}{$TName_Tid{1}{$TypeName}}{"Package"}}{$TypeName} = 1;
3188        }
3189        foreach my $NameSpace (sort keys(%NameSpace_Type))
3190        {
3191            $TYPE_PROBLEMS .= "<span class='jar'>$ArchiveName</span><br/>\n";
3192            if($NameSpace) {
3193                $TYPE_PROBLEMS .= "<span class='pkg_t'>package</span> <span class='pkg'>".$NameSpace."</span><br/>\n";
3194            }
3195           
3196            my @SortedTypes = sort {lc(showType($a, 0, 1)) cmp lc(showType($b, 0, 1))} keys(%{$NameSpace_Type{$NameSpace}});
3197            foreach my $TypeName (@SortedTypes)
3198            {
3199                my $TypeId = $TName_Tid{1}{$TypeName};
3200               
3201                my $ProblemNum = 1;
3202                my $TYPE_REPORT = "";
3203                my (%Kinds_Locations, %Kinds_Target) = ();
3204               
3205                foreach my $Kind (sort keys(%{$TypeChanges_Sev{$TypeName}}))
3206                {
3207                    foreach my $Location (sort keys(%{$TypeChanges_Sev{$TypeName}{$Kind}}))
3208                    {
3209                        $Kinds_Locations{$Kind}{$Location} = 1;
3210                       
3211                        my $Target = $TypeChanges_Sev{$TypeName}{$Kind}{$Location}{"Target"};
3212                        if($Kinds_Target{$Kind}{$Target}) {
3213                            next;
3214                        }
3215                        $Kinds_Target{$Kind}{$Target} = 1;
3216                       
3217                        my %AddAttr = ();
3218                       
3219                        if($Kind=~/Method/)
3220                        {
3221                            if(defined $MethodInfo{1}{$Target} and $MethodInfo{1}{$Target}{"Name"})
3222                            {
3223                                $AddAttr{"Method_Short"} = $Target;
3224                                $AddAttr{"Class"} = getTypeName($MethodInfo{1}{$Target}{"Class"}, 1);
3225                            }
3226                            elsif(defined $MethodInfo{2}{$Target} and $MethodInfo{2}{$Target}{"Name"})
3227                            {
3228                                $AddAttr{"Method_Short"} = $Target;
3229                                $AddAttr{"Class"} = getTypeName($MethodInfo{2}{$Target}{"Class"}, 2);
3230                            }
3231                        }
3232                       
3233                        my $ProblemAttr = $TypeChanges_Sev{$TypeName}{$Kind}{$Location};
3234                       
3235                        if(my $Change = applyMacroses($Level, $Kind, $CompatRules{$Level}{$Kind}{"Change"}, $ProblemAttr, \%AddAttr))
3236                        {
3237                            my $Effect = applyMacroses($Level, $Kind, $CompatRules{$Level}{$Kind}{"Effect"}, $ProblemAttr, \%AddAttr);
3238                           
3239                            $TYPE_REPORT .= "<tr>\n<th>$ProblemNum</th>\n<td>".$Change."</td>\n<td>".$Effect."</td>\n</tr>\n";
3240                            $ProblemNum += 1;
3241                            $ProblemsNum += 1;
3242                        }
3243                    }
3244                }
3245                $ProblemNum -= 1;
3246                if($TYPE_REPORT)
3247                {
3248                    my $Affected = "";
3249                    if(not defined $TypeInfo{1}{$TypeId}{"Annotation"}) {
3250                        $Affected = getAffectedMethods($Level, $TypeName, \%Kinds_Locations);
3251                    }
3252                   
3253                    my $ShowType = showType($TypeName, 1, 1);
3254                    if($NameSpace)
3255                    {
3256                        $TYPE_REPORT = cutNs($TYPE_REPORT, $NameSpace);
3257                        $ShowType = cutNs($ShowType, $NameSpace);
3258                        $Affected = cutNs($Affected, $NameSpace);
3259                    }
3260                   
3261                    $TYPE_PROBLEMS .= $ContentSpanStart."<span class='ext'>[+]</span> ".$ShowType;
3262                    if($In::Opt{"OldStyle"}) {
3263                        $TYPE_PROBLEMS .= " ($ProblemNum)";
3264                    }
3265                    else {
3266                        $TYPE_PROBLEMS .= " <span".getStyle("T", $TargetSeverity, $ProblemNum).">&nbsp;$ProblemNum&nbsp;</span>";
3267                    }
3268                    $TYPE_PROBLEMS .= $ContentSpanEnd."<br/>\n";
3269                    $TYPE_PROBLEMS .= $ContentDivStart."<table class='ptable'><tr>";
3270                    $TYPE_PROBLEMS .= "<th width='2%'></th><th width='47%'>Change</th><th>Effect</th>";
3271                    $TYPE_PROBLEMS .= "</tr>$TYPE_REPORT</table>".$Affected."<br/><br/>$ContentDivEnd\n";
3272                }
3273            }
3274           
3275            $TYPE_PROBLEMS .= "<br/>";
3276        }
3277    }
3278    if($TYPE_PROBLEMS)
3279    {
3280        $TYPE_PROBLEMS = insertIDs($TYPE_PROBLEMS);
3281       
3282        my $Title = "Problems with Data Types, $TargetSeverity Severity";
3283        if($TargetSeverity eq "Safe")
3284        { # Safe Changes
3285            $Title = "Other Changes in Data Types";
3286        }
3287        if($In::Opt{"OldStyle"}) {
3288            $TYPE_PROBLEMS = "<h2>$Title ($ProblemsNum)</h2><hr/>\n".$TYPE_PROBLEMS;
3289        }
3290        else {
3291            $TYPE_PROBLEMS = "<h2>$Title <span".getStyle("T", $TargetSeverity, $ProblemsNum).">&nbsp;$ProblemsNum&nbsp;</span></h2><hr/>\n".$TYPE_PROBLEMS;
3292        }
3293        $TYPE_PROBLEMS = "<a name='".getAnchor("Type", $Level, $TargetSeverity)."'></a>\n".$TYPE_PROBLEMS;
3294        $TYPE_PROBLEMS .= $TOP_REF."<br/>\n";
3295    }
3296    return $TYPE_PROBLEMS;
3297}
3298
3299sub cutNs($$)
3300{
3301    my ($N, $Ns) = @_;
3302    $N=~s/(\W|\A)\Q$Ns\E\.(\w)/$1$2/g;
3303    return $N;
3304}
3305
3306sub getAffectedMethods($$$)
3307{
3308    my ($Level, $Target_TypeName, $Kinds_Locations) = @_;
3309   
3310    my $LIMIT = 10;
3311    if(defined $In::Opt{"AffectLimit"}) {
3312        $LIMIT = $In::Opt{"AffectLimit"};
3313    }
3314   
3315    my %SymSel = ();
3316   
3317    foreach my $Kind (sort keys(%{$Kinds_Locations}))
3318    {
3319        my @Locs = sort {(index($a, "retval")!=-1) cmp (index($b, "retval")!=-1)} sort {length($a)<=>length($b)} sort keys(%{$Kinds_Locations->{$Kind}});
3320       
3321        foreach my $Loc (@Locs)
3322        {
3323            foreach my $Method (keys(%{$TypeProblemsIndex{$Level}{$Target_TypeName}{$Kind}{$Loc}}))
3324            {
3325                if($Method eq ".client_method") {
3326                    next;
3327                }
3328               
3329                if(not defined $SymSel{$Method})
3330                {
3331                    $SymSel{$Method}{"Kind"} = $Kind;
3332                    $SymSel{$Method}{"Loc"} = $Loc;
3333                }
3334            }
3335        }
3336    }
3337   
3338    my $Total = keys(%SymSel);
3339   
3340    if(not $Total) {
3341        return "";
3342    }
3343   
3344    my $Affected = "";
3345    my $SNum = 0;
3346   
3347    foreach my $Method (sort {lc($a) cmp lc($b)} keys(%SymSel))
3348    {
3349        my $Kind = $SymSel{$Method}{"Kind"};
3350        my $Loc = $SymSel{$Method}{"Loc"};
3351       
3352        my $Desc = getAffectDesc($Method, $Kind, $Loc, $Level);
3353        my $PName = getParamName($Loc);
3354        my $Pos = getParamPos($PName, $Method, 1);
3355       
3356        $Affected .= "<span class='iname_a'>".getSignature($Method, 1, "HTML|Italic|Param|Class|Target=".$Pos)."</span><br/>";
3357        $Affected .= "<div class='affect'>".$Desc."</div>\n";
3358       
3359        if(++$SNum>=$LIMIT) {
3360            last;
3361        }
3362    }
3363   
3364    if($Total>$LIMIT) {
3365        $Affected .= " <b>...</b>\n<br/>\n"; # and others ...
3366    }
3367   
3368    $Affected = "<div class='affected'>".$Affected."</div>";
3369    if($Affected)
3370    {
3371        my $Per = showNum($Total*100/keys(%CheckedMethods));
3372        $Affected =  $ContentDivStart.$Affected.$ContentDivEnd;
3373        $Affected =  $ContentSpanStart_Affected."[+] affected methods: $Total ($Per\%)".$ContentSpanEnd.$Affected;
3374    }
3375   
3376    return $Affected;
3377}
3378
3379sub getAffectDesc($$$$)
3380{
3381    my ($Method, $Kind, $Location, $Level) = @_;
3382    my %Affect = %{$CompatProblems{$Method}{$Kind}{$Location}};
3383    my $New_Value = $Affect{"New_Value"};
3384    my $Type_Name = $Affect{"Type_Name"};
3385    my @Sentence_Parts = ();
3386   
3387    $Location=~s/\.[^.]+?\Z//;
3388   
3389    my $TypeAttr = getType($MethodInfo{1}{$Method}{"Class"}, 1);
3390    my $Type_Type = $TypeAttr->{"Type"};
3391   
3392    my $ABSTRACT_M = $MethodInfo{1}{$Method}{"Abstract"}?" abstract":"";
3393    my $ABSTRACT_C = $TypeAttr->{"Abstract"}?" abstract":"";
3394    my $METHOD_TYPE = $MethodInfo{1}{$Method}{"Constructor"}?"constructor":"method";
3395   
3396    if($Kind eq "Class_Overridden_Method" or $Kind eq "Class_Method_Moved_Up_Hierarchy") {
3397        return "Method '".getSignature($New_Value, 2, "Class|HTML|Italic")."' will be called instead of this method in a client program.";
3398    }
3399    elsif($CompatRules{$Level}{$Kind}{"Kind"} eq "Types")
3400    {
3401        my %MInfo = %{$MethodInfo{1}{$Method}};
3402       
3403        if($Location eq "this") {
3404            return "This$ABSTRACT_M $METHOD_TYPE is from \'".specChars($Type_Name)."\'$ABSTRACT_C $Type_Type.";
3405        }
3406       
3407        my $TypeID = undef;
3408       
3409        if($Location=~/retval/)
3410        { # return value
3411            if($Location=~/\./) {
3412                push(@Sentence_Parts, "Field \'".specChars($Location)."\' in the return value");
3413            }
3414            else {
3415                push(@Sentence_Parts, "Return value");
3416            }
3417           
3418            $TypeID = $MInfo{"Return"};
3419        }
3420        elsif($Location=~/this/)
3421        { # "this" reference
3422            push(@Sentence_Parts, "Field \'".specChars($Location)."\' in the object");
3423           
3424            $TypeID = $MInfo{"Class"};
3425        }
3426        else
3427        { # parameters
3428            my $PName = getParamName($Location);
3429            my $PPos = getParamPos($PName, $Method, 1);
3430           
3431            if($Location=~/\./) {
3432                push(@Sentence_Parts, "Field \'".specChars($Location)."\' in ".showPos($PPos)." parameter");
3433            }
3434            else {
3435                push(@Sentence_Parts, showPos($PPos)." parameter");
3436            }
3437            if($PName) {
3438                push(@Sentence_Parts, "\'$PName\'");
3439            }
3440           
3441            if(defined $MInfo{"Param"}) {
3442                $TypeID = $MInfo{"Param"}{$PPos}{"Type"};
3443            }
3444        }
3445        push(@Sentence_Parts, " of this$ABSTRACT_M method");
3446       
3447        my $Location_T = $Location;
3448        $Location_T=~s/\A\w+(\.|\Z)//; # location in type
3449       
3450        my $TypeID_Problem = $TypeID;
3451        if($Location_T) {
3452            $TypeID_Problem = getFieldType($Location_T, $TypeID, 1);
3453        }
3454       
3455        if($TypeInfo{1}{$TypeID_Problem}{"Name"} eq $Type_Name) {
3456            push(@Sentence_Parts, "is of type \'".specChars($Type_Name)."\'.");
3457        }
3458        else {
3459            push(@Sentence_Parts, "has base type \'".specChars($Type_Name)."\'.");
3460        }
3461    }
3462    return join(" ", @Sentence_Parts);
3463}
3464
3465sub getParamPos($$$)
3466{
3467    my ($Name, $Method, $LVer) = @_;
3468   
3469    if(defined $MethodInfo{$LVer}{$Method}
3470    and defined $MethodInfo{$LVer}{$Method}{"Param"})
3471    {
3472        my $Info = $MethodInfo{$LVer}{$Method};
3473        foreach (keys(%{$Info->{"Param"}}))
3474        {
3475            if($Info->{"Param"}{$_}{"Name"} eq $Name)
3476            {
3477                return $_;
3478            }
3479        }
3480    }
3481   
3482    return undef;
3483}
3484
3485sub getParamName($)
3486{
3487    my $Loc = $_[0];
3488    $Loc=~s/\..*//g;
3489    return $Loc;
3490}
3491
3492sub getFieldType($$$)
3493{
3494    my ($Location, $TypeId, $LVer) = @_;
3495   
3496    my @Fields = split(/\./, $Location);
3497   
3498    foreach my $Name (@Fields)
3499    {
3500        my $TInfo = getBaseType($TypeId, $LVer);
3501       
3502        foreach my $N (keys(%{$TInfo->{"Fields"}}))
3503        {
3504            if($N eq $Name)
3505            {
3506                $TypeId = $TInfo->{"Fields"}{$N}{"Type"};
3507                last;
3508            }
3509        }
3510    }
3511   
3512    return $TypeId;
3513}
3514
3515sub writeReport($$)
3516{
3517    my ($Level, $Report) = @_;
3518    my $RPath = getReportPath($Level);
3519    writeFile($RPath, $Report);
3520}
3521
3522sub createReport()
3523{
3524    if($In::Opt{"JoinReport"}) {
3525        writeReport("Join", getReport("Join"));
3526    }
3527    elsif($In::Opt{"DoubleReport"})
3528    { # default
3529        writeReport("Binary", getReport("Binary"));
3530        writeReport("Source", getReport("Source"));
3531    }
3532    elsif($In::Opt{"BinaryOnly"})
3533    { # --binary
3534        writeReport("Binary", getReport("Binary"));
3535    }
3536    elsif($In::Opt{"SourceOnly"})
3537    { # --source
3538        writeReport("Source", getReport("Source"));
3539    }
3540}
3541
3542sub getCssStyles($)
3543{
3544    my $Level = $_[0];
3545   
3546    my $CssStyles = readModule("Css", "Report.css");
3547   
3548    if($Level eq "Join" or $In::Opt{"ExternCss"}) {
3549        $CssStyles .= readModule("Css", "Tabs.css");
3550    }
3551   
3552    return $CssStyles;
3553}
3554
3555sub getJsScript($)
3556{
3557    my $Level = $_[0];
3558   
3559    my $JScripts = readModule("Js", "Sections.js");
3560   
3561    if($Level eq "Join" or $In::Opt{"ExternJs"}) {
3562        $JScripts .= readModule("Js", "Tabs.js");
3563    }
3564   
3565    return $JScripts;
3566}
3567
3568sub getReport($)
3569{
3570    my $Level = $_[0];
3571   
3572    my $CssStyles = getCssStyles($Level);
3573    my $JScripts = getJsScript($Level);
3574   
3575    if(defined $In::Opt{"ExternCss"}) {
3576        writeFile($In::Opt{"ExternCss"}, $CssStyles);
3577    }
3578   
3579    if(defined $In::Opt{"ExternJs"}) {
3580        writeFile($In::Opt{"ExternJs"}, $JScripts);
3581    }
3582   
3583    if($Level eq "Join")
3584    {
3585        my $Title = $In::Opt{"TargetTitle"}.": ".$In::Desc{1}{"Version"}." to ".$In::Desc{2}{"Version"}." compatibility report";
3586        my $Keywords = $In::Opt{"TargetTitle"}.", compatibility";
3587        my $Description = "Compatibility report for the ".$In::Opt{"TargetTitle"}." library between ".$In::Desc{1}{"Version"}." and ".$In::Desc{2}{"Version"}." versions";
3588       
3589        my ($BSummary, $BMetaData) = getSummary("Binary");
3590        my ($SSummary, $SMetaData) = getSummary("Source");
3591       
3592        my $Report = "<!-\- $BMetaData -\->\n<!-\- $SMetaData -\->\n".composeHTML_Head($Level, $Title, $Keywords, $Description, $CssStyles, $JScripts)."<body><a name='Source'></a><a name='Binary'></a><a name='Top'></a>";
3593       
3594        $Report .= getReportHeader("Join");
3595        $Report .= "<br/><div class='tabset'>\n";
3596        $Report .= "<a id='BinaryID' href='#BinaryTab' class='tab active'>Binary<br/>Compatibility</a>\n";
3597        $Report .= "<a id='SourceID' href='#SourceTab' style='margin-left:3px' class='tab disabled'>Source<br/>Compatibility</a>\n";
3598        $Report .= "</div>\n";
3599       
3600        $Report .= "<div id='BinaryTab' class='tab'>\n$BSummary\n".getReportAdded("Binary").getReportRemoved("Binary").getReportProblems("High", "Binary").getReportProblems("Medium", "Binary").getReportProblems("Low", "Binary").getReportProblems("Safe", "Binary").getSourceInfo()."<br/><br/><br/></div>";
3601       
3602        $Report .= "<div id='SourceTab' class='tab'>\n$SSummary\n".getReportAdded("Source").getReportRemoved("Source").getReportProblems("High", "Source").getReportProblems("Medium", "Source").getReportProblems("Low", "Source").getReportProblems("Safe", "Source").getSourceInfo()."<br/><br/><br/></div>";
3603       
3604        $Report .= getReportFooter();
3605        $Report .= "\n</body></html>";
3606        return $Report;
3607    }
3608    else
3609    {
3610        my ($Summary, $MetaData) = getSummary($Level);
3611       
3612        my $Title = $In::Opt{"TargetTitle"}.": ".$In::Desc{1}{"Version"}." to ".$In::Desc{2}{"Version"}." ".lc($Level)." compatibility report";
3613        my $Keywords = $In::Opt{"TargetTitle"}.", ".lc($Level).", compatibility";
3614        my $Description = "$Level compatibility report for the ".$In::Opt{"TargetTitle"}." library between ".$In::Desc{1}{"Version"}." and ".$In::Desc{2}{"Version"}." versions";
3615       
3616        my $Report = "<!-\- $MetaData -\->\n".composeHTML_Head($Level, $Title, $Keywords, $Description, $CssStyles, $JScripts)."<body><a name='Top'></a>";
3617        $Report .= getReportHeader($Level)."\n".$Summary."\n";
3618        $Report .= getReportAdded($Level).getReportRemoved($Level);
3619        $Report .= getReportProblems("High", $Level).getReportProblems("Medium", $Level).getReportProblems("Low", $Level).getReportProblems("Safe", $Level);
3620        $Report .= getSourceInfo()."<br/><br/><br/>\n";
3621        $Report .= getReportFooter();
3622        $Report .= "\n</body></html>";
3623        return $Report;
3624    }
3625}
3626
3627sub getReportFooter()
3628{
3629    my $Footer = "";
3630    $Footer .= "<hr/>";
3631    $Footer .= "<div class='footer' align='right'><i>Generated by ";
3632    $Footer .= "<a href='".$HomePage{"Dev"}."'>Java API Compliance Checker</a> $TOOL_VERSION &#160;";
3633    $Footer .= "</i></div>";
3634    $Footer .= "<br/>";
3635    return $Footer;
3636}
3637
3638sub getReportProblems($$)
3639{
3640    my ($Priority, $Level) = @_;
3641    my $Report = getReportTypeProblems($Priority, $Level);
3642    if(my $MProblems = getReportMethodProblems($Priority, $Level)) {
3643        $Report .= $MProblems;
3644    }
3645    if($Report)
3646    {
3647        if($In::Opt{"JoinReport"})
3648        {
3649            if($Priority eq "Safe") {
3650                $Report = "<a name=\'Other_".$Level."_Changes\'></a>".$Report;
3651            }
3652            else {
3653                $Report = "<a name=\'".$Priority."_Risk_".$Level."_Problems\'></a>".$Report;
3654            }
3655        }
3656        else
3657        {
3658            if($Priority eq "Safe") {
3659                $Report = "<a name=\'Other_Changes\'></a>".$Report;
3660            }
3661            else {
3662                $Report = "<a name=\'".$Priority."_Risk_Problems\'></a>".$Report;
3663            }
3664        }
3665    }
3666    return $Report;
3667}
3668
3669sub composeHTML_Head($$$$$$)
3670{
3671    my ($Level, $Title, $Keywords, $Description, $Styles, $Scripts) = @_;
3672   
3673    my $Head = "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">\n";
3674    $Head .= "<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\">\n";
3675    $Head .= "<head>\n";
3676    $Head .= "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\" />\n";
3677    $Head .= "<meta name=\"keywords\" content=\"$Keywords\" />\n";
3678    $Head .= "<meta name=\"description\" content=\"$Description\" />\n";
3679   
3680    my $RPath = getReportPath($Level);
3681   
3682    if(defined $In::Opt{"ExternCss"}) {
3683        $Head .= "<link rel=\"stylesheet\" type=\"text/css\" href=\"".getRelPath($In::Opt{"ExternCss"}, $RPath)."\" />\n";
3684    }
3685   
3686    if(defined $In::Opt{"ExternJs"}) {
3687        $Head .= "<script type=\"text/javascript\" src=\"".getRelPath($In::Opt{"ExternJs"}, $RPath)."\"></script>\n";
3688    }
3689   
3690    $Head .= "<title>$Title</title>\n";
3691   
3692    if(not defined $In::Opt{"ExternCss"}) {
3693        $Head .= "<style type=\"text/css\">\n$Styles\n</style>\n";
3694    }
3695   
3696    if(not defined $In::Opt{"ExternJs"}) {
3697        $Head .= "<script type=\"text/javascript\" language=\"JavaScript\">\n<!--\n$Scripts\n-->\n</script>\n";
3698    }
3699   
3700    $Head .= "</head>\n";
3701   
3702    return $Head;
3703}
3704
3705sub insertIDs($)
3706{
3707    my $Text = $_[0];
3708    while($Text=~/CONTENT_ID/)
3709    {
3710        if(int($Content_Counter)%2)
3711        {
3712            $ContentID -= 1;
3713        }
3714        $Text=~s/CONTENT_ID/c_$ContentID/;
3715        $ContentID += 1;
3716        $Content_Counter += 1;
3717    }
3718    return $Text;
3719}
3720
3721sub registerUsage($$)
3722{
3723    my ($TypeId, $LVer) = @_;
3724    $Class_Constructed{$LVer}{$TypeId} = 1;
3725    if(my $BaseId = $TypeInfo{$LVer}{$TypeId}{"BaseType"}) {
3726        $Class_Constructed{$LVer}{$BaseId} = 1;
3727    }
3728}
3729
3730sub checkVoidMethod($)
3731{
3732    my $Method = $_[0];
3733   
3734    if($Method=~s/\)(.+)\Z/\)V/g) {
3735        return $Method;
3736    }
3737   
3738    return undef;
3739}
3740
3741sub detectAdded()
3742{
3743    foreach my $Method (keys(%{$MethodInfo{2}}))
3744    {
3745        if(not defined $MethodInfo{1}{$Method})
3746        {
3747            if(not methodFilter($Method, 2)) {
3748                next;
3749            }
3750           
3751            my $ClassId = $MethodInfo{2}{$Method}{"Class"};
3752            my $CName = getTypeName($ClassId, 2);
3753           
3754            $CheckedTypes{$CName} = 1;
3755            $CheckedMethods{$Method} = 1;
3756           
3757            if(not $MethodInfo{2}{$Method}{"Constructor"}
3758            and my $Overridden = findMethod($Method, 2, $CName, 2))
3759            {
3760                if(defined $MethodInfo{1}{$Overridden}
3761                and getTypeType($ClassId, 2) eq "class" and $TName_Tid{1}{$CName})
3762                { # class should exist in previous version
3763                    %{$CompatProblems{$Overridden}{"Class_Overridden_Method"}{"this.".getSFormat($Method)}}=(
3764                        "Type_Name"=>$CName,
3765                        "Target"=>$MethodInfo{2}{$Method}{"Signature"},
3766                        "Old_Value"=>$Overridden,
3767                        "New_Value"=>$Method);
3768                }
3769            }
3770            if($MethodInfo{2}{$Method}{"Abstract"}) {
3771                $AddedMethod_Abstract{$CName}{$Method} = 1;
3772            }
3773           
3774            %{$CompatProblems{$Method}{"Added_Method"}{""}}=();
3775           
3776            if(not $MethodInfo{2}{$Method}{"Constructor"})
3777            {
3778                if(getTypeName($MethodInfo{2}{$Method}{"Return"}, 2) ne "void"
3779                and my $VoidMethod = checkVoidMethod($Method))
3780                {
3781                    if(defined $MethodInfo{1}{$VoidMethod})
3782                    { # return value type changed from "void" to
3783                        $ChangedReturnFromVoid{$VoidMethod} = 1;
3784                        $ChangedReturnFromVoid{$Method} = 1;
3785                       
3786                        %{$CompatProblems{$VoidMethod}{"Changed_Method_Return_From_Void"}{""}}=(
3787                            "New_Value"=>getTypeName($MethodInfo{2}{$Method}{"Return"}, 2)
3788                        );
3789                    }
3790                }
3791            }
3792        }
3793    }
3794}
3795
3796sub detectRemoved()
3797{
3798    foreach my $Method (keys(%{$MethodInfo{1}}))
3799    {
3800        if(not defined $MethodInfo{2}{$Method})
3801        {
3802            if(not methodFilter($Method, 1)) {
3803                next;
3804            }
3805           
3806            my $ClassId = $MethodInfo{1}{$Method}{"Class"};
3807            my $CName = getTypeName($ClassId, 1);
3808           
3809            $CheckedTypes{$CName} = 1;
3810            $CheckedMethods{$Method} = 1;
3811           
3812            if(not $MethodInfo{1}{$Method}{"Constructor"}
3813            and my $MovedUp = findMethod($Method, 1, $CName, 2))
3814            {
3815                if(getTypeType($ClassId, 1) eq "class"
3816                and not $MethodInfo{1}{$Method}{"Abstract"} and $TName_Tid{2}{$CName})
3817                {# class should exist in newer version
3818                    %{$CompatProblems{$Method}{"Class_Method_Moved_Up_Hierarchy"}{"this.".getSFormat($MovedUp)}}=(
3819                        "Type_Name"=>$CName,
3820                        "Target"=>$MethodInfo{2}{$MovedUp}{"Signature"},
3821                        "Old_Value"=>$Method,
3822                        "New_Value"=>$MovedUp);
3823                }
3824            }
3825            else
3826            {
3827                if($MethodInfo{1}{$Method}{"Abstract"}) {
3828                    $RemovedMethod_Abstract{$CName}{$Method} = 1;
3829                }
3830                %{$CompatProblems{$Method}{"Removed_Method"}{""}}=();
3831            }
3832        }
3833    }
3834}
3835
3836sub getArchivePaths($$)
3837{
3838    my ($Dest, $LVer) = @_;
3839    if(-f $Dest) {
3840        return ($Dest);
3841    }
3842    elsif(-d $Dest)
3843    {
3844        $Dest=~s/[\/\\]+\Z//g;
3845        next if(not $Dest);
3846       
3847        my @Archives = ();
3848        foreach my $Path (cmdFind($Dest, "", "*\\.jar"))
3849        {
3850            next if(ignorePath($Path, $Dest));
3851            push(@Archives, realpath_F($Path));
3852        }
3853        return @Archives;
3854    }
3855    return ();
3856}
3857
3858sub isCyclical($$) {
3859    return (grep {$_ eq $_[1]} @{$_[0]});
3860}
3861
3862sub mergeAPIs($$)
3863{
3864    my ($LVer, $Dep) = @_;
3865   
3866    foreach my $TId (keys(%{$Dep->{"TypeInfo"}}))
3867    {
3868        $TypeInfo{$LVer}{$TId} = $Dep->{"TypeInfo"}{$TId};
3869        $TypeInfo{$LVer}{$TId}{"Dep"} = 1;
3870    }
3871   
3872    my $MInfo = $Dep->{"MethodInfo"};
3873    foreach my $M_Id (keys(%{$MInfo}))
3874    {
3875        if(my $Name = $MInfo->{$M_Id}{"Name"})
3876        {
3877            $MethodInfo{$LVer}{$Name} = $MInfo->{$M_Id};
3878            $MethodInfo{$LVer}{$Name}{"Dep"} = 1;
3879        }
3880    }
3881}
3882
3883sub readAPIDump($$$)
3884{
3885    my ($LVer, $Path, $Subj) = @_;
3886   
3887    if(not $In::Opt{"CountMethods"}) {
3888        printMsg("INFO", "Reading API dump ($LVer) ...");
3889    }
3890   
3891    my $FilePath = "";
3892    if(isDump_U($Path))
3893    { # input *.dump
3894        $FilePath = $Path;
3895    }
3896    else
3897    { # input *.dump.tar.gz
3898        $FilePath = unpackDump($Path);
3899        if(not isDump_U($FilePath)) {
3900            exitStatus("Invalid_Dump", "specified API dump \'$Path\' is not valid, try to recreate it");
3901        }
3902    }
3903   
3904    my $APIRef = {};
3905   
3906    open(DUMP, $FilePath);
3907    local $/ = undef;
3908    my $Content = <DUMP>;
3909    close(DUMP);
3910   
3911    if(getDirname($FilePath) eq $In::Opt{"Tmp"}."/unpack")
3912    { # remove temp file
3913        unlink($FilePath);
3914    }
3915   
3916    if($Content!~/};\s*\Z/) {
3917        exitStatus("Invalid_Dump", "specified API dump \'$Path\' is not valid, try to recreate it");
3918    }
3919   
3920    $APIRef = eval($Content);
3921   
3922    if(not $APIRef) {
3923        exitStatus("Error", "internal error - eval() procedure seem to not working correctly, try to remove 'use strict' and try again");
3924    }
3925   
3926    my $APIVer = $APIRef->{"API_DUMP_VERSION"};
3927   
3928    if($APIVer)
3929    {
3930        if(cmpVersions($APIVer, $API_DUMP_VERSION)>0)
3931        { # future formats
3932            exitStatus("Dump_Version", "the versions of the API dump is newer than version of the tool");
3933        }
3934    }
3935   
3936    if(cmpVersions($APIVer, $API_DUMP_VERSION_MIN)<0) {
3937        exitStatus("Dump_Version", "the version of the API dump is too old and unsupported anymore, please regenerate it");
3938    }
3939   
3940    if($Subj ne "Dep")
3941    {
3942        $In::Desc{$LVer}{"Version"} = $APIRef->{"LibraryVersion"};
3943        $In::Desc{$LVer}{"Dump"} = 1;
3944    }
3945   
3946    return $APIRef;
3947}
3948
3949sub checkVersionNum($$)
3950{
3951    my ($LVer, $Path) = @_;
3952   
3953    if($In::Desc{$LVer}{"TargetVersion"}) {
3954        return;
3955    }
3956   
3957    if($Path!~/\.jar\Z/i) {
3958        return;
3959    }
3960   
3961    my $Ver = undef;
3962   
3963    if(not defined $Ver) {
3964        $Ver = getManifestVersion(getAbsPath($Path));
3965    }
3966   
3967    if(not defined $Ver) {
3968        $Ver = getPkgVersion(getFilename($Path));
3969    }
3970   
3971    if(not defined $Ver) {
3972        $Ver = parseVersion($Path);
3973    }
3974   
3975    if(not defined $Ver)
3976    {
3977        if($In::Opt{"DumpAPI"})
3978        {
3979            $Ver = "XYZ";
3980        }
3981        else
3982        {
3983            if($LVer==1) {
3984                $Ver = "X";
3985            }
3986            else {
3987                $Ver = "Y";
3988            }
3989        }
3990    }
3991   
3992    $In::Desc{$LVer}{"TargetVersion"} = $Ver;
3993   
3994    if($In::Opt{"DumpAPI"}) {
3995        printMsg("WARNING", "set version number to $Ver (use -vnum option to change it)");
3996    }
3997    else {
3998        printMsg("WARNING", "set #$LVer version number to $Ver (use --v$LVer=NUM option to change it)");
3999    }
4000}
4001
4002sub getManifestVersion($)
4003{
4004    my $Path = $_[0];
4005   
4006    my $JarCmd = getCmdPath("jar");
4007    if(not $JarCmd) {
4008        exitStatus("Not_Found", "can't find \"jar\" command");
4009    }
4010   
4011    my $TmpDir = $In::Opt{"Tmp"};
4012   
4013    chdir($TmpDir);
4014    system($JarCmd." -xf \"$Path\" META-INF 2>null");
4015    chdir($In::Opt{"OrigDir"});
4016   
4017    my $Manifest = $TmpDir."/META-INF/MANIFEST.MF";
4018   
4019    if(-f $Manifest)
4020    {
4021        if(my $Content = readFile($Manifest))
4022        {
4023            if($Content=~/(\A|\s)Implementation\-Version:\s*(.+)(\s|\Z)/i) {
4024                return $2;
4025            }
4026        }
4027    }
4028    return undef;
4029}
4030
4031sub parseVersion($)
4032{
4033    my $Str = $_[0];
4034   
4035    if(not $Str) {
4036        return undef;
4037    }
4038   
4039    if($Str=~/(\/|\\|\w|\A)[\-\_]*(\d+[\d\.\-]+\d+|\d+)/) {
4040        return $2;
4041    }
4042    return undef;
4043}
4044
4045sub getPkgVersion($)
4046{
4047    my $Name = $_[0];
4048    $Name=~s/\.\w+\Z//;
4049    if($Name=~/\A(.+[a-z])[\-\_](v|ver|)(\d.+?)\Z/i)
4050    { # libsample-N
4051      # libsample-vN
4052        return ($1, $3);
4053    }
4054    elsif($Name=~/\A(.+?)(\d[\d\.]*)\Z/i)
4055    { # libsampleN
4056        return ($1, $2);
4057    }
4058    elsif($Name=~/\A(.+)[\-\_](v|ver|)(\d.+?)\Z/i)
4059    { # libsample-N
4060      # libsample-vN
4061        return ($1, $3);
4062    }
4063    elsif($Name=~/\A([a-z_\-]+)(\d.+?)\Z/i)
4064    { # libsampleNb
4065        return ($1, $2);
4066    }
4067    return (undef, undef);
4068}
4069
4070sub dumpSorting($)
4071{
4072    my $Hash = $_[0];
4073    return [] if(not $Hash);
4074    my @Keys = keys(%{$Hash});
4075    return [] if($#Keys<0);
4076    if($Keys[0]=~/\A\d+\Z/)
4077    { # numbers
4078        return [sort {int($a)<=>int($b)} @Keys];
4079    }
4080    else
4081    { # strings
4082        return [sort {$a cmp $b} @Keys];
4083    }
4084}
4085
4086sub printStatMsg($)
4087{
4088    my $Level = $_[0];
4089    printMsg("INFO", "Total ".lc($Level)." compatibility problems: ".$RESULT{$Level}{"Problems"}.", warnings: ".$RESULT{$Level}{"Warnings"});
4090}
4091
4092sub printReport()
4093{
4094    printMsg("INFO", "Creating compatibility report ...");
4095    createReport();
4096    if($In::Opt{"JoinReport"} or $In::Opt{"DoubleReport"})
4097    {
4098        if($RESULT{"Binary"}{"Problems"}
4099        or $RESULT{"Source"}{"Problems"})
4100        {
4101            printMsg("INFO", "Binary compatibility: ".(100-$RESULT{"Binary"}{"Affected"})."\%");
4102            printMsg("INFO", "Source compatibility: ".(100-$RESULT{"Source"}{"Affected"})."\%");
4103        }
4104        else
4105        {
4106            printMsg("INFO", "Binary compatibility: 100\%");
4107            printMsg("INFO", "Source compatibility: 100\%");
4108        }
4109        printStatMsg("Binary");
4110        printStatMsg("Source");
4111    }
4112    elsif($In::Opt{"BinaryOnly"})
4113    {
4114        if($RESULT{"Binary"}{"Problems"}) {
4115            printMsg("INFO", "Binary compatibility: ".(100-$RESULT{"Binary"}{"Affected"})."\%");
4116        }
4117        else {
4118            printMsg("INFO", "Binary compatibility: 100\%");
4119        }
4120        printStatMsg("Binary");
4121    }
4122    elsif($In::Opt{"SourceOnly"})
4123    {
4124        if($RESULT{"Source"}{"Problems"}) {
4125            printMsg("INFO", "Source compatibility: ".(100-$RESULT{"Source"}{"Affected"})."\%");
4126        }
4127        else {
4128            printMsg("INFO", "Source compatibility: 100\%");
4129        }
4130        printStatMsg("Source");
4131    }
4132    if($In::Opt{"JoinReport"})
4133    {
4134        printMsg("INFO", "Report: ".getReportPath("Join"));
4135    }
4136    elsif($In::Opt{"DoubleReport"})
4137    { # default
4138        printMsg("INFO", "Report (BC): ".getReportPath("Binary"));
4139        printMsg("INFO", "Report (SC): ".getReportPath("Source"));
4140    }
4141    elsif($In::Opt{"BinaryOnly"})
4142    { # --binary
4143        printMsg("INFO", "Report: ".getReportPath("Binary"));
4144    }
4145    elsif($In::Opt{"SourceOnly"})
4146    { # --source
4147        printMsg("INFO", "Report: ".getReportPath("Source"));
4148    }
4149}
4150
4151sub getReportPath($)
4152{
4153    my $Level = $_[0];
4154    my $Dir = "compat_reports/".$In::Opt{"TargetLib"}."/".$In::Desc{1}{"Version"}."_to_".$In::Desc{2}{"Version"};
4155    if($Level eq "Binary")
4156    {
4157        if($In::Opt{"BinaryReportPath"})
4158        { # --bin-report-path
4159            return $In::Opt{"BinaryReportPath"};
4160        }
4161        elsif($In::Opt{"OutputReportPath"})
4162        { # --report-path
4163            return $In::Opt{"OutputReportPath"};
4164        }
4165        else
4166        { # default
4167            return $Dir."/bin_compat_report.html";
4168        }
4169    }
4170    elsif($Level eq "Source")
4171    {
4172        if($In::Opt{"SourceReportPath"})
4173        { # --src-report-path
4174            return $In::Opt{"SourceReportPath"};
4175        }
4176        elsif($In::Opt{"OutputReportPath"})
4177        { # --report-path
4178            return $In::Opt{"OutputReportPath"};
4179        }
4180        else
4181        { # default
4182            return $Dir."/src_compat_report.html";
4183        }
4184    }
4185    else
4186    {
4187        if($In::Opt{"OutputReportPath"})
4188        { # --report-path
4189            return $In::Opt{"OutputReportPath"};
4190        }
4191        else
4192        { # default
4193            return $Dir."/compat_report.html";
4194        }
4195    }
4196}
4197
4198sub unpackDump($)
4199{
4200    my $Path = $_[0];
4201   
4202    if(isDump_U($Path)) {
4203        return $Path;
4204    }
4205   
4206    my $TmpDir = $In::Opt{"Tmp"};
4207   
4208    $Path = getAbsPath($Path);
4209    $Path = pathFmt($Path);
4210   
4211    my ($Dir, $FileName) = sepPath($Path);
4212    my $UnpackDir = $TmpDir."/unpack";
4213    if(-d $UnpackDir) {
4214        rmtree($UnpackDir);
4215    }
4216    mkpath($UnpackDir);
4217   
4218    if($FileName=~s/\Q.zip\E\Z//g)
4219    { # *.zip
4220        my $UnzipCmd = getCmdPath("unzip");
4221        if(not $UnzipCmd) {
4222            exitStatus("Not_Found", "can't find \"unzip\" command");
4223        }
4224        chdir($UnpackDir);
4225        system("$UnzipCmd \"$Path\" >contents.txt");
4226        if($?) {
4227            exitStatus("Error", "can't extract \'$Path\'");
4228        }
4229        chdir($In::Opt{"OrigDir"});
4230        my @Contents = ();
4231        foreach (split("\n", readFile("$UnpackDir/contents.txt")))
4232        {
4233            if(/inflating:\s*([^\s]+)/) {
4234                push(@Contents, $1);
4235            }
4236        }
4237        if(not @Contents) {
4238            exitStatus("Error", "can't extract \'$Path\'");
4239        }
4240        return join_P($UnpackDir, $Contents[0]);
4241    }
4242    elsif($FileName=~s/\Q.tar.gz\E\Z//g)
4243    { # *.tar.gz
4244        if($In::Opt{"OS"} eq "windows")
4245        { # -xvzf option is not implemented in tar.exe (2003)
4246          # use "gzip.exe -k -d -f" + "tar.exe -xvf" instead
4247            my $TarCmd = getCmdPath("tar");
4248            if(not $TarCmd) {
4249                exitStatus("Not_Found", "can't find \"tar\" command");
4250            }
4251            my $GzipCmd = getCmdPath("gzip");
4252            if(not $GzipCmd) {
4253                exitStatus("Not_Found", "can't find \"gzip\" command");
4254            }
4255            chdir($UnpackDir);
4256            qx/$GzipCmd -k -d -f "$Path"/; # keep input files (-k)
4257            if($?) {
4258                exitStatus("Error", "can't extract \'$Path\'");
4259            }
4260            my @Contents = qx/$TarCmd -xvf "$Dir\\$FileName.tar"/;
4261            if($? or not @Contents) {
4262                exitStatus("Error", "can't extract \'$Path\'");
4263            }
4264            chdir($In::Opt{"OrigDir"});
4265            unlink($Dir."/".$FileName.".tar");
4266            chomp $Contents[0];
4267            return join_P($UnpackDir, $Contents[0]);
4268        }
4269        else
4270        { # Linux, Unix, OS X
4271            my $TarCmd = getCmdPath("tar");
4272            if(not $TarCmd) {
4273                exitStatus("Not_Found", "can't find \"tar\" command");
4274            }
4275            chdir($UnpackDir);
4276            my @Contents = qx/$TarCmd -xvzf "$Path" 2>&1/;
4277            if($? or not @Contents) {
4278                exitStatus("Error", "can't extract \'$Path\'");
4279            }
4280            chdir($In::Opt{"OrigDir"});
4281            $Contents[0]=~s/^x //; # OS X
4282            chomp $Contents[0];
4283            return join_P($UnpackDir, $Contents[0]);
4284        }
4285    }
4286}
4287
4288sub createArchive($$)
4289{
4290    my ($Path, $To) = @_;
4291    if(not $To) {
4292        $To = ".";
4293    }
4294   
4295    my $TmpDir = $In::Opt{"Tmp"};
4296   
4297    my ($From, $Name) = sepPath($Path);
4298    if($In::Opt{"OS"} eq "windows")
4299    { # *.zip
4300        my $ZipCmd = getCmdPath("zip");
4301        if(not $ZipCmd) {
4302            exitStatus("Not_Found", "can't find \"zip\"");
4303        }
4304        my $Pkg = $To."/".$Name.".zip";
4305        unlink($Pkg);
4306        chdir($To);
4307        system("$ZipCmd -j \"$Name.zip\" \"$Path\" >\"$TmpDir/null\"");
4308        if($?)
4309        { # cannot allocate memory (or other problems with "zip")
4310            unlink($Path);
4311            exitStatus("Error", "can't pack the API dump: ".$!);
4312        }
4313        chdir($In::Opt{"OrigDir"});
4314        unlink($Path);
4315        return $Pkg;
4316    }
4317    else
4318    { # *.tar.gz
4319        my $TarCmd = getCmdPath("tar");
4320        if(not $TarCmd) {
4321            exitStatus("Not_Found", "can't find \"tar\"");
4322        }
4323        my $GzipCmd = getCmdPath("gzip");
4324        if(not $GzipCmd) {
4325            exitStatus("Not_Found", "can't find \"gzip\"");
4326        }
4327        my $Pkg = abs_path($To)."/".$Name.".tar.gz";
4328        unlink($Pkg);
4329        chdir($From);
4330        system($TarCmd, "-czf", $Pkg, $Name);
4331        if($?)
4332        { # cannot allocate memory (or other problems with "tar")
4333            unlink($Path);
4334            exitStatus("Error", "can't pack the API dump: ".$!);
4335        }
4336        chdir($In::Opt{"OrigDir"});
4337        unlink($Path);
4338        return $To."/".$Name.".tar.gz";
4339    }
4340}
4341
4342sub initAliases($)
4343{
4344    my $LVer = $_[0];
4345   
4346    initAPI($LVer);
4347   
4348    $MethodInfo{$LVer} = $In::API{$LVer}{"MethodInfo"};
4349    $TypeInfo{$LVer} = $In::API{$LVer}{"TypeInfo"};
4350    $TName_Tid{$LVer} = $In::API{$LVer}{"TName_Tid"};
4351   
4352    initAliases_TypeAttr($LVer);
4353}
4354
4355sub createAPIFile($$)
4356{
4357    my ($LVer, $DescPath) = @_;
4358   
4359    if(not -e $DescPath) {
4360        exitStatus("Access_Error", "can't access \'$DescPath\'");
4361    }
4362   
4363    detectDefaultPaths("bin", "java");
4364   
4365    if(isDump($DescPath))
4366    {
4367        $In::API{$LVer} = readAPIDump($LVer, $DescPath, "Main");
4368        initAliases($LVer);
4369       
4370        if(my $V = $In::Desc{$LVer}{"TargetVersion"}) {
4371            $In::Desc{$LVer}{"Version"} = $V;
4372        }
4373        else {
4374            $In::Desc{$LVer}{"Version"} = $In::API{$LVer}{"LibraryVersion"};
4375        }
4376    }
4377    else
4378    {
4379        loadModule("APIDump");
4380   
4381        checkVersionNum($LVer, $DescPath);
4382        readDesc(createDesc($DescPath, $LVer), $LVer);
4383       
4384        initLogging($LVer);
4385       
4386        createAPIDump($LVer);
4387    }
4388   
4389    if(my $Dep = $In::Desc{$LVer}{"DepDump"}) {
4390        mergeAPIs($LVer, readAPIDump($LVer, $Dep, "Dep"));
4391    }
4392   
4393    printMsg("INFO", "Creating library API dump ...");
4394   
4395    $In::API{$LVer}{"API_DUMP_VERSION"} = $API_DUMP_VERSION;
4396    $In::API{$LVer}{"JAPI_COMPLIANCE_CHECKER_VERSION"} = $TOOL_VERSION;
4397   
4398    foreach ("TName_Tid") {
4399        delete($In::API{$LVer}{$_});
4400    }
4401   
4402    my $DumpPath = "api_dumps/".$In::Opt{"TargetLib"}."/".$In::Desc{$LVer}{"Version"}."/API.dump";
4403    if($In::Opt{"OutputDumpPath"})
4404    { # user defined path
4405        $DumpPath = $In::Opt{"OutputDumpPath"};
4406    }
4407   
4408    my $ArExt = $In::Opt{"Ar"};
4409    my $Archive = ($DumpPath=~s/\Q.$ArExt\E\Z//g);
4410   
4411    if($Archive)
4412    {
4413        my $TarCmd = getCmdPath("tar");
4414        if(not $TarCmd) {
4415            exitStatus("Not_Found", "can't find \"tar\"");
4416        }
4417        my $GzipCmd = getCmdPath("gzip");
4418        if(not $GzipCmd) {
4419            exitStatus("Not_Found", "can't find \"gzip\"");
4420        }
4421    }
4422   
4423    my ($DDir, $DName) = sepPath($DumpPath);
4424    my $DPath = $In::Opt{"Tmp"}."/".$DName;
4425    if(not $Archive) {
4426        $DPath = $DumpPath;
4427    }
4428   
4429    mkpath($DDir);
4430   
4431    open(DUMP, ">", $DPath) || die ("can't open file \'$DPath\': $!\n");
4432    print DUMP Dumper($In::API{$LVer});
4433    close(DUMP);
4434   
4435    if(not -s $DPath) {
4436        exitStatus("Error", "can't create API dump because something is going wrong with the Data::Dumper module");
4437    }
4438   
4439    if($Archive) {
4440        $DumpPath = createArchive($DPath, $DDir);
4441    }
4442   
4443    if($In::Opt{"OutputDumpPath"}) {
4444        printMsg("INFO", "Dump path: ".$In::Opt{"OutputDumpPath"});
4445    }
4446    else {
4447        printMsg("INFO", "Dump path: $DumpPath");
4448    }
4449    exit(0);
4450}
4451
4452sub compareInit()
4453{
4454    if(not $In::Desc{1}{"Path"}) {
4455        exitStatus("Error", "-old option is not specified");
4456    }
4457    if(not -e $In::Desc{1}{"Path"}) {
4458        exitStatus("Access_Error", "can't access \'".$In::Desc{1}{"Path"}."\'");
4459    }
4460    if(not $In::Desc{2}{"Path"}) {
4461        exitStatus("Error", "-new option is not specified");
4462    }
4463    if(not -e $In::Desc{2}{"Path"}) {
4464        exitStatus("Access_Error", "can't access \'".$In::Desc{2}{"Path"}."\'");
4465    }
4466   
4467    if($In::Opt{"Quick"})
4468    {
4469        $CompatRules{"Binary"}{"Interface_Added_Super_Interface"}{"Severity"} = "Low";
4470        $CompatRules{"Binary"}{"Abstract_Class_Added_Super_Abstract_Class"}{"Severity"} = "Low";
4471        $CompatRules{"Binary"}{"Abstract_Class_Added_Super_Interface"}{"Severity"} = "Low";
4472        $CompatRules{"Binary"}{"Abstract_Class_Added_Abstract_Method"}{"Severity"} = "Low";
4473        $CompatRules{"Binary"}{"Interface_Added_Abstract_Method"}{"Severity"} = "Low";
4474    }
4475   
4476    printMsg("INFO", "Preparing, please wait ...");
4477   
4478    detectDefaultPaths("bin", undef);
4479   
4480    if(isDump($In::Desc{1}{"Path"}))
4481    {
4482        $In::API{1} = readAPIDump(1, $In::Desc{1}{"Path"}, "Main");
4483        initAliases(1);
4484       
4485        if(my $V = $In::Desc{1}{"TargetVersion"}) {
4486            $In::Desc{1}{"Version"} = $V;
4487        }
4488        else {
4489            $In::Desc{1}{"Version"} = $In::API{1}{"LibraryVersion"};
4490        }
4491    }
4492    else
4493    {
4494        loadModule("APIDump");
4495       
4496        checkVersionNum(1, $In::Desc{1}{"Path"});
4497        readDesc(createDesc($In::Desc{1}{"Path"}, 1), 1);
4498       
4499        initLogging(1);
4500        detectDefaultPaths(undef, "java");
4501        createAPIDump(1);
4502    }
4503   
4504    if(my $Dep = $In::Desc{1}{"DepDump"}) {
4505        mergeAPIs(1, readAPIDump(1, $Dep, "Dep"));
4506    }
4507   
4508    if(isDump($In::Desc{2}{"Path"}))
4509    {
4510        $In::API{2} = readAPIDump(2, $In::Desc{2}{"Path"}, "Main");
4511        initAliases(2);
4512       
4513        if(my $V = $In::Desc{2}{"TargetVersion"}) {
4514            $In::Desc{2}{"Version"} = $V;
4515        }
4516        else {
4517            $In::Desc{2}{"Version"} = $In::API{2}{"LibraryVersion"};
4518        }
4519    }
4520    else
4521    {
4522        loadModule("APIDump");
4523       
4524        checkVersionNum(2, $In::Desc{2}{"Path"});
4525        readDesc(createDesc($In::Desc{2}{"Path"}, 2), 2);
4526       
4527        initLogging(2);
4528        detectDefaultPaths(undef, "java");
4529        createAPIDump(2);
4530    }
4531   
4532    if(my $Dep = $In::Desc{2}{"DepDump"}) {
4533        mergeAPIs(2, readAPIDump(2, $Dep, "Dep"));
4534    }
4535   
4536    prepareData(1);
4537    prepareData(2);
4538   
4539    foreach my $Inv (keys(%{$MethodUsed{2}}))
4540    {
4541        foreach my $M (keys(%{$MethodUsed{2}{$Inv}}))
4542        {
4543            my $InvType = $MethodUsed{2}{$Inv}{$M};
4544           
4545            if($InvType ne "static"
4546            and index($Inv, "<init>")==-1)
4547            {
4548                my $CName = $Inv;
4549                $CName=~s/\A\"\[L(.+);"/$1/g;
4550                $CName=~s/#/./g;
4551               
4552                if($CName=~/\A(.+?)\./)
4553                {
4554                    $CName = $1;
4555                    if($CName!~/\"/)
4556                    {
4557                        $CName=~s!/!.!g;
4558                        $ClassMethod_AddedUsed{$CName}{$Inv} = $M;
4559                    }
4560                }
4561            }
4562           
4563            if(not defined $MethodInfo{1}{$M}) {
4564                delete($MethodUsed{2}{$Inv}{$M});
4565            }
4566        }
4567    }
4568   
4569    foreach my $ClassName (keys(%ClassMethod_AddedUsed))
4570    {
4571        foreach my $MethodName (keys(%{$ClassMethod_AddedUsed{$ClassName}}))
4572        {
4573            if(defined $MethodInfo{1}{$MethodName}
4574            or defined $MethodInfo{2}{$MethodName}
4575            or defined $MethodUsed{1}{$MethodName}
4576            or findMethod($MethodName, 2, $ClassName, 1))
4577            { # abstract method added by the new super-class (abstract) or super-interface
4578                delete($ClassMethod_AddedUsed{$ClassName}{$MethodName});
4579            }
4580        }
4581        if(not keys(%{$ClassMethod_AddedUsed{$ClassName}})) {
4582            delete($ClassMethod_AddedUsed{$ClassName});
4583        }
4584    }
4585}
4586
4587sub scenario()
4588{
4589    setTarget("default");
4590   
4591    initAliases(1);
4592    initAliases(2);
4593   
4594    $In::Opt{"OrigDir"} = cwd();
4595    $In::Opt{"Tmp"} = tempdir(CLEANUP=>1);
4596    $In::Opt{"Reproducible"} = 1;
4597   
4598    $In::Opt{"JoinReport"} = 1;
4599    $In::Opt{"DoubleReport"} = 0;
4600   
4601    if($In::Opt{"BinaryOnly"} and $In::Opt{"SourceOnly"})
4602    { # both --binary and --source
4603      # is the default mode
4604        $In::Opt{"DoubleReport"} = 1;
4605        $In::Opt{"JoinReport"} = 0;
4606        $In::Opt{"BinaryOnly"} = 0;
4607        $In::Opt{"SourceOnly"} = 0;
4608        if($In::Opt{"OutputReportPath"})
4609        { # --report-path
4610            $In::Opt{"DoubleReport"} = 0;
4611            $In::Opt{"JoinReport"} = 1;
4612        }
4613    }
4614    elsif($In::Opt{"BinaryOnly"} or $In::Opt{"SourceOnly"})
4615    { # --binary or --source
4616        $In::Opt{"DoubleReport"} = 0;
4617        $In::Opt{"JoinReport"} = 0;
4618    }
4619    if(defined $In::Opt{"Help"})
4620    {
4621        helpMsg();
4622        exit(0);
4623    }
4624    if(defined $In::Opt{"ShowVersion"})
4625    {
4626        printMsg("INFO", "Java API Compliance Checker (JAPICC) $TOOL_VERSION\nCopyright (C) 2017 Andrey Ponomarenko's ABI Laboratory\nLicense: LGPL or GPL <http://www.gnu.org/licenses/>\nThis program is free software: you can redistribute it and/or modify it.\n\nWritten by Andrey Ponomarenko.");
4627        exit(0);
4628    }
4629    if(defined $In::Opt{"DumpVersion"})
4630    {
4631        printMsg("INFO", $TOOL_VERSION);
4632        exit(0);
4633    }
4634    $Data::Dumper::Sortkeys = 1;
4635   
4636    # FIXME: can't pass \&dumpSorting - cause a segfault sometimes
4637    if($In::Opt{"SortDump"})
4638    {
4639        $Data::Dumper::Useperl = 1;
4640        $Data::Dumper::Sortkeys = \&dumpSorting;
4641    }
4642   
4643    if(defined $In::Opt{"TestTool"})
4644    {
4645        detectDefaultPaths("bin", "java");
4646        loadModule("RegTests");
4647        testTool();
4648        exit(0);
4649    }
4650   
4651    if(defined $In::Opt{"ShortMode"})
4652    {
4653        if(not defined $In::Opt{"AffectLimit"}) {
4654            $In::Opt{"AffectLimit"} = 10;
4655        }
4656    }
4657   
4658    if(not $In::Opt{"TargetLib"} and not $In::Opt{"CountMethods"})
4659    {
4660        if($In::Opt{"DumpAPI"})
4661        {
4662            if($In::Opt{"DumpAPI"}=~/\.jar\Z/)
4663            { # short usage
4664                my ($Name, $Version) = getPkgVersion(getFilename($In::Opt{"DumpAPI"}));
4665                if($Name and $Version ne "")
4666                {
4667                    $In::Opt{"TargetLib"} = $Name;
4668                    if(not $In::Desc{1}{"TargetVersion"}) {
4669                        $In::Desc{1}{"TargetVersion"} = $Version;
4670                    }
4671                }
4672            }
4673        }
4674        else
4675        {
4676            if($In::Desc{1}{"Path"}=~/\.jar\Z/ and $In::Desc{2}{"Path"}=~/\.jar\Z/)
4677            { # short usage
4678                my ($Name1, $Version1) = getPkgVersion(getFilename($In::Desc{1}{"Path"}));
4679                my ($Name2, $Version2) = getPkgVersion(getFilename($In::Desc{2}{"Path"}));
4680               
4681                if($Name1 and $Version1 ne ""
4682                and $Version2 ne "")
4683                {
4684                    $In::Opt{"TargetLib"} = $Name1;
4685                    if(not $In::Desc{1}{"TargetVersion"}) {
4686                        $In::Desc{1}{"TargetVersion"} = $Version1;
4687                    }
4688                    if(not $In::Desc{2}{"TargetVersion"}) {
4689                        $In::Desc{2}{"TargetVersion"} = $Version2;
4690                    }
4691                }
4692            }
4693        }
4694       
4695        if(not $In::Opt{"TargetLib"}) {
4696            exitStatus("Error", "library name is not selected (option --lib=NAME)");
4697        }
4698    }
4699    else
4700    { # validate library name
4701        if($In::Opt{"TargetLib"}=~/[\*\/\\]/) {
4702            exitStatus("Error", "\"\\\", \"\/\" and \"*\" symbols are not allowed in the library name");
4703        }
4704    }
4705    if(not $In::Opt{"TargetTitle"}) {
4706        $In::Opt{"TargetTitle"} = $In::Opt{"TargetLib"};
4707    }
4708    if(my $ClassListPath = $In::Opt{"ClassListPath"})
4709    {
4710        if(not -f $ClassListPath) {
4711            exitStatus("Access_Error", "can't access file \'$ClassListPath\'");
4712        }
4713        foreach my $Class (split(/\n/, readFile($ClassListPath)))
4714        {
4715            $Class=~s/\//./g;
4716            $In::Opt{"ClassList_User"}{$Class} = 1;
4717        }
4718    }
4719    if(my $AnnotationsListPath = $In::Opt{"AnnotationsListPath"})
4720    {
4721        if(not -f $AnnotationsListPath) {
4722            exitStatus("Access_Error", "can't access file \'$AnnotationsListPath\'");
4723        }
4724        foreach my $Annotation (split(/\n/, readFile($AnnotationsListPath)))
4725        {
4726            $In::Opt{"AnnotationList_User"}{$Annotation} = 1;
4727        }
4728    }
4729    if(my $SkipAnnotationsListPath = $In::Opt{"SkipAnnotationsListPath"})
4730    {
4731        if(not -f $SkipAnnotationsListPath) {
4732            exitStatus("Access_Error", "can't access file \'$SkipAnnotationsListPath\'");
4733        }
4734        foreach my $Annotation (split(/\n/, readFile($SkipAnnotationsListPath)))
4735        {
4736            $In::Opt{"SkipAnnotationList_User"}{$Annotation} = 1;
4737        }
4738    }
4739    if(my $SkipClassesList = $In::Opt{"SkipClassesList"})
4740    {
4741        if(not -f $SkipClassesList) {
4742            exitStatus("Access_Error", "can't access file \'$SkipClassesList\'");
4743        }
4744        foreach my $Class (split(/\n/, readFile($SkipClassesList)))
4745        {
4746            $Class=~s/\//./g;
4747            $In::Opt{"SkipClasses"}{$Class} = 1;
4748        }
4749    }
4750    if(my $SkipPackagesList = $In::Opt{"SkipPackagesList"})
4751    {
4752        if(not -f $SkipPackagesList) {
4753            exitStatus("Access_Error", "can't access file \'$SkipPackagesList\'");
4754        }
4755        foreach my $Package (split(/\n/, readFile($SkipPackagesList)))
4756        {
4757            $In::Desc{1}{"SkipPackages"}{$Package} = 1;
4758            $In::Desc{2}{"SkipPackages"}{$Package} = 1;
4759        }
4760    }
4761    if(my $ClientPath = $In::Opt{"ClientPath"})
4762    {
4763        if($ClientPath=~/\.class\Z/) {
4764            exitStatus("Error", "input file is not a java archive");
4765        }
4766       
4767        if(-f $ClientPath)
4768        {
4769            detectDefaultPaths("bin", undef);
4770            readArchive(0, $ClientPath)
4771        }
4772        else {
4773            exitStatus("Access_Error", "can't access file \'$ClientPath\'");
4774        }
4775    }
4776   
4777    if(my $DPath = $In::Opt{"CountMethods"})
4778    {
4779        if(not -e $DPath) {
4780            exitStatus("Access_Error", "can't access \'$DPath\'");
4781        }
4782       
4783        $In::API{1} = readAPIDump(1, $DPath, "Main");
4784        initAliases(1);
4785       
4786        my $Count = 0;
4787        foreach my $Method (keys(%{$MethodInfo{1}})) {
4788            $Count += methodFilter($Method, 1);
4789        }
4790       
4791        printMsg("INFO", $Count);
4792        exit(0);
4793    }
4794   
4795    if($In::Opt{"DumpAPI"})
4796    {
4797        createAPIFile(1, $In::Opt{"DumpAPI"});
4798        exit(0);
4799    }
4800   
4801    compareInit();
4802   
4803    readRules("Binary");
4804    readRules("Source");
4805   
4806    detectAdded();
4807    detectRemoved();
4808   
4809    printMsg("INFO", "Comparing classes ...");
4810    mergeClasses();
4811    mergeMethods();
4812   
4813    printReport();
4814   
4815    if($RESULT{"Source"}{"Problems"} + $RESULT{"Binary"}{"Problems"}) {
4816        exit(getErrorCode("Incompatible"));
4817    }
4818    else {
4819        exit(getErrorCode("Compatible"));
4820    }
4821}
4822
4823scenario();
Note: See TracBrowser for help on using the repository browser.