source: josm/trunk/tools/japicc/modules/Internals/APIDump.pm @ 12872

Last change on this file since 12872 was 12872, checked in by Don-vip, 6 years ago

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