xref: /AOO41X/main/solenv/bin/modules/pre2par/work.pm (revision 9780544fa6b4c85f7d9b48452f58c7da854fc9a5) 
1#**************************************************************
2#
3#  Licensed to the Apache Software Foundation (ASF) under one
4#  or more contributor license agreements.  See the NOTICE file
5#  distributed with this work for additional information
6#  regarding copyright ownership.  The ASF licenses this file
7#  to you under the Apache License, Version 2.0 (the
8#  "License"); you may not use this file except in compliance
9#  with the License.  You may obtain a copy of the License at
10#
11#    http://www.apache.org/licenses/LICENSE-2.0
12#
13#  Unless required by applicable law or agreed to in writing,
14#  software distributed under the License is distributed on an
15#  "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
16#  KIND, either express or implied.  See the License for the
17#  specific language governing permissions and limitations
18#  under the License.
19#
20#**************************************************************
21
22
23
24
25package pre2par::work;
26
27use pre2par::exiter;
28use pre2par::remover;
29use pre2par::pathanalyzer;
30
31############################################
32# pre2par working module
33############################################
34
35############################################
36# procedure to split a line, that contains
37# more than one par file lines
38############################################
39
40sub split_line
41{
42    my ($line, $parfile) = @_;
43
44    while ( $line =~ /^((?:[^"]|\"(?:[^"\\]|\\.)*\")*?\;\s+)\s*(.*)$/ )
45    {
46        my $oneline = $1;
47        $line = $2;
48        pre2par::remover::remove_leading_and_ending_whitespaces(\$oneline);
49        $oneline = $oneline . "\n";
50        push(@{$parfile}, $oneline);
51
52        if ( $line =~ /^\s*End\s+(\w+.*$)/i )
53        {
54            $line = $1;
55            push(@{$parfile}, "End\n\n");
56        }
57    }
58
59    # the last line
60
61    pre2par::remover::remove_leading_and_ending_whitespaces(\$line);
62    $line = $line . "\n";
63    push(@{$parfile}, $line);
64
65    if ( $line =~ /^\s*End\s*$/i ) { push(@{$parfile}, "\n"); }
66}
67
68###################################################################
69# Preprocessing the pre file to split all lines with semicolon
70###################################################################
71
72sub preprocess_macros
73{
74    my ($prefile) = @_;
75
76    my @newprefile = ();
77
78    for ( my $i = 0; $i <= $#{$prefile}; $i++ )
79    {
80        my $oneline = ${$prefile}[$i];
81        if ( $oneline =~ /\;\s*\w+/ )
82        {
83            split_line($oneline, \@newprefile);
84        }
85        else
86        {
87            push(@newprefile, $oneline);
88        }
89    }
90
91    return \@newprefile;
92}
93
94############################################
95# main working procedure
96############################################
97
98sub convert
99{
100    my ($prefile) = @_;
101
102    my @parfile = ();
103
104    my $iscodesection = 0;
105    my $ismultiliner = 0;
106    my $globalline = "";
107
108    # Preprocessing the pre file to split all lines with semicolon
109    $prefile = preprocess_macros($prefile);
110
111    for ( my $i = 0; $i <= $#{$prefile}; $i++ )
112    {
113        my $oneline = ${$prefile}[$i];
114
115        if ($iscodesection)
116        {
117            if ( $oneline =~ /^\s*\}\;\s*$/ )
118            {
119                $iscodesection = 0;
120            }
121            else    # nothing to do for code inside a code section
122            {
123                push(@parfile, $oneline);
124                next;
125             }
126        }
127
128        if ( $oneline =~ /^\s*$/ ) { next; }
129
130        if ( $oneline =~ /^\s*Code\s+\=\s+\{/ )
131        {
132            $iscodesection = 1;
133        }
134
135        pre2par::remover::remove_leading_and_ending_whitespaces(\$oneline);
136
137        my $insertemptyline = 0;
138
139        if ( $oneline =~ /^\s*End\s*$/i ) { $insertemptyline = 1; }
140
141        # Sometimes the complete file is in one line, then the gid line has to be separated
142
143        if ( $oneline =~ /^\s*(\w+\s+\w+)\s+(\w+\s+\=.*$)/ )    # three words before the equal sign
144        {
145            my $gidline = $1;
146            $oneline = $2;
147            $gidline = $gidline . "\n";
148
149            push(@parfile, $gidline);
150        }
151
152        if ( $oneline =~ /\;\s*\w+/ )
153        {
154            split_line($oneline, \@parfile);
155            next;
156        }
157
158        # searching for lines with brackets, like Customs = { ..., which can be parted above several lines
159
160        if ( $oneline =~ /^\s*\w+\s+\=\s*\(.*\)\s*\;\s*$/ )     # only one line
161        {
162            if (( ! ( $oneline =~ /^\s*Assignment\d+\s*\=/ )) && ( ! ( $oneline =~ /^\s*PatchAssignment\d+\s*\=/ )))
163            {
164                $oneline =~ s/\s//g;        # removing whitespaces in lists
165                $oneline =~ s/\=/\ \=\ /;   # adding whitespace around equals sign
166            }
167        }
168
169        if ( $oneline =~ /^\s*\w+\s+\=\s*$/ )
170        {
171            $oneline =~ s/\s*$//;
172            pre2par::exiter::exit_program("Error: Illegal syntax, no line break after eqals sign allowed. Line: \"$oneline\"", "convert");
173        }
174
175        if (( $oneline =~ /^\s*\w+\s+\=\s*\(/ ) && (!( $oneline =~ /\)\s*\;\s*$/ )))     # several lines
176        {
177            $ismultiliner = 1;
178            $oneline =~ s/\s//g;
179            $globalline .= $oneline;
180            next;                       # not including yet
181        }
182
183        if ( $ismultiliner )
184        {
185            $oneline =~ s/\s//g;
186            $globalline .= $oneline;
187
188            if ( $oneline =~ /\)\s*\;\s*$/ ) {  $ismultiliner = 0; }
189
190            if (! ( $ismultiliner ))
191            {
192                $globalline =~ s/\=/\ \=\ /;    # adding whitespace around equals sign
193                $globalline .= "\n";
194                push(@parfile, $globalline);
195                $globalline = "";
196            }
197
198            next;
199        }
200
201        $oneline = $oneline . "\n";
202
203        $oneline =~ s/\s*\=\s*/ \= /;   # nice, to have only one whitespace around equal signs
204
205        # Concatenate adjacent string literals:
206        while ($oneline =~
207               s/^((?:[^"]*
208                      \"(?:[^\\"]|\\.)*\"
209                      (?:[^"]*[^[:blank:]"][^"]*\"(?:[^\\"]|\\.)*\")*)*
210                   [^"]*
211                   \"(?:[^\\"]|\\.)*)
212                 \"[[:blank:]]*\"
213                 ((?:[^\\"]|\\.)*\")
214                /\1\2/x)
215        {}
216
217        push(@parfile, $oneline);
218
219        if ($insertemptyline) { push(@parfile, "\n"); }
220
221    }
222
223    return \@parfile;
224}
225
226############################################
227# formatting the par file
228############################################
229
230sub formatter
231{
232    my ($parfile) = @_;
233
234    my $iscodesection = 0;
235
236    my $tabcounter = 0;
237    my $isinsideitem = 0;
238    my $currentitem;
239
240    for ( my $i = 0; $i <= $#{$parfile}; $i++ )
241    {
242        my $oneline = ${$parfile}[$i];
243        my $isitemline = 0;
244
245        if (! $isinsideitem )
246        {
247            for ( my $j = 0; $j <= $#pre2par::globals::allitems; $j++ )
248            {
249                if ( $oneline =~ /^\s*$pre2par::globals::allitems[$j]\s+\w+\s*$/ )
250                {
251                    $currentitem = $pre2par::globals::allitems[$j];
252                    $isitemline = 1;
253                    $isinsideitem = 1;
254                    $tabcounter = 0;
255                    last;
256                }
257            }
258        }
259
260        if ( $isitemline )
261        {
262            next;   # nothing to do
263        }
264
265        if ( $oneline =~ /^\s*end\s*$/i )
266        {
267            $isinsideitem = 0;
268            $tabcounter--;
269        }
270
271        if ( $isinsideitem )
272        {
273            $oneline = "\t" . $oneline;
274            ${$parfile}[$i] = $oneline;
275        }
276    }
277}
278
279###################################################
280# Returning the language file name
281###################################################
282
283sub getlangfilename
284{
285    return $pre2par::globals::langfilename;
286}
287
288###################################################
289# Creating the ulf file name from the
290# corresponding pre file name
291###################################################
292
293sub getulffilename
294{
295    my ($prefilename) = @_;
296
297    my $ulffilename = $prefilename;
298    $ulffilename =~ s/\.pre\s*$/\.ulf/;
299    pre2par::pathanalyzer::make_absolute_filename_to_relative_filename(\$ulffilename);
300
301    return $ulffilename;
302}
303
304############################################
305# Checking if a file exists
306############################################
307
308sub fileexists
309{
310    my ($langfilename) = @_;
311
312    my $fileexists = 0;
313
314    if( -f $langfilename ) { $fileexists = 1; }
315
316    return $fileexists;
317}
318
319############################################
320# Checking the existence of ulf and
321# jlf/mlf files
322############################################
323
324sub check_existence_of_langfiles
325{
326    my ($langfilename, $ulffilename) = @_;
327
328    my $do_localize = 0;
329
330    if (( fileexists($ulffilename) ) && ( ! fileexists($langfilename) )) { pre2par::exiter::exit_program("Error: Did not find language file $langfilename", "check_existence_of_langfiles"); }
331    if (( fileexists($ulffilename) ) && ( fileexists($langfilename) )) { $do_localize = 1; }
332
333    return $do_localize;
334}
335
336############################################
337# Checking that the pre file has content
338############################################
339
340sub check_content
341{
342    my ($filecontent, $filename) = @_;
343
344    if ( $#{$filecontent} < 0 ) { pre2par::exiter::exit_program("Error: $filename has no content!", "check_content"); }
345}
346
347############################################
348# Checking content of par files.
349# Currently only size.
350############################################
351
352sub diff_content
353{
354    my ($content1, $content2, $filename) = @_;
355
356    if ( $#{$content1} != $#{$content2} ) { pre2par::exiter::exit_program("Error: $filename was not saved correctly!", "diff_content"); }
357}
358
3591;
360