xref: /AOO41X/main/solenv/bin/modules/pre2par/work.pm (revision 9780544fa6b4c85f7d9b48452f58c7da854fc9a5)

#**************************************************************
#
#  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;