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

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

tools update: Groovy 2.4.15, PMD 6.2.0, JAPICC 2.4

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