# 讀寫文件的簡單函數
# 關鍵詞:函數,引用,讀寫文件,前綴 ,雙下劃線,雙目，匹配，
   use CGI qw(:all);
   #use strict;


   $mat_var = '(?:[a-zA-Z_]+[\w]*)';






   sub OpenFile{
    ($sorc_dir) = @_;

    open(SORC,$sorc_dir) or die "Can't open $sorc_dir";
    local (@cont) = <SORC>;
    close SORC;
    return (\@cont);
  }


  sub Proc_file{
   ($pa_sorc,$comm) = @_;
    #@cont = @{$sorc_ref};

    foreach (@{$pa_sorc})
    {
    my $tmp = $_;
    #if ($tmp =~ m/$mat_tree/)
    {Proc_line(\$_);}
    #print "line finished->$_\n";
    }
   }




   {
   @sig_operator = qw(+ - * / % & ^ | = > < );

   foreach(@sig_operator)
   {
   $_ =~ s/^(\W)$/\|$1/;
   $sig_oper.= $_;
   }
   $sig_oper =~ s/^\|/[/;
   $sig_oper .= ']';
   }
   #for single operator end
   #print $sig_oper;




   {
   @bin_operator = ( '\+=', '\*=', '\/=', '%=','\-=',
                     '>=',  '!=', '\<=',
                     '\^=','\|=','&=','>>','\<\<',
                     '\|\|','&&','=='
                     );




   foreach(@bin_operator)
   {
   $_ = '|'.$_;
   $bin_oper.= $_;
   }
   $bin_oper =~ s/^\|//;
   }



     sub b_tree
   {

     my ($out,$tmp,$patern,$l2);
     ($in,$patern) = @_;
     $l2 = $patern;
     if($in =~ m|^
                 (.*)  #left else

                   	(?<!$l2) #00000define operator
                   	($l2)
                   	(?!$l2)  #00000define operator

                 (.*\n?) #?????
                 $
                 |x)
     #if($in =~ m/^(.*)((?<!$mat_var)$l2(?!$mat_var))(.*\n?)$/)#前綴后綴都需要
      {

      #print "lll$1->$2->$3\n";
      $ok = $2;
      $c3 = $3;
      $uok = $1;

      $c3 =~ s/^\s*/ /;#assure end with a blank
      $ok .= $c3;


      #print "rrr$1->$2";
      $g_rev_stack[$g_index++] = $ok;
      #print "add->$ok\n";

      $uok =~ s@\s*$@ @;#assure begin with a blank


      #print "left->$uok\n";



      b_tree($uok,$l2);

      }

      $g_last = $in;
      #return $in;#遺留最后一次
    }




   sub l_trees
   {
     @g_rev_stack = ();
     $g_index = 0;
     $g_last = 0;
     my ($final,$p_in_out,$j,$patern,$l2);

     ($p_in_out,$patern) = @_;
     $l2 = $patern;
     if(($$p_in_out =~ m/$l2/)== 0)# 不需要處理
     {
     #print "not matched\n";
     return;}

     b_tree($$p_in_out,$patern);


     $g_rev_stack[$g_index++] = $g_last;
     #print "in->$g_last\n";

     $$p_in_out = ();
     for ($j = $g_index - 1 ;$j > -1; $j--)
     	{ $$p_in_out .= $g_rev_stack[$j];}
    }




    sub Proc_line{

    my ($p_sorc,$comm) = @_;
    #print "processing on $$p_sorc\n";

    l_trees($p_sorc,$bin_oper);
    l_trees($p_sorc,$sig_oper);

  }
  #處理命令



  sub CreateFile{
  (
   $des_dir,$cont_ref) = @_;
   local ($des_dir) = '>'.$des_dir;
   local @cont = @{$cont_ref};
   open (DES,$des_dir) or die "Can't create file $des_dir";
   print DES @cont;
   close DES;
  }






   $a = OpenFile("j:\\Carrangement4.h");#向量引用
 # $a = OpenFile("j:\\email.txt");#向量引用
  Proc_file($a,"=");#向量引用

  foreach(@{$a})
  {
     print $_;
  }
  #CreateFile("j:\\Carrangement4.h",$a);