source: josm/trunk/tools/japicc/modules/Internals/APIDump.pm @ 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: 31.2 KB
Line 
1###########################################################################
2# A module to create API dump from disassembled code
3#
4# Copyright (C) 2016-2017 Andrey Ponomarenko's ABI Laboratory
5#
6# Written by Andrey Ponomarenko
7#
8# This program is free software: you can redistribute it and/or modify
9# it under the terms of the GNU General Public License or the GNU Lesser
10# General Public License as published by the Free Software Foundation.
11#
12# This program is distributed in the hope that it will be useful,
13# but WITHOUT ANY WARRANTY; without even the implied warranty of
14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15# GNU General Public License for more details.
16#
17# You should have received a copy of the GNU General Public License
18# and the GNU Lesser General Public License along with this program.
19# If not, see <http://www.gnu.org/licenses/>.
20###########################################################################
21use strict;
22use IPC::Open3;
23
24my $ExtractCounter = 0;
25
26my %MName_Mid;
27my %Mid_MName;
28
29my $T_ID = 0;
30my $M_ID = 0;
31my $U_ID = 0;
32
33# Aliases
34my (%MethodInfo, %TypeInfo, %TName_Tid) = ();
35
36foreach (1, 2)
37{
38    $MethodInfo{$_} = $In::API{$_}{"MethodInfo"};
39    $TypeInfo{$_} = $In::API{$_}{"TypeInfo"};
40    $TName_Tid{$_} = $In::API{$_}{"TName_Tid"};
41}
42
43sub createAPIDump($)
44{
45    my $LVer = $_[0];
46   
47    readArchives($LVer);
48   
49    if(not keys(%{$MethodInfo{$LVer}})) {
50        printMsg("WARNING", "empty dump");
51    }
52   
53    $In::API{$LVer}{"LibraryVersion"} = $In::Desc{$LVer}{"Version"};
54    $In::API{$LVer}{"LibraryName"} = $In::Opt{"TargetLib"};
55    $In::API{$LVer}{"Language"} = "Java";
56}
57
58sub readArchives($)
59{
60    my $LVer = $_[0];
61    my @ArchivePaths = getArchives($LVer);
62    if($#ArchivePaths==-1) {
63        exitStatus("Error", "Java archives are not found in ".$In::Desc{$LVer}{"Version"});
64    }
65    printMsg("INFO", "Reading classes ".$In::Desc{$LVer}{"Version"}." ...");
66   
67    $T_ID = 0;
68    $M_ID = 0;
69    $U_ID = 0;
70   
71    %MName_Mid = ();
72    %Mid_MName = ();
73   
74    foreach my $ArchivePath (sort {length($a)<=>length($b)} @ArchivePaths) {
75        readArchive($LVer, $ArchivePath);
76    }
77    foreach my $TName (keys(%{$TName_Tid{$LVer}}))
78    {
79        my $Tid = $TName_Tid{$LVer}{$TName};
80        if(not $TypeInfo{$LVer}{$Tid}{"Type"})
81        {
82            if($TName=~/\A(void|boolean|char|byte|short|int|float|long|double)\Z/) {
83                $TypeInfo{$LVer}{$Tid}{"Type"} = "primitive";
84            }
85            else {
86                $TypeInfo{$LVer}{$Tid}{"Type"} = "class";
87            }
88        }
89    }
90}
91
92sub getArchives($)
93{
94    my $LVer = $_[0];
95    my @Paths = ();
96    foreach my $Path (keys(%{$In::Desc{$LVer}{"Archives"}}))
97    {
98        if(not -e $Path) {
99            exitStatus("Access_Error", "can't access \'$Path\'");
100        }
101       
102        foreach (getArchivePaths($Path, $LVer)) {
103            push(@Paths, $_);
104        }
105    }
106    return @Paths;
107}
108
109sub readArchive($$)
110{ # 1, 2 - library, 0 - client
111    my ($LVer, $Path) = @_;
112   
113    $Path = getAbsPath($Path);
114    my $JarCmd = getCmdPath("jar");
115    if(not $JarCmd) {
116        exitStatus("Not_Found", "can't find \"jar\" command");
117    }
118    my $ExtractPath = join_P($In::Opt{"Tmp"}, $ExtractCounter);
119    if(-d $ExtractPath) {
120        rmtree($ExtractPath);
121    }
122    mkpath($ExtractPath);
123    chdir($ExtractPath);
124    system($JarCmd." -xf \"$Path\"");
125    if($?) {
126        exitStatus("Error", "can't extract \'$Path\'");
127    }
128    chdir($In::Opt{"OrigDir"});
129    my @Classes = ();
130    foreach my $ClassPath (cmdFind($ExtractPath, "", "*\\.class"))
131    {
132        if($In::Opt{"OS"} ne "windows") {
133            $ClassPath=~s/\.class\Z//g;
134        }
135       
136        my $ClassName = getFilename($ClassPath);
137        if($ClassName=~/\$\d/) {
138            next;
139        }
140        $ClassPath = cutPrefix($ClassPath, $ExtractPath); # javap decompiler accepts relative paths only
141       
142        my $ClassDir = getDirname($ClassPath);
143        if($ClassDir=~/\./)
144        { # jaxb-osgi.jar/1.0/org/apache
145            next;
146        }
147       
148        my $Package = getPFormat($ClassDir);
149        if($LVer)
150        {
151            if(skipPackage($Package, $LVer))
152            { # internal packages
153                next;
154            }
155        }
156       
157        push(@Classes, $ClassPath);
158    }
159   
160    if($#Classes!=-1)
161    {
162        foreach my $PartRef (divideArray(\@Classes))
163        {
164            if($LVer) {
165                readClasses($PartRef, $LVer, getFilename($Path));
166            }
167            else {
168                readClasses_Usage($PartRef);
169            }
170        }
171    }
172   
173    $ExtractCounter += 1;
174   
175    if($LVer)
176    {
177        foreach my $SubArchive (cmdFind($ExtractPath, "", "*\\.jar"))
178        { # recursive step
179            readArchive($LVer, $SubArchive);
180        }
181    }
182   
183    rmtree($ExtractPath);
184}
185
186sub sepParams($$$)
187{
188    my ($Params, $Comma, $Sp) = @_;
189    my @Parts = ();
190    my %B = ( "("=>0, "<"=>0, ")"=>0, ">"=>0 );
191    my $Part = 0;
192    foreach my $Pos (0 .. length($Params) - 1)
193    {
194        my $S = substr($Params, $Pos, 1);
195        if(defined $B{$S}) {
196            $B{$S} += 1;
197        }
198        if($S eq "," and
199        $B{"("}==$B{")"} and $B{"<"}==$B{">"})
200        {
201            if($Comma)
202            { # include comma
203                $Parts[$Part] .= $S;
204            }
205            $Part += 1;
206        }
207        else {
208            $Parts[$Part] .= $S;
209        }
210    }
211    if(not $Sp)
212    { # remove spaces
213        foreach (@Parts)
214        {
215            s/\A //g;
216            s/ \Z//g;
217        }
218    }
219    return @Parts;
220}
221
222sub simpleDecl($)
223{
224    my $Line = $_[0];
225   
226    my %B = ( "<"=>0, ">"=>0 );
227    my @Chars = split("", $Line);
228   
229    my $Extends = undef;
230    my ($Pre, $Post) = ("", "");
231    my @Replace = ();
232   
233    foreach my $Pos (0 .. $#Chars)
234    {
235        my $S = $Chars[$Pos];
236        if(defined $B{$S}) {
237            $B{$S} += 1;
238        }
239       
240        if($B{"<"}!=0)
241        {
242            if(defined $Extends)
243            {
244                my $E = 0;
245               
246                if($S eq ",")
247                {
248                    if($B{"<"}-$B{">"}==$Extends) {
249                        $E = 1;
250                    }
251                }
252                elsif($S eq ">")
253                {
254                    if($B{"<"}==$B{">"} or $B{"<"}-$B{">"}+1==$Extends) {
255                        $E = 1;
256                    }
257                }
258               
259                if($E)
260                {
261                    if($Post) {
262                        push(@Replace, $Post);
263                    }
264                   
265                    $Extends = undef;
266                    ($Pre, $Post) = ("", "");
267                }
268            }
269            elsif($B{"<"}!=$B{">"})
270            {
271                if(substr($Pre, -9) eq " extends ")
272                {
273                    $Extends = $B{"<"}-$B{">"};
274                }
275            }
276        }
277       
278        $Pre .= $S;
279        if(defined $Extends) {
280            $Post .= $S;
281        }
282    }
283   
284    my %Tmpl = ();
285   
286    foreach my $R (@Replace)
287    {
288        if($Line=~s/([A-Za-z\d\?]+) extends \Q$R\E/$1/) {
289            $Tmpl{$1} = $R;
290        }
291    }
292   
293    return ($Line, \%Tmpl);
294}
295
296sub readClasses($$$)
297{
298    my ($Paths, $LVer, $ArchiveName) = @_;
299   
300    my $JavapCmd = getCmdPath("javap");
301    if(not $JavapCmd) {
302        exitStatus("Not_Found", "can't find \"javap\" command");
303    }
304   
305    my $TmpDir = $In::Opt{"Tmp"};
306   
307    # ! private info should be processed
308    my @Cmd = ($JavapCmd, "-s", "-private");
309    if(not $In::Opt{"Quick"}) {
310        @Cmd = (@Cmd, "-c", "-verbose");
311    }
312   
313    @Cmd = (@Cmd, @{$Paths});
314   
315    chdir($TmpDir."/".$ExtractCounter);
316    my $Pid = open3(*IN, *OUT, *ERR, @Cmd);
317    close(IN);
318   
319    my (%TypeAttr, $CurrentMethod, $CurrentPackage, $CurrentClass) = ();
320    my ($InParamTable, $InVarTypeTable, $InExceptionTable, $InCode) = (0, 0, 0, 0);
321   
322    my $InAnnotations = undef;
323    my $InAnnotations_Class = undef;
324    my $InAnnotations_Method = undef;
325    my %AnnotationName = ();
326    my %AnnotationNum = (); # support for Java 7
327   
328    my ($ParamPos, $FieldPos) = (0, 0);
329    my ($LINE, $Stay, $Run, $NonEmpty) = (undef, 0, 1, undef);
330   
331    my $DContent = "";
332    my $Debug = (defined $In::Opt{"Debug"});
333   
334    while($Run)
335    {
336        if(not $Stay)
337        {
338            $LINE = <OUT>;
339           
340            if(not defined $NonEmpty and $LINE) {
341                $NonEmpty = 1;
342            }
343           
344            if($Debug) {
345                $DContent .= $LINE;
346            }
347        }
348       
349        if(not $LINE)
350        {
351            $Run = 0;
352            last;
353        }
354       
355        $Stay = 0;
356       
357        if($LINE=~/\A\s*const/) {
358            next;
359        }
360       
361        if(index($LINE, 'Start  Length')!=-1
362        or index($LINE, 'Compiled from')!=-1
363        or index($LINE, 'Last modified')!=-1
364        or index($LINE, 'MD5 checksum')!=-1
365        or index($LINE, 'Classfile /')==0
366        or index($LINE, 'Classfile jar')==0)
367        {
368            next;
369        }
370       
371        if(index($LINE, '=')!=-1)
372        {
373            if(index($LINE, ' stack=')!=-1
374            or index($LINE, 'frame_type =')!=-1
375            or index($LINE, 'offset_delta =')!=-1)
376            {
377                next;
378            }
379        }
380       
381        if(index($LINE, ':')!=-1)
382        {
383            if(index($LINE, ' LineNumberTable:')!=-1
384            or index($LINE, 'SourceFile:')==0
385            or index($LINE, ' StackMapTable:')!=-1
386            or index($LINE, ' Exceptions:')!=-1
387            or index($LINE, 'Constant pool:')!=-1
388            or index($LINE, 'minor version:')!=-1
389            or index($LINE, 'major version:')!=-1
390            or index($LINE, ' AnnotationDefault:')!=-1)
391            {
392                next;
393            }
394        }
395       
396        if(index($LINE, " of ")!=-1
397        or index($LINE, "= [")!=-1) {
398            next;
399        }
400       
401        if($LINE=~/ line \d+:|\[\s*class|\$\d|\._\d/)
402        { # artificial methods and code
403            next;
404        }
405       
406        # $LINE=~s/ \$(\w)/ $1/g;
407       
408        if(index($LINE, '$')!=-1)
409        {
410            if(index($LINE, ' class$')!=-1
411            or index($LINE, '$eq')!=-1
412            or index($LINE, '.$')!=-1
413            or index($LINE, '/$')!=-1
414            or index($LINE, '$$')!=-1
415            or index($LINE, '$(')!=-1
416            or index($LINE, '$:')!=-1
417            or index($LINE, '$.')!=-1
418            or index($LINE, '$;')!=-1) {
419                next;
420            }
421           
422            if($LINE=~/ (\w+\$|)\w+\$\w+[\(:]/) {
423                next;
424            }
425           
426            if(not $InParamTable and not $InVarTypeTable)
427            {
428                if(index($LINE, ' $')!=-1) {
429                    next;
430                }
431            }
432           
433            $LINE=~s/\$([\> ]|\s*\Z)/$1/g;
434        }
435       
436        my $EndBr = ($LINE eq "}\n" or $LINE eq "}\r\n");
437       
438        if($EndBr) {
439            $InAnnotations_Class = 1;
440        }
441       
442        if($EndBr or $LINE eq "\n" or $LINE eq "\r\n")
443        {
444            $CurrentMethod = undef;
445            $InCode = 0;
446            $InAnnotations_Method = 0;
447            $InParamTable = 0;
448            $InVarTypeTable = 0;
449            next;
450        }
451       
452        if(index($LINE, '#')!=-1)
453        {
454            if($LINE=~/\A\s*#(\d+)/)
455            { # Constant pool
456                my $CNum = $1;
457                if($LINE=~/\s+([^ ]+?);/)
458                {
459                    my $AName = $1;
460                    $AName=~s/\AL//;
461                    $AName=~s/\$/./g;
462                    $AName=~s/\//./g;
463                   
464                    $AnnotationName{$CNum} = $AName;
465                   
466                    if(defined $AnnotationNum{$CNum})
467                    { # support for Java 7
468                        if($InAnnotations_Class) {
469                            $TypeAttr{"Annotations"}{registerType($AName, $LVer)} = 1;
470                        }
471                        delete($AnnotationNum{$CNum});
472                    }
473                }
474               
475                next;
476            }
477           
478            if(index($LINE, ": #")!=-1 and index($LINE, "//")!=-1) {
479                next;
480            }
481        }
482       
483        my $TmplP = undef;
484       
485        # Java 7: templates
486        if(index($LINE, "<")!=-1)
487        { # <T extends java.lang.Object>
488          # <KEYIN extends java.lang.Object ...
489            if($LINE=~/<[A-Z\d\?]+ /i) {
490                ($LINE, $TmplP) = simpleDecl($LINE);
491            }
492        }
493       
494        if(index($LINE, ',')!=-1) {
495            $LINE=~s/\s*,\s*/,/g;
496        }
497       
498        if(index($LINE, '$')!=-1) {
499            $LINE=~s/\$/#/g;
500        }
501       
502        if(index($LINE, "LocalVariableTable")!=-1) {
503            $InParamTable += 1;
504        }
505        elsif(index($LINE, "LocalVariableTypeTable")!=-1) {
506            $InVarTypeTable += 1;
507        }
508        elsif(index($LINE, "Exception table")!=-1) {
509            $InExceptionTable = 1;
510        }
511        elsif(index($LINE, " Code:")!=-1)
512        {
513            $InCode += 1;
514            $InAnnotations = undef;
515        }
516        elsif(index($LINE, ':')!=-1
517        and $LINE=~/\A\s*\d+:\s*/)
518        { # read Code
519            if($InCode==1)
520            {
521                if($CurrentMethod)
522                {
523                    if(index($LINE, "invoke")!=-1)
524                    {
525                        if($LINE=~/ invoke(\w+) .* \/\/\s*(Method|InterfaceMethod)\s+(.+?)\s*\Z/)
526                        { # 3:   invokevirtual   #2; //Method "[Lcom/sleepycat/je/Database#DbState;".clone:()Ljava/lang/Object;
527                            my ($InvokeType, $InvokedName) = ($1, $3);
528                           
529                            if($InvokedName!~/\A(\w+:|java\/(lang|util|io)\/)/
530                            and index($InvokedName, '"<init>":')!=0)
531                            {
532                                $InvokedName=~s/#/\$/g;
533                               
534                                my $ID = undef;
535                                if($In::Opt{"Reproducible"}) {
536                                    $ID = getMd5($InvokedName);
537                                }
538                                else {
539                                    $ID = ++$U_ID;
540                                }
541                               
542                                $In::API{$LVer}{"MethodUsed"}{$ID}{"Name"} = $InvokedName;
543                                $In::API{$LVer}{"MethodUsed"}{$ID}{"Used"}{$CurrentMethod} = $InvokeType;
544                            }
545                        }
546                    }
547                    # elsif($LINE=~/ (getstatic|putstatic) .* \/\/\s*Field\s+(.+?)\s*\Z/)
548                    # {
549                    #     my $UsedFieldName = $2;
550                    #     $In::API{$LVer}{"FieldUsed"}{$UsedFieldName}{$CurrentMethod} = 1;
551                    # }
552                }
553            }
554            elsif(defined $InAnnotations)
555            {
556                if($LINE=~/\A\s*\d+\:\s*#(\d+)/)
557                {
558                    if(my $AName = $AnnotationName{$1})
559                    {
560                        if($InAnnotations_Class) {
561                            $TypeAttr{"Annotations"}{registerType($AName, $LVer)} = 1;
562                        }
563                        elsif($InAnnotations_Method) {
564                            $MethodInfo{$LVer}{$MName_Mid{$CurrentMethod}}{"Annotations"}{registerType($AName, $LVer)} = 1;
565                        }
566                    }
567                    else
568                    { # suport for Java 7
569                        $AnnotationNum{$1} = 1;
570                    }
571                }
572            }
573        }
574        elsif($InParamTable==1 and $LINE=~/\A\s+\d/)
575        { # read parameter names from LocalVariableTable
576            if($CurrentMethod and $LINE=~/\A\s+0\s+\d+\s+\d+\s+(\#?)(\w+)/)
577            {
578                my $Art = $1;
579                my $PName = $2;
580               
581                if(($PName ne "this" or $Art) and $PName=~/[a-z]/i)
582                {
583                    if($CurrentMethod)
584                    {
585                        my $ID = $MName_Mid{$CurrentMethod};
586                       
587                        if(defined $MethodInfo{$LVer}{$ID}
588                        and defined $MethodInfo{$LVer}{$ID}{"Param"}
589                        and defined $MethodInfo{$LVer}{$ID}{"Param"}{$ParamPos}
590                        and defined $MethodInfo{$LVer}{$ID}{"Param"}{$ParamPos}{"Type"})
591                        {
592                            $MethodInfo{$LVer}{$ID}{"Param"}{$ParamPos}{"Name"} = $PName;
593                            $ParamPos++;
594                        }
595                    }
596                }
597            }
598        }
599        elsif($InVarTypeTable==1 and $LINE=~/\A\s+\d/)
600        {
601            # skip
602        }
603        elsif($CurrentClass and index($LINE, '(')!=-1
604        and $LINE=~/(\A|\s+)([^\s]+)\s+([^\s]+)\s*\((.*)\)\s*(throws\s*([^\s]+)|)\s*;\s*\Z/)
605        { # attributes of methods and constructors
606            my (%MethodAttr, $ParamsLine, $Exceptions) = ();
607           
608            $InParamTable = 0; # read the first local variable table
609            $InVarTypeTable = 0;
610            $InCode = 0; # read the first code
611            $InAnnotations_Method = 1;
612            $InAnnotations_Class = 0;
613           
614            ($MethodAttr{"Return"}, $MethodAttr{"ShortName"}, $ParamsLine, $Exceptions) = ($2, $3, $4, $6);
615            $MethodAttr{"ShortName"}=~s/#/./g;
616           
617            if($Exceptions)
618            {
619                foreach my $E (split(/,/, $Exceptions)) {
620                    $MethodAttr{"Exceptions"}{registerType($E, $LVer)} = 1;
621                }
622            }
623            if($LINE=~/(\A|\s+)(public|protected|private)\s+/) {
624                $MethodAttr{"Access"} = $2;
625            }
626            else {
627                $MethodAttr{"Access"} = "package-private";
628            }
629            $MethodAttr{"Class"} = registerType($TypeAttr{"Name"}, $LVer);
630            if($MethodAttr{"ShortName"}=~/\A(|(.+)\.)\Q$CurrentClass\E\Z/)
631            {
632                if($2)
633                {
634                    $MethodAttr{"Package"} = $2;
635                    $CurrentPackage = $MethodAttr{"Package"};
636                    $MethodAttr{"ShortName"} = $CurrentClass;
637                }
638                $MethodAttr{"Constructor"} = 1;
639                delete($MethodAttr{"Return"});
640            }
641            else
642            {
643                $MethodAttr{"Return"} = registerType($MethodAttr{"Return"}, $LVer);
644            }
645           
646            my @Params = sepParams($ParamsLine, 0, 1);
647           
648            $ParamPos = 0;
649            foreach my $ParamTName (@Params)
650            {
651                %{$MethodAttr{"Param"}{$ParamPos}} = ("Type"=>registerType($ParamTName, $LVer), "Name"=>"p".($ParamPos+1));
652                $ParamPos++;
653            }
654            $ParamPos = 0;
655            if(not $MethodAttr{"Constructor"})
656            { # methods
657                if($CurrentPackage) {
658                    $MethodAttr{"Package"} = $CurrentPackage;
659                }
660                if($LINE=~/(\A|\s+)abstract\s+/) {
661                    $MethodAttr{"Abstract"} = 1;
662                }
663                if($LINE=~/(\A|\s+)final\s+/) {
664                    $MethodAttr{"Final"} = 1;
665                }
666                if($LINE=~/(\A|\s+)static\s+/) {
667                    $MethodAttr{"Static"} = 1;
668                }
669                if($LINE=~/(\A|\s+)native\s+/) {
670                    $MethodAttr{"Native"} = 1;
671                }
672                if($LINE=~/(\A|\s+)synchronized\s+/) {
673                    $MethodAttr{"Synchronized"} = 1;
674                }
675            }
676           
677            my $LINE_N = <OUT>;
678           
679            if($Debug) {
680                $DContent .= $LINE_N;
681            }
682           
683            # $LINE_N=~s/ \$(\w)/ $1/g;
684            $LINE_N=~s/\$([\> ]|\s*\Z)/$1/g;
685           
686            # read the Signature
687            if(index($LINE_N, ": #")==-1
688            and $LINE_N=~/(Signature|descriptor):\s*(.+?)\s*\Z/i)
689            { # create run-time unique name ( java/io/PrintStream.println (Ljava/lang/String;)V )
690                if($MethodAttr{"Constructor"}) {
691                    $CurrentMethod = $CurrentClass.".\"<init>\":".$2;
692                }
693                else {
694                    $CurrentMethod = $CurrentClass.".".$MethodAttr{"ShortName"}.":".$2;
695                }
696                if(my $PackageName = getSFormat($CurrentPackage)) {
697                    $CurrentMethod = $PackageName."/".$CurrentMethod;
698                }
699            }
700            else {
701                exitStatus("Error", "internal error - can't read method signature");
702            }
703           
704            $MethodAttr{"Archive"} = $ArchiveName;
705            if($CurrentMethod)
706            {
707                my $ID = undef;
708                if($In::Opt{"Reproducible"}) {
709                    $ID = getMd5($CurrentMethod);
710                }
711                else {
712                    $ID = ++$M_ID;
713                }
714               
715                $MName_Mid{$CurrentMethod} = $ID;
716               
717                if(defined $Mid_MName{$ID} and $Mid_MName{$ID} ne $CurrentMethod) {
718                    printMsg("ERROR", "md5 collision on \'$ID\', please increase ID length (MD5_LEN in Basic.pm)");
719                }
720               
721                $Mid_MName{$ID} = $CurrentMethod;
722               
723                $MethodAttr{"Name"} = $CurrentMethod;
724                $MethodInfo{$LVer}{$ID} = \%MethodAttr;
725            }
726        }
727        elsif($CurrentClass and $LINE=~/(\A|\s+)([^\s]+)\s+(\w+);\s*\Z/)
728        { # fields
729            my ($TName, $FName) = ($2, $3);
730            $TypeAttr{"Fields"}{$FName}{"Type"} = registerType($TName, $LVer);
731            if($LINE=~/(\A|\s+)final\s+/) {
732                $TypeAttr{"Fields"}{$FName}{"Final"} = 1;
733            }
734            if($LINE=~/(\A|\s+)static\s+/) {
735                $TypeAttr{"Fields"}{$FName}{"Static"} = 1;
736            }
737            if($LINE=~/(\A|\s+)transient\s+/) {
738                $TypeAttr{"Fields"}{$FName}{"Transient"} = 1;
739            }
740            if($LINE=~/(\A|\s+)volatile\s+/) {
741                $TypeAttr{"Fields"}{$FName}{"Volatile"} = 1;
742            }
743            if($LINE=~/(\A|\s+)(public|protected|private)\s+/) {
744                $TypeAttr{"Fields"}{$FName}{"Access"} = $2;
745            }
746            else {
747                $TypeAttr{"Fields"}{$FName}{"Access"} = "package-private";
748            }
749           
750            $TypeAttr{"Fields"}{$FName}{"Pos"} = $FieldPos++;
751           
752            my $LINE_NP = <OUT>;
753            if($Debug) {
754                $DContent .= $LINE_NP;
755            }
756           
757            # read the Signature
758            if(index($LINE_NP, ": #")==-1
759            and $LINE_NP=~/(Signature|descriptor):\s*(.+?)\s*\Z/i)
760            {
761                my $FSignature = $2;
762                if(my $PackageName = getSFormat($CurrentPackage)) {
763                    $TypeAttr{"Fields"}{$FName}{"Mangled"} = $PackageName."/".$CurrentClass.".".$FName.":".$FSignature;
764                }
765            }
766           
767            $LINE_NP = <OUT>;
768            if($Debug) {
769                $DContent .= $LINE_NP;
770            }
771           
772            if($LINE_NP=~/flags:/i)
773            { # flags: ACC_PUBLIC, ACC_STATIC, ACC_FINAL, ACC_ANNOTATION
774                $LINE_NP = <OUT>;
775                if($Debug) {
776                    $DContent .= $LINE_NP;
777                }
778            }
779            else
780            {
781                $LINE = $LINE_NP;
782                $Stay = 1;
783            }
784           
785            # read the Value
786            if($LINE_NP=~/Constant\s*value:\s*([^\s]+)\s(.*?)\s*\Z/i)
787            {
788              # Java 6: Constant value: ...
789              # Java 7: ConstantValue: ...
790                my ($TName, $Value) = ($1, $2);
791                if($Value)
792                {
793                    if($Value=~s/Deprecated:\s*true\Z//g) {
794                        # deprecated values: ?
795                    }
796                    $TypeAttr{"Fields"}{$FName}{"Value"} = $Value;
797                }
798                elsif($TName eq "String") {
799                    $TypeAttr{"Fields"}{$FName}{"Value"} = "\@EMPTY_STRING\@";
800                }
801            }
802            else
803            {
804                $LINE = $LINE_NP;
805                $Stay = 1;
806            }
807        }
808        elsif($LINE=~/(\A|\s+)(class|interface)\s+([^\s\{]+)(\s+|\{|\s*\Z)/)
809        { # properties of classes and interfaces
810            if($TypeAttr{"Name"})
811            { # register previous
812                %{$TypeInfo{$LVer}{registerType($TypeAttr{"Name"}, $LVer)}} = %TypeAttr;
813            }
814           
815            %TypeAttr = ("Type"=>$2, "Name"=>$3); # reset previous class
816            %AnnotationName = (); # reset annotations of the class
817            %AnnotationNum = (); # support for Java 7
818            $InAnnotations_Class = 1;
819           
820            $FieldPos = 0; # reset field position
821            $CurrentMethod = ""; # reset current method
822            $TypeAttr{"Archive"} = $ArchiveName;
823            if($TypeAttr{"Name"}=~/\A(.+)\.([^.]+)\Z/)
824            {
825                $CurrentClass = $2;
826                $TypeAttr{"Package"} = $1;
827                $CurrentPackage = $TypeAttr{"Package"};
828            }
829            else
830            {
831                $CurrentClass = $TypeAttr{"Name"};
832                $CurrentPackage = "";
833            }
834            if($CurrentClass=~s/#/./g)
835            { # javax.swing.text.GlyphView.GlyphPainter <=> GlyphView$GlyphPainter
836                $TypeAttr{"Name"}=~s/#/./g;
837            }
838            if($LINE=~/(\A|\s+)(public|protected|private)\s+/) {
839                $TypeAttr{"Access"} = $2;
840            }
841            else {
842                $TypeAttr{"Access"} = "package-private";
843            }
844            if($LINE=~/\s+extends\s+([^\s\{]+)/)
845            {
846                my $Extended = $1;
847               
848                if($TypeAttr{"Type"} eq "class")
849                {
850                    if($Extended ne $CurrentPackage.".".$CurrentClass) {
851                        $TypeAttr{"SuperClass"} = registerType($Extended, $LVer);
852                    }
853                }
854                elsif($TypeAttr{"Type"} eq "interface")
855                {
856                    my @Elems = sepParams($Extended, 0, 0);
857                    foreach my $SuperInterface (@Elems)
858                    {
859                        if($SuperInterface ne $CurrentPackage.".".$CurrentClass) {
860                            $TypeAttr{"SuperInterface"}{registerType($SuperInterface, $LVer)} = 1;
861                        }
862                       
863                        if($SuperInterface eq "java.lang.annotation.Annotation") {
864                            $TypeAttr{"Annotation"} = 1;
865                        }
866                    }
867                }
868            }
869            if($LINE=~/\s+implements\s+([^\s\{]+)/)
870            {
871                my $Implemented = $1;
872                my @Elems = sepParams($Implemented, 0, 0);
873               
874                foreach my $SuperInterface (@Elems) {
875                    $TypeAttr{"SuperInterface"}{registerType($SuperInterface, $LVer)} = 1;
876                }
877            }
878            if($LINE=~/(\A|\s+)abstract\s+/) {
879                $TypeAttr{"Abstract"} = 1;
880            }
881            if($LINE=~/(\A|\s+)final\s+/) {
882                $TypeAttr{"Final"} = 1;
883            }
884            if($LINE=~/(\A|\s+)static\s+/) {
885                $TypeAttr{"Static"} = 1;
886            }
887        }
888        elsif(index($LINE, "Deprecated: true")!=-1
889        or index($LINE, "Deprecated: length")!=-1)
890        { # deprecated method or class
891            if($CurrentMethod) {
892                $MethodInfo{$LVer}{$MName_Mid{$CurrentMethod}}{"Deprecated"} = 1;
893            }
894            elsif($CurrentClass) {
895                $TypeAttr{"Deprecated"} = 1;
896            }
897        }
898        elsif(index($LINE, "RuntimeInvisibleAnnotations")!=-1
899        or index($LINE, "RuntimeVisibleAnnotations")!=-1)
900        {
901            $InAnnotations = 1;
902            $InCode = 0;
903        }
904        elsif(defined $InAnnotations and index($LINE, "InnerClasses")!=-1) {
905            $InAnnotations = undef;
906        }
907        else
908        {
909            # unparsed
910        }
911    }
912   
913    if($TypeAttr{"Name"})
914    { # register last
915        %{$TypeInfo{$LVer}{registerType($TypeAttr{"Name"}, $LVer)}} = %TypeAttr;
916    }
917   
918    waitpid($Pid, 0);
919    chdir($In::Opt{"OrigDir"});
920   
921    if(not $NonEmpty) {
922        exitStatus("Error", "internal error in parser");
923    }
924   
925    if($Debug) {
926        appendFile(getDebugDir($LVer)."/class-dump.txt", $DContent);
927    }
928}
929
930sub registerType($$)
931{
932    my ($TName, $LVer) = @_;
933   
934    if(not $TName) {
935        return 0;
936    }
937   
938    $TName=~s/#/./g;
939    if($TName_Tid{$LVer}{$TName}) {
940        return $TName_Tid{$LVer}{$TName};
941    }
942   
943    if(not $TName_Tid{$LVer}{$TName})
944    {
945        my $ID = undef;
946        if($In::Opt{"Reproducible"}) {
947            $ID = getMd5($TName);
948        }
949        else {
950            $ID = ++$T_ID;
951        }
952        $TName_Tid{$LVer}{$TName} = "$ID";
953    }
954   
955    my $Tid = $TName_Tid{$LVer}{$TName};
956    $TypeInfo{$LVer}{$Tid}{"Name"} = $TName;
957    if($TName=~/(.+)\[\]\Z/)
958    {
959        if(my $BaseTypeId = registerType($1, $LVer))
960        {
961            $TypeInfo{$LVer}{$Tid}{"BaseType"} = $BaseTypeId;
962            $TypeInfo{$LVer}{$Tid}{"Type"} = "array";
963        }
964    }
965   
966    return $Tid;
967}
968
969sub readClasses_Usage($)
970{
971    my $Paths = $_[0];
972   
973    my $JavapCmd = getCmdPath("javap");
974    if(not $JavapCmd) {
975        exitStatus("Not_Found", "can't find \"javap\" command");
976    }
977   
978    my $Input = join(" ", @{$Paths});
979    if($In::Opt{"OS"} ne "windows")
980    { # on unix ensure that the system does not try and interpret the $, by escaping it
981        $Input=~s/\$/\\\$/g;
982    }
983   
984    my $TmpDir = $In::Opt{"Tmp"};
985   
986    chdir($TmpDir."/".$ExtractCounter);
987    open(CONTENT, "$JavapCmd -c -private $Input 2>\"$TmpDir/warn\" |");
988    while(<CONTENT>)
989    {
990        if(/\/\/\s*(Method|InterfaceMethod)\s+(.+)\s*\Z/)
991        {
992            my $M = $2;
993            $In::Opt{"UsedMethods_Client"}{$M} = 1;
994           
995            if($M=~/\A(.*)+\.\w+\:\(/)
996            {
997                my $C = $1;
998                $C=~s/\//./g;
999                $In::Opt{"UsedClasses_Client"}{$C} = 1;
1000            }
1001        }
1002        elsif(/\/\/\s*Field\s+(.+)\s*\Z/)
1003        {
1004            # my $FieldName = $1;
1005            # if(/\s+(putfield|getfield|getstatic|putstatic)\s+/) {
1006            #     $UsedFields_Client{$FieldName} = $1;
1007            # }
1008        }
1009        elsif(/ ([^\s]+) [^: ]+\(([^()]+)\)/)
1010        {
1011            my ($Ret, $Params) = ($1, $2);
1012           
1013            $Ret=~s/\[\]//g; # quals
1014            $In::Opt{"UsedClasses_Client"}{$Ret} = 1;
1015           
1016            foreach my $Param (split(/\s*,\s*/, $Params))
1017            {
1018                $Param=~s/\[\]//g; # quals
1019                $In::Opt{"UsedClasses_Client"}{$Param} = 1;
1020            }
1021        }
1022        elsif(/ class /)
1023        {
1024            if(/extends ([^\s{]+)/)
1025            {
1026                foreach my $Class (split(/\s*,\s*/, $1)) {
1027                    $In::Opt{"UsedClasses_Client"}{$Class} = 1;
1028                }
1029            }
1030           
1031            if(/implements ([^\s{]+)/)
1032            {
1033                foreach my $Interface (split(/\s*,\s*/, $1)) {
1034                    $In::Opt{"UsedClasses_Client"}{$Interface} = 1;
1035                }
1036            }
1037        }
1038    }
1039    close(CONTENT);
1040    chdir($In::Opt{"OrigDir"});
1041}
1042
1043return 1;
Note: See TracBrowser for help on using the repository browser.