perl-flex.pl

flex是linux下一个很有用的高效的编译器工具

#!/usr/bin/perl

use strict;
use warnings;

########################

sub eliminate{
    my ($firs, $seco) = @_;

	open(Ffir,$firs) or die "can't open:$!";
	
	my @rule_name; #the rules must be eliminate
	my @out;
	my @rule;   #the rule's regex contains sentence like '!~'
	
	while(my $line = <Ffir>){
		$line=~s/^#.*$//;
		$line=~s/^\s+//;
		$line=~s/\s+$//;
		next unless($line);

		my($key,$value,$regex) = split(/[\s\t]+/,$line,3);
		if ($key eq 'score' and $regex == '0') {
			push(@rule_name,$value);
		}elsif ($regex=~/^eval:.*$/){
			push(@rule_name,$value);
		}elsif ($regex=~/^.+\s!~.*$/){
			push(@rule,$value);
		}else{
		
		}
	}
=i

		if($line=~/^score\s+([^\s]*)\s+([-0-9.]{0,5})/){  #Find out the rules its score is not zero.
			if($2 == '0'){
				push(@rule_name,$1);
			}
		}
		my($key,$value,$regex) = split(/[\s\t]+/,$line,3); #Find out the rules its regex contains 'eval:'.
		if ($regex=~/^eval:.*$/){
			push(@rule_name,$value);
		}elsif($regex=~/.+\s!~.*/){
			push(@rule,$value);
		}else{
		}
	};
=cut

#	print "The number of the rules its score is not zero is:";
#	print scalar @rule_name;
	close Ffir;

	local $,='  ';
	print @rule;
#dele the same element in @rulename
	my %saw;
	@out = grep(!$saw{$_}++,@rule_name);   
#	print   @out;

	my $signal=1;
	my $newsign=1;
#	print "\n",$_,"\n";
	open(Ffir,$firs) or die "can't open:$!";
	open(Fsec,">>".$seco) or die "can't open:$!";
	while(my $m_line = <Ffir>){
		$m_line=~s/^#.*$//;
		$m_line=~s/^\s+//;
		$m_line=~s/\s+$//;
		next unless($m_line);
		my($m_key,$m_value,$m_regex) = split(/[\s\t]+/,$m_line,3);
		foreach (@out) {
			if($m_value eq $_){
				$signal=0;
				next;
			}
		}
		if ($signal) {
			if ($m_key eq 'score') {
				foreach (@rule) {
					if ($m_value eq $_) {
						$newsign=0;
						print "\nchange...\n";
						print Fsec "$m_key $m_value -$m_regex\n";
#						last;
					}
					
				}
				if ($newsign) {
  					print Fsec $m_line."\n";
				}
			}elsif($m_key ne 'describe'){
				print Fsec $m_line."\n";
			}else{

			}
		}
		$signal=1;
		$newsign=1;
	}
	close Ffir;
	close Fsec;
}
#######################

sub convert{    #convert sa-regex to flex-regex

	my ($newrule) = @_;

##like this:?:/?!/?=
	$newrule=~s/\(\?:(.*?)\)/$1/eg;  #del the formate regex:(?:)

	$newrule=~s/\(\?!(.*?)\)/$1/eg;   #del the formate regex:(?:)

	$newrule=~s/\(\?=(.*?)\)/$1/eg;    #del the formate regex:(?:)


#########################################
#change ESC .....

	$newrule=~s/\\d/'[0-9]'/eg;

	$newrule=~s/\\D/'[^0-9]'/eg;

	$newrule=~s/\\s/'[\f\n\r\t\v]'/eg;

	$newrule=~s/\\S/'[^\f\n\r\t\v]'/eg;

	$newrule=~s/\\w/'[A-Za-z0-9_]'/eg;

	$newrule=~s/\\W/'[^A-Za-z0-9_]'/eg;

##########################################
#eliminate the formatted rule:[*|+|?|{n}|{n,}|{n,m}]?

#	$newrule=~s/[\*|\+|\?|\{\d\}|\{\d,\}|\{\d,\d\}]\?//eg;   #####??????????????

	$newrule=~s/\((.*?)\)/$1/eg;

############End of convert#######################


	return $newrule; 

}

###################start parsing......#############################

