# Parser.pm
#
# Parse *.efg Files and generate *.efg.pl
#
# Ralf Peine, 2004-05-26 Tue

use strict 'vars';

package Efg::Parser;

use Log;

use CFG;

use Efg::Generator;

use vars qw (%ConfigKeyNames @ISA);

@ISA = qw(Efg::Base);

$ConfigKeyNames{OUTPUT_DIR} = '_output_dir';

sub fixText {}      # store fixtext

sub getConfigKeyNamesRef {
    return \%ConfigKeyNames;
}

sub init {
    my $self = shift;

    $self->{_commentChar} = '#';   # Comment Char
    $self->{_genList}     = ();    # Generator Names
    my $inpDir = $CFG{"INPUT_DIR"};
    my $outDir = $CFG{"OUTPUT_DIR"};
    $inpDir =~ s/\\/\//gio;
    $outDir =~ s/\\/\//gio;

    $self->{_input_dir} = $inpDir;
    $self->{_output_dir} = $outDir;
    $self->setVarsFromConfig();
    $self->{_fixStrArr} = ();
    $self->{_fixStrIdx} = -1;

    $self->{_noBreak} = 'true';    # no exit for errors
}

sub setVarsFromConfig {
    my $self = shift;

    foreach my $key (keys (%CFG)) {
	$self->setVar($key, $CFG{$key});
    }
}

sub setVar {
    # my $self    = shift;
    # my $varName = shift;
    # my $val     = shift;
    $_[0]->{"_var_$_[1]"} = $_[2];
    # print "setvar ".$_[0]->{"_var_$_[1]"}."\n";
}

sub getVar {
    # my $self    = shift;
    # my $varName = shift;
    my $var = $_[0]->{"_var_$_[1]"};
    return $var if ($var);
    # later search in CFG, _O_PKT_RP Sun Nov 23 12:43:06 2003
    return undef;
}

sub addGenerator { # Name
    my $self = shift;
    my $gen = shift;

    push (@{$self->{_genList}}, $gen);
}

