# charcuterie.pm
#
# Copyright (c) 2003 
# Nyal <nyal@voila.fr>, Claudio <hobbes_cur@hotmail.com>. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# Documentation (at end) improved 2003 by Nyal <nyal@voila.fr>.

package charcuterie;

use strict;

BEGIN {
    require Exporter;
    use vars qw(@ISA @EXPORT %EXPORT_TAGS @EXPORT_OK $VERSION);
    @ISA = qw(Exporter);
    @EXPORT = qw(next_expr); # fonctions
    %EXPORT_TAGS = ();
    @EXPORT_OK = qw(); # variables
    $VERSION = "1.2";
}

use vars @EXPORT_OK;
use vars qw(%stock_fd @keyword $parenthese
	    @keyword_uniq @keyword_multi
	    $fd $compteur $recreate_word @tabl 
	    $stop_lecture $vire_space);

%stock_fd = ();
@keyword_uniq = (
		 ['\\', \&avance_bcksl],
		 ['\'', \&avance_quote],
		 ['"' , \&avance_double_quote],
		 );

@keyword_multi = (
		  ["\Q/*\E"      , \&avance_comment_c],
		  ["\Q//\E"      , \&avance_comment_cpp],
		  ["for[ \t\(]"  , \&avance_parenthese],
		  ["while[ \t\(]", \&avance_parenthese],
		  ["if[ \t\(]"   , \&avance_parenthese],
		  ["\Q\@\E.*"    , \&avance_arobase],
		  ["\Q\#\E.*"    , \&avance_arobase],
#		  ["\Q\@implementation\E", \&avance_arobase],
#		  ["\Q\@module\E", \&avance_arobase],
		  );

