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

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

update to JAPICC 2.3

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