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