sub charcuterie_error() {
    my $error = $_[0];
    
    print "KOOC:${$stock_fd{$fd}}[1]:${$stock_fd{$fd}}[2]: ";
    $_[1] =~ s/([a-z]*?)\[.*/$1/ and print "syntax error before '$_[1]'\n" if ($error == "1");
    exit 1;
}

sub rajoute_line() {
    while (!defined($tabl[$compteur])) {
	my $value = <FD>;
	${$stock_fd{$fd}}[2]++;
	if (!defined($value) || $stop_lecture) {
	    $stop_lecture = 1;
	    return 0;
	}
	chomp $value;
	${$stock_fd{$fd}}[0] .= " " . $value;
	push @tabl, split(//, " " . $value);
    }
    return 1;
}

sub vire_space() {
    return if (!defined($tabl[$compteur]));
    if ($tabl[$compteur] =~ /[ \t]/) {
#	$tabl[$compteur] = " ";
	#$stock_fd{$fd} = join("", @tabl);
	$vire_space++;
    }
    else {
	if ($vire_space) {
	    #print "$compteur $vire_space }\n";
	    splice(@tabl, $compteur - $vire_space + 1, $vire_space - 1);
	    $tabl[$compteur - $vire_space] = " ";
	    ${$stock_fd{$fd}}[0] = join("", @tabl);
	    $compteur = $compteur - $vire_space;
	}
        $vire_space = 0;
    }
}

sub gere_letter() {
    my $want = $_[0];
    
    !&rajoute_line() && return 0; 
    &vire_space();
    return 1 if (!defined($tabl[$compteur]));
#    print "----> $want $tabl[$compteur] $parenthese\n";
    if (!($tabl[$compteur] =~ /[ \t]/ &&
	  !$recreate_word)) {
	# section rajoute mot si different separateur
	if ($tabl[$compteur] !~ /[;{}\(\)]/ ||
	    ($tabl[$compteur] =~ /\(/ && $want ne "[)]")) {
	    if ($recreate_word =~ /[ \t]$/) {
		$recreate_word = "";
	    }
	    else {
		$recreate_word .= $tabl[$compteur];
	    }
	}
	else {
	    if ($tabl[$compteur] =~ /($want)/) {
		if ($1 eq ";") {
		    return 0;
		}
		if ($1 eq ")") {
		    $parenthese--;
		    if ($parenthese == 0) {
			return 0;
		    }
		}
		if ($1 =~ /[{}]/) {
		    if ($compteur) {
			$compteur--;
		    }
		    return 0;
		}
	    }
	    if ($tabl[$compteur] eq "(" && $want eq "[)]") {
		$parenthese++;
	    }
	}
    }
    $compteur++;
    return 1;
}

sub avance_bcksl() {
    $compteur++;
}

sub avance_arobase() {
    my $temp;

#     my $temp = $stock_fd{$fd};
#     $stock_fd{$fd} = "";
#     return $temp;

    if ($compteur != 1) {
	$temp = substr (${$stock_fd{$fd}}[0], 0, $compteur - 1, "");
	$compteur = 0;
    } else {
	$temp = ${$stock_fd{$fd}}[0];
	${$stock_fd{$fd}}[0] = "";
    }
    return $temp;

}

sub avance_quote() {
    $compteur++;
    while (1) {
	!&rajoute_line() && return ;
	if ($tabl[$compteur] eq '\\') {
            $compteur += 2;
        }
	if (defined ($tabl[$compteur]) && $tabl[$compteur] eq '\'') {
	    $compteur++;
	    last;
	}
	$compteur++;
    }
    $recreate_word = "";
}

sub avance_double_quote() {
    $compteur++;
    while (1) {
	!&rajoute_line() && return ;
	if ($tabl[$compteur] eq '\\') {
	    $compteur += 2;
	}
	if (defined ($tabl[$compteur]) && $tabl[$compteur] eq '"') {
	    $compteur++;
	    last;
	}
	$compteur++;
    }
    $recreate_word = "";
}

sub avance_comment_c() {
    my $compteur_sav = $compteur;
    my $var	     = 0;
    
    while (1) {
	!&rajoute_line() && return undef;
	#print "/* --> $tabl[$compteur] $var\n";
	if ($tabl[$compteur] eq "*") {
            $var++;
        }
	else {
	    if ($tabl[$compteur] eq "/") {
		last if ($var == 1);
	    } 
	    else {
		$var = 0;
	    }
	}
        $compteur++;
    }
    $compteur_sav -= 2;
    splice(@tabl, $compteur_sav,
	   $compteur - $compteur_sav + 1);
    $compteur = $compteur_sav;
    ${$stock_fd{$fd}}[0] = join("", @tabl);
    $recreate_word = "";
    return undef;
}

sub avance_comment_cpp() {
    splice (@tabl, $compteur-2, $#tabl - $compteur +3);

    $compteur -= 1;
    ${$stock_fd{$fd}}[0] = join("", @tabl);
    $recreate_word = "";
    return undef;
}

sub avance_parenthese() {
    my $word_key = $_[0];
    my $testing = substr(${$stock_fd{$fd}}[0], 0, $compteur, "");

    &charcuterie_error(1, $word_key) if ($testing =~ /[^ ] $word_key/);
    $parenthese++ if ($recreate_word =~ /\($/);
    $recreate_word = "";
    my $value = &have_expr_selon_sep("[\)]");
#    print "/ $value /". "\n";
    return ($value);
}

sub have_expr_selon_sep() {
    for (; &gere_letter($_[0]); ) {
	for (my $cpt = 0; $keyword_uniq[$cpt]; $cpt++) {
	    if (defined($tabl[$compteur]) &&
		${$keyword_uniq[$cpt]}[0] eq $tabl[$compteur]) {
		&{${$keyword_uniq[$cpt]}[1]}();
		last;
	    }
	}
	for (my $cpt = 0; $keyword_multi[$cpt]; $cpt++) {
	    if ($recreate_word =~ /${$keyword_multi[$cpt]}[0]/) {
		my $ret = &{${$keyword_multi[$cpt]}[1]}(${$keyword_multi[$cpt]}[0]);
		if (defined($ret)) {
		    return ($ret);
		}
		last;
	    }
	}
    }
#    print "----$stock_fd{$fd}----" . "\n";
    my $expr = substr(${$stock_fd{$fd}}[0], 0, $compteur + 1, "");
#    print $expr . "\n";
    return undef if ($stop_lecture);
    return ($expr);
}

sub zero_charcuterie_hash() {
    undef $stock_fd{$fd};
    return 1;
}

sub next_expr() {
    *FD = $_[0];
    $fd = $_[0];

    $stop_lecture = 0;
    $parenthese = 0;
    $compteur = 0;
    $recreate_word = "";
    $vire_space = 0;
    @tabl = ();
#    if (!(exists($stock_fd{$fd}) && $stock_fd{$fd})) {
    if (!$stock_fd{$fd}) {
	if (!exists($stock_fd{$fd})) {
	    $stock_fd{$fd} = [];
	    ${$stock_fd{$fd}}[1] = $_[1];
	    ${$stock_fd{$fd}}[2] = 0;
	}
	while (!${$stock_fd{$fd}}[0]) {
            if (!(${$stock_fd{$fd}}[0] = <FD>)) {
                &zero_charcuterie_hash();
		return undef;
            }
	    ${$stock_fd{$fd}}[2]++;
            chomp ${$stock_fd{$fd}}[0];
        }
    }
    @tabl = split(//, ${$stock_fd{$fd}}[0]);
    my $want = "[;}{]";
    my $result = &have_expr_selon_sep($want);
    &zero_charcuterie_hash and return undef if (!defined($result));
    $result =~ s/^[ ]*?|[ ]*?$//g;
    return ($result, ${$stock_fd{$fd}}[2]);
}

1;

__END__

=head1 NAME

charcuterie : Module permettant de recuperer les expressions des fichiers
              type C

=head1 SYNOPSIS

use charcuterie;

open FD, $ARGV[0];
while (1) {
    my ($expr, $line) = &next_expr(*FD, $ARGV[0]);
    if (!defined($expr)) {
        last;
    } else {
        print "\n $line ###" .  $expr . "###\n";
    }
}

=head1 DESCRIPTION

Le module decoupe les lignes au niveau des points-virgules et accolades.
Il renvoit les accolades seul contrairement aux points-virgules :

  int main()    {
^^^^^^^^^^^^   ^^^
   1 fois       2 fois

S'il ne trouve pas de caracteres cles, il lis les lignes suivantes du 
fichier.
Il decoupe ensuite les structures de controle. Ainsi :

for (int i = 0; i > atoi(str); i++)   {
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^  ^^^
   1 fois                             2 fois

Enfin, le module enleve les espaces superlus : Un seul est garde.
(plus de tabulation)
Bien sur, il garde l'integrite de chaines entre double-quote et quote
en faisant attention aux inhibiteurs backslash.
Puis les commentaires C/C++ sont tout simplement supprimes et le module peut gerer plusieurs fichier en meme temps.
Vous pouvez donc ouvrir un fichier, commencer a le traiter puis en ouvrir un autre. Vous traitez le nouveau fichier e revenez apres a l'ancien.

=head1 AUTHOR & COPYRIGHTS
Copyright 2003 by Nyal <nyal@voila.fr> and claudio <hobbes_cur@hotmail.com>

This library is free software; you can redistribute it and/or modify it under the same terms as the GNU General Public License.

=cut