xref: /aoo4110/main/solenv/bin/modules/pre2par/work.pm (revision b1cdbd2c) 
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