1 | ###########################################################################
|
---|
2 | # A module with basic functions
|
---|
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 | ###########################################################################
|
---|
23 | use strict;
|
---|
24 | use POSIX;
|
---|
25 |
|
---|
26 | sub initAPI($)
|
---|
27 | {
|
---|
28 | my $V = $_[0];
|
---|
29 | foreach my $K ("MethodInfo", "TypeInfo", "TName_Tid")
|
---|
30 | {
|
---|
31 | if(not defined $In::API{$V}{$K}) {
|
---|
32 | $In::API{$V}{$K} = {};
|
---|
33 | }
|
---|
34 | }
|
---|
35 | }
|
---|
36 |
|
---|
37 | sub setTarget($)
|
---|
38 | {
|
---|
39 | my $Target = $_[0];
|
---|
40 |
|
---|
41 | if($Target eq "default")
|
---|
42 | {
|
---|
43 | $Target = getOSgroup();
|
---|
44 |
|
---|
45 | $In::Opt{"OS"} = $Target;
|
---|
46 | $In::Opt{"Ar"} = getArExt($Target);
|
---|
47 | }
|
---|
48 |
|
---|
49 | $In::Opt{"Target"} = $Target;
|
---|
50 | }
|
---|
51 |
|
---|
52 | sub getMaxLen()
|
---|
53 | {
|
---|
54 | if($In::Opt{"OS"} eq "windows") {
|
---|
55 | return 8191;
|
---|
56 | }
|
---|
57 |
|
---|
58 | return undef;
|
---|
59 | }
|
---|
60 |
|
---|
61 | sub getMaxArg()
|
---|
62 | {
|
---|
63 | if($In::Opt{"OS"} eq "windows") {
|
---|
64 | return undef;
|
---|
65 | }
|
---|
66 |
|
---|
67 | # Linux
|
---|
68 | # return POSIX::sysconf(POSIX::_SC_ARG_MAX);
|
---|
69 | # javap failed on rt.jar (GC triggered before VM initialization completed)
|
---|
70 | return 10000;
|
---|
71 | }
|
---|
72 |
|
---|
73 | sub divideArray($)
|
---|
74 | {
|
---|
75 | my $ArrRef = $_[0];
|
---|
76 |
|
---|
77 | return () if($#{$ArrRef}==-1);
|
---|
78 |
|
---|
79 | my $LEN_MAX = getMaxLen();
|
---|
80 | my $ARG_MAX = getMaxArg();
|
---|
81 |
|
---|
82 | if(defined $ARG_MAX)
|
---|
83 | { # Linux
|
---|
84 | if($#{$ArrRef} < $ARG_MAX - 500) {
|
---|
85 | return $ArrRef;
|
---|
86 | }
|
---|
87 | }
|
---|
88 |
|
---|
89 | my @Res = ();
|
---|
90 | my $Sub = [];
|
---|
91 | my $Len = 0;
|
---|
92 |
|
---|
93 | foreach my $Pos (0 .. $#{$ArrRef})
|
---|
94 | {
|
---|
95 | my $Arg = $ArrRef->[$Pos];
|
---|
96 | my $Arg_L = length($Arg) + 1; # space
|
---|
97 |
|
---|
98 | my ($LenLimit, $ArgLimit) = (1, 1);
|
---|
99 |
|
---|
100 | if(defined $LEN_MAX) {
|
---|
101 | $LenLimit = ($Len < $LEN_MAX - 500);
|
---|
102 | }
|
---|
103 |
|
---|
104 | if(defined $ARG_MAX) {
|
---|
105 | $ArgLimit = ($#{$Sub} < $ARG_MAX - 500);
|
---|
106 | }
|
---|
107 |
|
---|
108 | if($LenLimit and $ArgLimit)
|
---|
109 | {
|
---|
110 | push(@{$Sub}, $Arg);
|
---|
111 | $Len += $Arg_L;
|
---|
112 | }
|
---|
113 | else
|
---|
114 | {
|
---|
115 | push(@Res, $Sub);
|
---|
116 |
|
---|
117 | $Sub = [$Arg];
|
---|
118 | $Len = $Arg_L;
|
---|
119 | }
|
---|
120 | }
|
---|
121 |
|
---|
122 | if($#{$Sub}!=-1) {
|
---|
123 | push(@Res, $Sub);
|
---|
124 | }
|
---|
125 |
|
---|
126 | return @Res;
|
---|
127 | }
|
---|
128 |
|
---|
129 | sub cmdFind(@)
|
---|
130 | { # native "find" is much faster than File::Find (~6x)
|
---|
131 | # also the File::Find doesn't support --maxdepth N option
|
---|
132 | # so using the cross-platform wrapper for the native one
|
---|
133 | my ($Path, $Type, $Name, $MaxDepth, $UseRegex) = ();
|
---|
134 |
|
---|
135 | $Path = shift(@_);
|
---|
136 | if(@_) {
|
---|
137 | $Type = shift(@_);
|
---|
138 | }
|
---|
139 | if(@_) {
|
---|
140 | $Name = shift(@_);
|
---|
141 | }
|
---|
142 | if(@_) {
|
---|
143 | $MaxDepth = shift(@_);
|
---|
144 | }
|
---|
145 | if(@_) {
|
---|
146 | $UseRegex = shift(@_);
|
---|
147 | }
|
---|
148 |
|
---|
149 | my $TmpDir = $In::Opt{"Tmp"};
|
---|
150 | my $TmpFile = $TmpDir."/null";
|
---|
151 |
|
---|
152 | if($In::Opt{"OS"} eq "windows")
|
---|
153 | {
|
---|
154 | $Path = getAbsPath($Path);
|
---|
155 | my $Cmd = "cmd /C dir \"$Path\" /B /O";
|
---|
156 | if($MaxDepth!=1) {
|
---|
157 | $Cmd .= " /S";
|
---|
158 | }
|
---|
159 | if($Type eq "d") {
|
---|
160 | $Cmd .= " /AD";
|
---|
161 | }
|
---|
162 | elsif($Type eq "f") {
|
---|
163 | $Cmd .= " /A-D";
|
---|
164 | }
|
---|
165 |
|
---|
166 | my @Files = split(/\n/, qx/$Cmd/);
|
---|
167 |
|
---|
168 | if($Name)
|
---|
169 | {
|
---|
170 | if(not $UseRegex)
|
---|
171 | { # FIXME: how to search file names in MS shell?
|
---|
172 | # wildcard to regexp
|
---|
173 | $Name=~s/\*/.*/g;
|
---|
174 | $Name='\A'.$Name.'\Z';
|
---|
175 | }
|
---|
176 | @Files = grep { /$Name/i } @Files;
|
---|
177 | }
|
---|
178 | my @AbsPaths = ();
|
---|
179 | foreach my $File (@Files)
|
---|
180 | {
|
---|
181 | if(not isAbsPath($File)) {
|
---|
182 | $File = join_P($Path, $File);
|
---|
183 | }
|
---|
184 | if($Type eq "f" and not -f $File)
|
---|
185 | { # skip dirs
|
---|
186 | next;
|
---|
187 | }
|
---|
188 | push(@AbsPaths, $File);
|
---|
189 | }
|
---|
190 | if($Type eq "d") {
|
---|
191 | push(@AbsPaths, $Path);
|
---|
192 | }
|
---|
193 |
|
---|
194 | @AbsPaths = sort(@AbsPaths);
|
---|
195 |
|
---|
196 | return @AbsPaths;
|
---|
197 | }
|
---|
198 | else
|
---|
199 | {
|
---|
200 | my $FindCmd = "find";
|
---|
201 | if(not checkCmd($FindCmd)) {
|
---|
202 | exitStatus("Not_Found", "can't find a \"find\" command");
|
---|
203 | }
|
---|
204 | $Path = getAbsPath($Path);
|
---|
205 | if(-d $Path and -l $Path
|
---|
206 | and $Path!~/\/\Z/)
|
---|
207 | { # for directories that are symlinks
|
---|
208 | $Path.="/";
|
---|
209 | }
|
---|
210 | my $Cmd = $FindCmd." \"$Path\"";
|
---|
211 | if($MaxDepth) {
|
---|
212 | $Cmd .= " -maxdepth $MaxDepth";
|
---|
213 | }
|
---|
214 | if($Type) {
|
---|
215 | $Cmd .= " -type $Type";
|
---|
216 | }
|
---|
217 | if($Name and not $UseRegex)
|
---|
218 | { # wildcards
|
---|
219 | $Cmd .= " -name \"$Name\"";
|
---|
220 | }
|
---|
221 | my $Res = qx/$Cmd 2>"$TmpFile"/;
|
---|
222 | if($? and $!) {
|
---|
223 | printMsg("ERROR", "problem with \'find\' utility ($?): $!");
|
---|
224 | }
|
---|
225 | my @Files = split(/\n/, $Res);
|
---|
226 | if($Name and $UseRegex)
|
---|
227 | { # regex
|
---|
228 | @Files = grep { /$Name/ } @Files;
|
---|
229 | }
|
---|
230 |
|
---|
231 | @Files = sort(@Files);
|
---|
232 |
|
---|
233 | return @Files;
|
---|
234 | }
|
---|
235 | }
|
---|
236 |
|
---|
237 | sub getVersion($)
|
---|
238 | {
|
---|
239 | my $Cmd = $_[0];
|
---|
240 | my $TmpDir = $In::Opt{"Tmp"};
|
---|
241 | my $Ver = `$Cmd --version 2>\"$TmpDir/null\"`;
|
---|
242 | return $Ver;
|
---|
243 | }
|
---|
244 |
|
---|
245 | return 1;
|
---|