| #************************************************************** |
| # |
| # Licensed to the Apache Software Foundation (ASF) under one |
| # or more contributor license agreements. See the NOTICE file |
| # distributed with this work for additional information |
| # regarding copyright ownership. The ASF licenses this file |
| # to you under the Apache License, Version 2.0 (the |
| # "License"); you may not use this file except in compliance |
| # with the License. You may obtain a copy of the License at |
| # |
| # http://www.apache.org/licenses/LICENSE-2.0 |
| # |
| # Unless required by applicable law or agreed to in writing, |
| # software distributed under the License is distributed on an |
| # "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY |
| # KIND, either express or implied. See the License for the |
| # specific language governing permissions and limitations |
| # under the License. |
| # |
| #************************************************************** |
| |
| |
| |
| |
| package pre2par::work; |
| |
| use pre2par::exiter; |
| use pre2par::remover; |
| use pre2par::pathanalyzer; |
| |
| ############################################ |
| # pre2par working module |
| ############################################ |
| |
| ############################################ |
| # procedure to split a line, that contains |
| # more than one par file lines |
| ############################################ |
| |
| sub split_line |
| { |
| my ($line, $parfile) = @_; |
| |
| while ( $line =~ /^((?:[^"]|\"(?:[^"\\]|\\.)*\")*?\;\s+)\s*(.*)$/ ) |
| { |
| my $oneline = $1; |
| $line = $2; |
| pre2par::remover::remove_leading_and_ending_whitespaces(\$oneline); |
| $oneline = $oneline . "\n"; |
| push(@{$parfile}, $oneline); |
| |
| if ( $line =~ /^\s*End\s+(\w+.*$)/i ) |
| { |
| $line = $1; |
| push(@{$parfile}, "End\n\n"); |
| } |
| } |
| |
| # the last line |
| |
| pre2par::remover::remove_leading_and_ending_whitespaces(\$line); |
| $line = $line . "\n"; |
| push(@{$parfile}, $line); |
| |
| if ( $line =~ /^\s*End\s*$/i ) { push(@{$parfile}, "\n"); } |
| } |
| |
| ################################################################### |
| # Preprocessing the pre file to split all lines with semicolon |
| ################################################################### |
| |
| sub preprocess_macros |
| { |
| my ($prefile) = @_; |
| |
| my @newprefile = (); |
| |
| for ( my $i = 0; $i <= $#{$prefile}; $i++ ) |
| { |
| my $oneline = ${$prefile}[$i]; |
| if ( $oneline =~ /\;\s*\w+/ ) |
| { |
| split_line($oneline, \@newprefile); |
| } |
| else |
| { |
| push(@newprefile, $oneline); |
| } |
| } |
| |
| return \@newprefile; |
| } |
| |
| ############################################ |
| # main working procedure |
| ############################################ |
| |
| sub convert |
| { |
| my ($prefile) = @_; |
| |
| my @parfile = (); |
| |
| my $iscodesection = 0; |
| my $ismultiliner = 0; |
| my $globalline = ""; |
| |
| # Preprocessing the pre file to split all lines with semicolon |
| $prefile = preprocess_macros($prefile); |
| |
| for ( my $i = 0; $i <= $#{$prefile}; $i++ ) |
| { |
| my $oneline = ${$prefile}[$i]; |
| |
| if ($iscodesection) |
| { |
| if ( $oneline =~ /^\s*\}\;\s*$/ ) |
| { |
| $iscodesection = 0; |
| } |
| else # nothing to do for code inside a code section |
| { |
| push(@parfile, $oneline); |
| next; |
| } |
| } |
| |
| if ( $oneline =~ /^\s*$/ ) { next; } |
| |
| if ( $oneline =~ /^\s*Code\s+\=\s+\{/ ) |
| { |
| $iscodesection = 1; |
| } |
| |
| pre2par::remover::remove_leading_and_ending_whitespaces(\$oneline); |
| |
| my $insertemptyline = 0; |
| |
| if ( $oneline =~ /^\s*End\s*$/i ) { $insertemptyline = 1; } |
| |
| # Sometimes the complete file is in one line, then the gid line has to be separated |
| |
| if ( $oneline =~ /^\s*(\w+\s+\w+)\s+(\w+\s+\=.*$)/ ) # three words before the equal sign |
| { |
| my $gidline = $1; |
| $oneline = $2; |
| $gidline = $gidline . "\n"; |
| |
| push(@parfile, $gidline); |
| } |
| |
| if ( $oneline =~ /\;\s*\w+/ ) |
| { |
| split_line($oneline, \@parfile); |
| next; |
| } |
| |
| # searching for lines with brackets, like Customs = { ..., which can be parted above several lines |
| |
| if ( $oneline =~ /^\s*\w+\s+\=\s*\(.*\)\s*\;\s*$/ ) # only one line |
| { |
| if (( ! ( $oneline =~ /^\s*Assignment\d+\s*\=/ )) && ( ! ( $oneline =~ /^\s*PatchAssignment\d+\s*\=/ ))) |
| { |
| $oneline =~ s/\s//g; # removing whitespaces in lists |
| $oneline =~ s/\=/\ \=\ /; # adding whitespace around equals sign |
| } |
| } |
| |
| if ( $oneline =~ /^\s*\w+\s+\=\s*$/ ) |
| { |
| $oneline =~ s/\s*$//; |
| pre2par::exiter::exit_program("Error: Illegal syntax, no line break after eqals sign allowed. Line: \"$oneline\"", "convert"); |
| } |
| |
| if (( $oneline =~ /^\s*\w+\s+\=\s*\(/ ) && (!( $oneline =~ /\)\s*\;\s*$/ ))) # several lines |
| { |
| $ismultiliner = 1; |
| $oneline =~ s/\s//g; |
| $globalline .= $oneline; |
| next; # not including yet |
| } |
| |
| if ( $ismultiliner ) |
| { |
| $oneline =~ s/\s//g; |
| $globalline .= $oneline; |
| |
| if ( $oneline =~ /\)\s*\;\s*$/ ) { $ismultiliner = 0; } |
| |
| if (! ( $ismultiliner )) |
| { |
| $globalline =~ s/\=/\ \=\ /; # adding whitespace around equals sign |
| $globalline .= "\n"; |
| push(@parfile, $globalline); |
| $globalline = ""; |
| } |
| |
| next; |
| } |
| |
| $oneline = $oneline . "\n"; |
| |
| $oneline =~ s/\s*\=\s*/ \= /; # nice, to have only one whitespace around equal signs |
| |
| # Concatenate adjacent string literals: |
| while ($oneline =~ |
| s/^((?:[^"]* |
| \"(?:[^\\"]|\\.)*\" |
| (?:[^"]*[^[:blank:]"][^"]*\"(?:[^\\"]|\\.)*\")*)* |
| [^"]* |
| \"(?:[^\\"]|\\.)*) |
| \"[[:blank:]]*\" |
| ((?:[^\\"]|\\.)*\") |
| /\1\2/x) |
| {} |
| |
| push(@parfile, $oneline); |
| |
| if ($insertemptyline) { push(@parfile, "\n"); } |
| |
| } |
| |
| return \@parfile; |
| } |
| |
| ############################################ |
| # formatting the par file |
| ############################################ |
| |
| sub formatter |
| { |
| my ($parfile) = @_; |
| |
| my $iscodesection = 0; |
| |
| my $tabcounter = 0; |
| my $isinsideitem = 0; |
| my $currentitem; |
| |
| for ( my $i = 0; $i <= $#{$parfile}; $i++ ) |
| { |
| my $oneline = ${$parfile}[$i]; |
| my $isitemline = 0; |
| |
| if (! $isinsideitem ) |
| { |
| for ( my $j = 0; $j <= $#pre2par::globals::allitems; $j++ ) |
| { |
| if ( $oneline =~ /^\s*$pre2par::globals::allitems[$j]\s+\w+\s*$/ ) |
| { |
| $currentitem = $pre2par::globals::allitems[$j]; |
| $isitemline = 1; |
| $isinsideitem = 1; |
| $tabcounter = 0; |
| last; |
| } |
| } |
| } |
| |
| if ( $isitemline ) |
| { |
| next; # nothing to do |
| } |
| |
| if ( $oneline =~ /^\s*end\s*$/i ) |
| { |
| $isinsideitem = 0; |
| $tabcounter--; |
| } |
| |
| if ( $isinsideitem ) |
| { |
| $oneline = "\t" . $oneline; |
| ${$parfile}[$i] = $oneline; |
| } |
| } |
| } |
| |
| ################################################### |
| # Returning the language file name |
| ################################################### |
| |
| sub getlangfilename |
| { |
| return $pre2par::globals::langfilename; |
| } |
| |
| ################################################### |
| # Creating the ulf file name from the |
| # corresponding pre file name |
| ################################################### |
| |
| sub getulffilename |
| { |
| my ($prefilename) = @_; |
| |
| my $ulffilename = $prefilename; |
| $ulffilename =~ s/\.pre\s*$/\.ulf/; |
| pre2par::pathanalyzer::make_absolute_filename_to_relative_filename(\$ulffilename); |
| |
| return $ulffilename; |
| } |
| |
| ############################################ |
| # Checking if a file exists |
| ############################################ |
| |
| sub fileexists |
| { |
| my ($langfilename) = @_; |
| |
| my $fileexists = 0; |
| |
| if( -f $langfilename ) { $fileexists = 1; } |
| |
| return $fileexists; |
| } |
| |
| ############################################ |
| # Checking the existence of ulf and |
| # jlf/mlf files |
| ############################################ |
| |
| sub check_existence_of_langfiles |
| { |
| my ($langfilename, $ulffilename) = @_; |
| |
| my $do_localize = 0; |
| |
| if (( fileexists($ulffilename) ) && ( ! fileexists($langfilename) )) { pre2par::exiter::exit_program("Error: Did not find language file $langfilename", "check_existence_of_langfiles"); } |
| if (( fileexists($ulffilename) ) && ( fileexists($langfilename) )) { $do_localize = 1; } |
| |
| return $do_localize; |
| } |
| |
| ############################################ |
| # Checking that the pre file has content |
| ############################################ |
| |
| sub check_content |
| { |
| my ($filecontent, $filename) = @_; |
| |
| if ( $#{$filecontent} < 0 ) { pre2par::exiter::exit_program("Error: $filename has no content!", "check_content"); } |
| } |
| |
| ############################################ |
| # Checking content of par files. |
| # Currently only size. |
| ############################################ |
| |
| sub diff_content |
| { |
| my ($content1, $content2, $filename) = @_; |
| |
| if ( $#{$content1} != $#{$content2} ) { pre2par::exiter::exit_program("Error: $filename was not saved correctly!", "diff_content"); } |
| } |
| |
| 1; |