source: josm/trunk/tools/japicc/modules/Internals/Utils.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: 5.7 KB
Line 
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###########################################################################
23use strict;
24use POSIX;
25
26sub 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
37sub 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
52sub getMaxLen()
53{
54 if($In::Opt{"OS"} eq "windows") {
55 return 8191;
56 }
57
58 return undef;
59}
60
61sub 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
73sub 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
129sub 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
237sub 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
245return 1;
Note: See TracBrowser for help on using the repository browser.