sub parseFile {
    my $self = shift;
    my $file = shift; # Filename

    my $inpDir = $self->{_input_dir};
    my $outDir = $self->{_output_dir}; 

    LOG ("==================== $inpDir -> $outDir read and parse $file ... \n");

    my $fhInp = new FileHandle ("$inpDir/$file");

    unless (defined $fhInp) {
	$self->errorMsg(0001, "$file", "Can't open file $file for reading: $!\n");
	exit 1;
    }

    my $efg2pl = "$outDir/$file.pl";  # Perl file generated from imake file
    my $fhOutp = new FileHandle (">$efg2pl");
    unless (defined $fhOutp) {
	$self->errorMsg(0002, "$efg2pl", "Can't open file $efg2pl for writing: $!\n");
	exit 1;
    }

    my $pval;		# parameter value
    my $l;		# help variable for $_
    my $rule;           # name of the started rule
    my $argstr;         # all arguments of the rule
    my $cmd;            # Rule start with perl
    my $preCmd;         # Perl cmd before starting rule
    my $cmd_end;        # Rule end with perl
    my $commentChar = $self->{_commentChar} = '#';    # char starting a comment

    my @generatorNames;
    my $callGenerators;
    my $myFixtext = "my ";
 
    $fhOutp->write("# generated by $0 (version $Efg::version) at ".localtime()."\n");
    $fhOutp->write("package GEN;\n\n");
   
    while (<$fhInp>) {
	$l = $_;
	@generatorNames = @{$self->{_genList}};
	$callGenerators = '';
	$preCmd         = '';
	if ($l =~ /^\s*\/\//o) {
	    # --- delete // comment ---
	} elsif ($l =~ /\s*^(\#)/o) {
	    # --- write # comment ---
	    $l           = $'; #' # for emacs
	    $commentChar = "#";
	    chomp $l;
	    $fhOutp->write($commentChar. $l. "\n");

	    # write comment to output file with commentchar of file:
	    foreach my $genName (@generatorNames) {
		$fhOutp->write("\$$genName->writeComment(\"$l\\n\");\n");
	    }
	} elsif ($l =~ /^\s*&(\w+)\s+(.*)/) {
	    # &rule_call 1 2 3 4
	    $rule   = $1;
	    $argstr = "$2\n";
	    
	    if ($argstr =~ /^\(/io) {
		# &rule_call (1, 2, 3, 4);
		# --- rule startet with "(", print line unchanged ---
		$fhOutp->write($l);
		next;
	    }

	    $cmd_end = ");";
	    $cmd = "$rule (  ";

	    # --- special rules ---
	    if (lc($rule) eq "include") {
		# --- switch include to require ---
		$cmd_end = ";";
		$cmd = "require ";
		$argstr =~ s/\s+//gio;
		$argstr =~ s/\\/\//gio;
		($argstr) = $self->parseForAndInsertVariables($argstr);
		if ($self->{_error}) {
		    $self->errorMsg(1000, "$file:$.", "Syntax error at include: ".$self->{_error});
		    exit 1 unless $self->{_noBreak};
		} else {
		    $self->parseFile($argstr);
		    $argstr = "$outDir/$argstr.pl";
		}
		$fhOutp->write("require '$argstr';\n");
		next;
	    } elsif (lc($rule) eq "fix_text") {
		# --- scan for fixtext ---
		if ($argstr =~ /^\s*(.*)\s*<<\s+(.*)/) {
		    $argstr           = $1; # this is the list of used genrators
		    my $endcode       = $2; # this character code (pattern) ends the fix_text
		    my $fixString     = ""; # this is the fix string to remember
		    my $start_line    = $.; # in this line started the command fix_text
		    my $endcode_found = ""; # Endpattern found or not
		    $endcode =~ s/\s+$//io;
		    $cmd = 'write (';
		    # --- get all fix_text until end pattern is reached -----------
		    while (<$fhInp>) {
			$l = $_;
			chop $l;
			if ($l =~ /^$endcode\s*$/) {
			    # --- end pattern is reached ---
			    $preCmd  = "$myFixtext\$fix_text = <<$endcode\n$fixString$endcode\n;\n";
			    $cmd    .= '$fix_text';
			    $endcode_found = "true";
			    $myFixtext = '';
			    last;
			}
			$fixString .= "$l\n";
		    }
		    if (!$endcode_found) {
			# --- end pattern not found -----
			$self->errorMsg(1001, $file, "Syntax error in :\n".
					"Endcode '$endcode' for fix_text not found from line $start_line\n");
			exit 1 unless $self->{_noBreak};
			next;
		    }
		} else {
		    # --- wrong call of fix_text ---
		    $self->errorMsg(1002, "$file:$.", "Syntax error using fix_text: $_\n".
		    "     usage: &fix_text << EnDe\n");
		    exit 1 unless $self->{_noBreak};

		}
		$callGenerators = 'true';
	    } else {
		# no special rule
		$callGenerators = 'true';
	    }
	    
	    # --- translate rule call to perl syntax: ---
	    # --- &rule_call('arg1', "arg2", ...)     --- 

	    # --- Scan args of rule ---
	    my @argVec = $self->scanArgs($argstr);
	    @generatorNames = $self->getGeneratorsFromArgs(\@argVec);

	    $argstr = join (', ', @argVec);
	    $cmd .= $argstr;
	    $cmd =~ s/\$\(/\\\$\(/og;
	    $cmd .= $cmd_end;
	    if ($callGenerators) {
		$fhOutp->write("$preCmd\n") if ($preCmd ne '');
		foreach my $genName (@generatorNames) {
		    $fhOutp->write("\$$genName->$cmd\n");
		}
	    } else {
		$fhOutp->write("$cmd\n");
	    }
	} else {
	    # --- other perl statement in line ---
	    $fhOutp->write("$l");
	}
    }
    $fhOutp->write("1;\n");
    close $fhOutp;
    close $fhInp;

    return $efg2pl;
}

sub scanArgs {
    my $self   = shift;
    my $argstr = shift;

    my $pval;
    my @cmdArr;

    while ($argstr) {
	if ($argstr =~ /^\'((?:[^\']|\'\')+)\'/o) {
	    # --- 'String' recognizing, substituting '' to \' ---
	    $pval   = $1;
	    $argstr = $';
		    $pval   =~ s/\'\'/\\\'/go; # ' # for emacs
	    push (@cmdArr, "'$pval'");
	} elsif ($argstr =~ /^\"(([^\"]|\"\")+)(\")/o) {
	    # --- "String" recognizing, substituting "" to \" ---
	    $pval = $1;
	    $argstr = $'; # ' #  for emacs
	    $pval =~ s/\"\"/\\\"/go;
	    push (@cmdArr, "\"$pval\"");
	} elsif ($argstr =~ /^([^\s\'\"]+)/o) {
	    # --- handle string up to next white space, ' or " ---
	    $pval = $1;
	    $argstr = $'; # ' # for emacs
	    push (@cmdArr, "'$pval'");
	} else {
	    last;
	}
	$argstr =~ s/^\s+//o;
    }

    return @cmdArr;
}

sub getGeneratorsFromArgs {
    my $self       = shift;
    my $argRef     = shift;
    my $generators = shift(@$argRef);

    return @{$self->{_genList}} if $generators eq "'-all'";

    $generators = substr($generators, 1);
    chop $generators;
    return split (/\|/, $generators);
}

1;