sub newchange{
    my ($fir, $sec) = @_;
	
	open(FH,$fir) or die "can't open:$!";
	open(FL,">>".$sec) or die "can't open:$!";

	my $temprule;
	my $flexrule;

	while (my $line=<FH>) {
		$line=~s/^\s+//;
		$line=~s/\s+$//;
		next unless($line);
	
		my ($key,$value,$rule)=split(/[\s\t]+/,$line,3);

#		print "\n\n".$key."\n\n";

		if ($key eq 'score') {
			print FL $line."\n";
		}else{	
			if($rule=~/^\/(.*)\/[g|i|m|o|s|x]{0,2}$/){     #if it's regex like:/ /
				$flexrule=convert($1);
#				print $1."\n";
			}elsif ($rule=~/m\{(.*)\}$/){    #if it's regex like:m{ }
				$flexrule=convert($1);
#				print $1."\n";
			}elsif($rule=~/(.*):.*\s=~\s\/(.*)\/[g|i|m|o|s|x]{0,2}$/){        #if it's like:From =~
				$temprule=convert($2);
#				print $1.': '.$2."\n";
				$flexrule=$1.": ".$temprule;
			}elsif($rule=~/([^:]*)\s=~\s\/(.*)\/[g|i|m|o|s|x]{0,2}$/){
				$temprule=convert($2);
#				print $1.': '.$2."\n";
				$flexrule=$1.": ".$temprule;
			}elsif($rule=~/(.*):.*\s!~\s(.*)\[if-unset:.*\]$/){   #if it's like:From !~
				$temprule=convert($2."\\\@");
#				print $1.': '.$2."\n";
				$flexrule=$1.": ".$temprule;
			}elsif($rule=~/([^:]*)\s!~\s[\/|m\{](.*)[\/|\}].*$/){                             #the others formated rule
				$temprule=convert($2);
#				print $1.': '.$2."\n";
				$flexrule=$1.": ".$temprule;
			}else{
			                            # the others like : tflags. Deal with it latter.
			}
			print FL $key.' '.$value.'		'.$flexrule."\n";
	
		}

	}
	close FH;
	close FL;
}
#######################
#=item
sub flexrule{
	my ($first, $secon,$third) = @_;
	
	open FH,$first or die "Cant be open: $!";

	my @rule_name;

	while (my $line=<FH>) {
		$line=~s/^\s+//;
		$line=~s/\s+$//;
		next unless($line);
		
		my($key,$value,$regex)=split(/[\s\t]+/,$line,3);
	
		if ($key eq 'score') {              ## extract the whole of rules
			push(@rule_name,$value);
		}
	}

#	print "@rule_name\n";
	close FH;


	foreach (@rule_name) { #resort the rules:put them together if they have the same rule_name

		open FH,$first or die "Cant be open: $!";
		open FN,">>".$secon or die "Cant be open: $!";

			while (my $m_line=<FH>) {
				$m_line=~s/^\s+//;
				$m_line=~s/\s+$//;
				next unless($m_line);
	
				my($m_key,$m_value,$m_regex)=split(/[\s\t]+/,$m_line,3);

				if ($m_value eq $_) {
					print FN $m_key." ".$m_value."	".$m_regex."\n";
				}	
			}
		close FH;
		close FN;
	}
##################################print the formatted rules in FLEX


	open FH,$secon or die "Cant be open: $!";
	open FN,">>".$third or die "Cant be open: $!";


	while (my $my_line=<FH>) {
		$my_line=~s/^\s+//;
		$my_line=~s/\s+$//;
		next unless($my_line);
	
		my($my_key,$my_value,$my_regex)=split(/[\s\t]+/,$my_line,3);

		if ($my_key ne 'score') {
			if ($my_key eq 'header') {
				$my_regex =~/(\S*):\s(.*)/;
				print FN "<".uc($1).">".$2." {\n";
			}else{
			print FN "<BODY>".$my_regex." {\n";
			}
		}elsif ($my_key eq 'score'){
			print FN "\tscort += ".$my_regex.";\n}\n";
		}else{
	          ##do nothing;
		}
	}
	close FH;
	close FN;

}
#########-end-#########

#=cut

my $filel='F:\rule\doc\local.sco';
my $filef='F:\rule\doc\flex.sco';
my $filet='F:\rule\doc\temp.sco';
my $filez='F:\rule\doc\final.sco';  #by zhou
#my @rule;
#my $filel='F:\rule\doc\11.sco';
#my $filef='F:\rule\doc\22.sco';


print "Firstly,clear the rules that it's score is zero(Cause this rules do nothing).\n";
print "Secondly,clear the rules that it's regex like 'eval:.?'(Cause this rules need special disposal).\n";
eliminate($filel,$filet);

print "Thirdly,change the rules that it's regex is not recognize by flex.\n";
newchange($filet,$filef);
unlink($filet);
print "Finally,transform the rules to the flex formate.\n";
flexrule($filef,$filet,$filez);
unlink($filet);
unlink($filef);
print "Transition succeeded,3x for using.The file 'flex.sco' is what you want.\n";