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