#!/usr/bin/perl 
#
# modperlize.pl
#
# Replaces all global variables with a single hash passed to all subs.
#
# If the file is an object:
#	- the \%config hash is passed to 'new' and added to $self
#	- all global variables are replaced with 
#		$self->{config}{<package>}{<name>} or
#		@{$self->{config}{<package>}{<name>}}
#		%{$self->{config}{<package>}{<name>}}
# If the file is a normal package
#	- the \%config hash is passed to al subs
#	- all global variables are replaced with
#		$$config{<package>}{<name>} or
#		@{$$config{<package>}{<name>}
#		%{$$config{<package>}{<name>}
#
# All special edits are done as a patch BEFORE the replacement
#
# TODO
#	- modularizzare
#
use File::Find;


$| = 1;	# no buffering

my $DEBUG = 1;
#my $DEBUG = 2;

my %funcs;
my %funcsObj;
my @objects;
my @packages;
my %vars;

my @files = () ;

#-------------------------------------------------------------------

&main;

sub main {

    my $inpath = 'twiki.patched';
    my $outpath = 'twiki.modperlOneKey';

    my $start = localtime();

    if (! -d "twiki" )
    {
       print "EXIT : Directory twiki not found ! ";
       exit ;
    }
    print "\ncopy directory twiki in twiki.patched ... ";
    if ( system("rm -rf twiki.patched; mkdir twiki.patched; cp -r twiki/bin twiki.patched/bin; cp -r twiki/lib twiki.patched/lib ") != 0 ) 
    {
       print "EXIT : Error in copying Directory twiki in twiki.patched ! ";
       exit ;

    }
    print "OK";

    # apply special patches before other general transformations
    print "\napplying patch  .....";
    if ( ! -f "twiki.diff.20040901oo" )
    {
       print "EXIT : File  twiki.diff.20040901oo not found ! ";
       exit ;
    }
    chdir $inpath ;
    system("patch -p1 < ../twiki.diff.20040901oo ");
    chdir ".." ;
    print "OK Check patching and";
    print "\npress y to continue : ";
    chomp(my $continue=<STDIN>);
    if ( $continue ne "y" )
    {
         print "\nEXIT\n " ;
         exit ;
    }
    print "\nCONTINUE\n  " ;

    if ( system("rm -rf twiki.patched/lib/TWiki/Form.pm1 ") != 0 ) 
    {
       print "EXIT : Error in removing Form.pm1 in twiki.patched ! ";
       exit ;
    }

    #if a file pm contains more package create a separeted file for each package
    &onePackOneFile ($inpath); 

    #instructions in BEGIN blocks and not in sub are inserted in a sub init_config
    &insertBeginInitPlugins ($inpath); 

    if ( system("rm -rf twiki.modperlOneKey ;mkdir twiki.modperlOneKey ;  cp -r twiki.patched/bin twiki.modperlOneKey/bin; cp -r twiki.patched/lib twiki.modperlOneKey/lib ") != 0 ) 
    {
       print "EXIT : Error in copying Directory twiki in twiki.modperlOneKey ! ";
       exit ;

    }
    print "OK";

    chdir $inpath ;

 
    @files = ();
    find sub { push @files, $File::Find::name if -f && $_ ne "geturl" }, "./bin" , "./lib" ;

    chdir ".." ;

    my  $f ;
    foreach $f ( @files) {
	    print "getting global vars and functions from $f\n" if $DEBUG;
	    &getGlobals( $f, $inpath);
    }
    print "found objects: ", join(" ", @objects), "\n" if ($DEBUG && @objects);


    foreach $f ( @files) {
	    print "\nreplacing vars in $f: " if $DEBUG;
	    &replaceInFile ( $f, $inpath, $outpath);
    }

    chdir $outpath ;
    if ( rename ("./lib/TWiki.cfg" , "./lib/TWikicfg.pm" ) )
    {
         print "OK rename TWiki.cfg in TWikicfg.pm\n";

         print "\n\nCreate your configuration file (you can modify the conf-file later or create a new or another conf-file):\n";
         print "name of host :";
         $host=<>;
         chomp($host);
         print "web-server port (i.e.80) :";
         $port=<>;
         chomp($port);
         print "REQUEST_URI of twiki script in web-server conf (i.e.twiki1) :";
         $scriptFileName=<>;
         chomp($scriptFileName);
         my $confName=$host . "Port" . $port . $scriptFileName . ".pm";
         if (system( "cp ./lib/TWikicfg.pm ./lib/$confName ") != 0 ) { 
                  print "WARNING: Can't create file ./lib/$confName \n";
         }else{
                  local $/ ;
                  my $fConf= open CONF, "< ./lib/$confName";
                  my $confText = <CONF>;
                  close CONF;
                  $confText =~ s|/twiki/|/$scriptFileName/|gms ;
                  my $fConf= open CONF, "> ./lib/$confName";
                  print CONF $confText ;
                  close CONF;
                  print "OK lib/$confName created \n";

         }
         
    }else{
         print "ERROR rename TWiki.cfg in TWikicfg.pm\n";
    }


    my $finish ;
    print "\n START EXECUTION  : $start  \n ";
    print "\n FINISH EXECUTION : ", scalar(localtime()), "\n ";
    print "\n\n NEXT STEP : Now save your twiki/bin and twiki/lib and substitute with twiki.modperlOneKey/bin twiki.modperlOneKey/lib \n\n";

}


sub onePackOneFile ($) {
    my $inpath = shift ;
    chdir $inpath."/lib";
    @files = ();
    find(sub {
        push @files, $File::Find::name if -f $_;
    }
    , 'TWiki');
    chdir '../..';
    my $f;
    foreach $f (@files) {
        my $fpack = 0;
        my $textFile = '';
        my $currPack = $f ;
        $currPack =~ s/\//::/g ;
        $currPack =~ s/\.pm$//g ;
        print "\nfind packInPack in $f - $currPack " if ( $DEBUG == 2 );
        my $packInPack = '';
        if ( !(open INPUT, "<$inpath/lib/$f") ){
            print "EXIT: Can't read $inpath/lib/$f" ;
            exit;
        }
        while (defined($_ = <INPUT>)) {
	    if ($_ =~ /^\s*package\s+$currPack\s*;/) { 
                $fpack = 0;
            }
	    if ((($_ =~ /^\s*package\s+(.*?)\s*;/) &&
	         ($_ !~ /^\s*package\s+$currPack\s*;/)) 
                || $fpack ) {
                $inline = $_ ;
	        if ($_ =~ /^\s*package\s+(.*?)\s*;/) {
                   if ( $packInPack ) {
                      open PACK , ">> $inpath\/lib\/$packInPack\.pm" ;
                      print PACK  "\n1;\n" ;
                      close PACK ;
                   }
                   $packInPack = $1;
                   print "\nfound package in package : <$packInPack> in <$currPack>" ;
                   $textFile .= "\nuse $packInPack ; \n";
                }
                $fpack = 1;
                $packInPack =~ s/::/\//g;
                if ( ! (open PACK , ">> $inpath\/lib\/$packInPack\.pm" ) ){
                   my @path_file = split '/',$packInPack ;
                   pop @path_file , $package;
                   my $dirP = "$inpath/lib/" ;
                   foreach my $dir ( @path_file ) {
                      $dirP = $dirP . '/' . $dir ;
                      if ( ! -d ( $dirP ) ){
                           if (system("mkdir $dirP") != 0 ) { 
                              print "EXIT: Can't create directory $dirP\n";
                              exit;
                           }else{
                              print "\nDirectory $dirP created";
                           }
                      }
                   }
                   if ( ! (open PACK , ">> $inpath\/lib\/$packInPack\.pm" ) ){
                      print "EXIT: Can't open file $inpath\/lib\/$packInPack\.pm\n";
                      exit;
                   }
                }
                print PACK  $inline ;
                close PACK ;
             }else{
                $fpack = 0 ;
                $textFile .= $_ ;
            } # if row
        } # while file
        if ( $packInPack ) {
           open PACK , ">> $inpath\/lib\/$packInPack\.pm" ;
           print PACK  "\n1;\n" ;
           close PACK ;
        }
        close INPUT;
        unlink "$inpath/lib/$f";
        open INPUT, "> $inpath/lib/$f" ;
        print INPUT $textFile;
        print INPUT "\n1;\n";
        close INPUT;
    } # for each file
}

sub insertBeginInitPlugins ($) {
    my $inpath = shift ;
    chdir $inpath;
    @files = ();
    find(sub {
        push @files, $File::Find::name if -f $_;
    }
    , './lib');
    #, './bin','./lib');
    chdir '..';
    my $f;
    foreach $f (@files) {
        next if ( $f =~/setlib\.cfg/ ) ;
        open INPUT, "<$inpath/$f";
        print "insert (main) in BEGIN in $inpath/$f .....\n ";
        my $begins = '';
        my $textmain = '';
        my $remtextmain = '';
        my $subs = '';
        my $ret = '';
        my $init = '';
        my $pack = '';
        my $comments = '';
        my $isa = '';
        my $callmain = '';
        my $syncbegin = 0;
        my $syncsub = 0;
        my $syncuses = 0;
        my $syncmain = 0;
        my $fbegin = 0;
        my $fsub = 0;
        my $fuses = 0;
        my $fpod = 0;
        my $begintext="";
print "init:".$init ."\n";
        while (defined($_ = <INPUT>)) {
            if ( $_ =~ /^#!.*\n/ ) {
                $init = $init . $_ ;
                print 'ini ' . $init   if $DEBUG==2;
                next ;
            }
            if ( $_ =~ /^\s*BEGIN\s*\{\s*unshift\s+\@INC,\s*'\.';\s*require\s+'setlib\.cfg'(;)?\s*\}\s*/ ) {
                $_ =~ s/^/#/ ;                   # remark thisi particolar row
                $init = $init . $_ ;
                print 'ini ' . $init   if $DEBUG==2;
                next ;
            }
            if ( $_ =~ /^\s*#.*\n/ || $_ =~ /^\s*\n/ || $fpod || ( $fpod = ($_ =~ /^=/ ) )  ) { 
                # fpod è settato ad 1 se trova =begi =end =pod
                $comments = $comments . $_ ;
                print 'rem-pod '.$fpod.'-'. $_   if $DEBUG==2;
                if ( $_ =~ /^=cut/ ){
                   $fpod=0;
                }
                next ;
            }
            if ( $_ =~ /^package\b/ ) { 
                $pack =  $_ ;
                print 'pack ' . $pack if $DEBUG==2;
                next ;
            }
            if ( $_ =~ /^\s*&main.*\n/  ) {
                $callmain = $comments . $_ ;
                print 'call ' . $callmain if $DEBUG==2;
                $comments = '' ;
                next ;
            }
            if ($fbeg || ($fbeg = $_ =~ /^\s*BEGIN\b.*?/)) {
                $inline = $_;
                $inlineclear = $_;
                $inlineclear =~s/\/.*?\///;
                $inlineclear =~s/([~=\s]s)#(.*?)#(.*)#/$1\/$2\/$3/;
                $inlineclear =~s/[\n,A-Z,a-z]#.*?\n//;
                $inlineclear =~s/".*?"\n//;
                if (not $fpar) {
                    $fpar = scalar(split(/\{/, $inlineclear, 0)) - 1;
                }
                $inline =~ s/^\s*BEGIN\b(.*)/$1/;
                $syncbegin += scalar(split(/\{/, $inlineclear, 0)) - scalar(split(/\}/, $inlineclear, 0));
                $remtextmain .= $comments ;
                $begintext .=  $inline;
                print 'beg ' . $inline . " $fpar $syncbeg " if $DEBUG==2;
                if ($fbeg and not $syncbegin and $fpar) {
                    $fbeg = 0;
                    $fpar = 0;
                    if ( $begintext =~ /setlib\.cfg/gm && $f !~ /testenv/ ) {
                       $init .= "\nBEGIN {\n$begintext\n}\n"   ;
                       print 'set ' . $begintext  if $DEBUG==2;
                    }else{
                       $begins .= $begintext ;
                       print 'beg ' . $begintext  if $DEBUG==2;
                    }
                    $begintext="";
                }
            }
            elsif ( $_ =~ /^\s*sub\b.*?;/) {
                $subs .= $comments . $_;
                print 'sub-1line ' . $_   if $DEBUG==2;
            }
            elsif ($fsub || ($fsub = $_ =~ /^\s*sub\b.*?/)) {
                $inline = $_;
                $inlineclear = $_;
                $inlineclear =~s/\/.*?\///;
                $inlineclear =~s/([~=\s]s)#(.*?)#(.*)#/$1\/$2\/$3/;
                $inlineclear =~s/[\n,A-Z,a-z]#.*?\n//;
                $inlineclear =~s/".*?"\n//;
                if (not $fpar) {
                    $fpar = scalar(split(/\{/, $inlineclear, 0)) - 1;
                }
                $syncsub += scalar(split(/\{/, $inlineclear, 0)) - scalar(split(/\}/, $inlineclear, 0));
                $subs .= $comments . $inline;
                print 'sub ' . $inline . " $fpar $syncsub " if $DEBUG==2;
                if ($fsub and not $syncsub and $fpar) {
                    $fsub = 0;
                    $fpar = 0;
                }
            }
            elsif ($fuses || ($fuses = $_ =~ /^\s*use\b/)) {
                if (not $fpar) {
                    $fpar = $_ =~ /[(*.?\(*.?),(;$)]/;
                }
                $inline = $_;
                $inlineclear = $_;
                $inlineclear =~s/\/.*?\///;
                $inlineclear =~s/([~=\s]s)#(.*?)#(.*)#/$1\/$2\/$3/;
                $inlineclear =~s/[\n,A-Z,a-z]#.*?\n//;
                $inlineclear =~s/".*?"\n//;
                if (not $fpar) {
                    $fpar = scalar(split(/\(/, $inlineclear, 0)) - 1;
                }
                $syncuses += scalar(split(/\(/, $inlineclear, 0)) - scalar(split(/\)/, $inlineclear, 0));
                $comments .=  $inline;
                print 'use ' . $inline . " $fpar $syncuses " if $DEBUG==2;
                if ($fuses and not $syncuses and $fpar) {
                    $fuses = 0;
                    $fpar = 0;
                }
                next;
            }
            elsif ( $_=~ /^\@ISA\b/ ) {
                $isa .=  $comments .$_;
                print 'isa ' . $isa   if $DEBUG==2;
            }
            elsif ($_ =~ /^1;/) {
                $ret .=  $comments .$_;
                print 'end-pm ' . $_   if $DEBUG==2;
            }
            elsif ( $_ =~ /^\s*require .*?;\n/ && ! $syncmain ) {
                $init .=  $_;
                print 'req ' . $_   if $DEBUG==2;
            }
            else {
                print 'main ' . $_ if $DEBUG==2;
                $inlineclear = $_;
                #$inlineclear =~s/\/.*?\///;
                $inlineclear =~s/([~=\s]s)#(.*?)#(.*)#/$1\/$2\/$3/;
                $inlineclear =~s/[\n,A-Z,a-z]#.*?\n//;
                $inlineclear =~s/".*?"\n//;
                $syncmain += scalar(split(/\{/, $inlineclear, 0)) - scalar(split(/\}/, $inlineclear, 0));
                $remtextmain .=  $comments ;
                $textmain .=  $_;
            }
            $comments = '';
        }
        close INPUT;
        print "Len: ".length ($textmain) ." "  . length ($begins)." \n";
        
        #COMMENTATO PER AGGIUNGERE SEMPRE LA init_config
        if ( length ($textmain) != 0 || length ($begins)!= 0 ) {
          unlink "$inpath/$f";
          open INPUT, "> $inpath/$f" ;
          print INPUT $init . $pack . $isa . $remtextmain . "\nsub init_config {\n" . $textmain . $begins . "\n}# END of init_config\n" . $callmain . $subs . $ret;
          close INPUT;
        }
    }
}

#-------------------------------------------------------------------
sub replaceInFile ($$$) {
	my $file = shift;
	my $inpath = shift;
	my $outpath = shift;
	local $/;

	open INPUT,  "<$inpath/$file";
	my $text = <INPUT>;
	close INPUT;

	my ($package,$pname,$var,$v);

	my @path_file = split '/',$file ;
	my $curpackage = "$path_file[$#path_file]" ;
	$text =~ s/^\s*package\s+TWiki\s*;//m if ( $curpackage eq "testenv" );
	$curpackage = $1 if ($text =~ /^\s*package\s+([\w:]+)\s*;/m) ;

        if ( $file =~ /bin\// ) {
	   &replaceMain(\$text,$curpackage);
        }

	&replaceInitialize(\$text,$curpackage);
        if ( ! (grep { /^$curpackage$/ } @objects ) ) {
	   &noObj2Obj(\$text,$curpackage);
        } else {
	   print "s" if ($text =~ s/^(\s*sub\s+init_config\b\s*{.*?)/$1 \n   my \$self = shift;\n/gms );
        }
        &sub2meth(\$text,$curpackage);
	&replaceObject(\$text,$curpackage);

	open OUTPUT, ">$outpath/$file" || die "could not open $outpath/$file for output";
	print OUTPUT $text;
	close OUTPUT;
}


#-------------------------------------------------------------------
sub replaceGlobalVariable (\$$$$$) {
    my $text = shift;
    my $varpackage = shift;
    my $variable = shift;
    my $curpackage = shift;
    my $isObject = shift;
    my $tipo = substr $variable, 0, 1;
    my $var = substr $variable, 1;


    my $conf_key=$varpackage;
    $conf_key=~ s/::/\}->\{/g;
    my $newname = "\$config->{$conf_key}->{$var}";

    print "\$1 $varpackage $var $newname\n" if ($$text =~ s/([^\\](\\\\)*)\$$varpackage\:\:$var\b/$1$newname/gms );
    print "\$1 $varpackage $var $newname\n" if ($$text =~ s/([^\\](\\\\)*)\$\{$varpackage\:\:$var\}/$1$newname/gms );
    print "\#" if ($$text =~ s/\$\#$varpackage\:\:$var\b/\$\#{$newname}/gms );
    print "$1" if ($$text =~ s/([\%\@])$varpackage\:\:$var\b/$1\{$newname\}/gms );
    if ($curpackage eq $varpackage || 
        ( ( $curpackage eq "TWikicfg" ) && ( $varpackage eq "TWiki" ) ) ||
        ( ( $curpackage eq "testenv" ) && ( $varpackage eq "TWiki" ) ) ||
        ( ( $curpackage eq "TWiki::Render" ) && ( $varpackage eq "TWiki" ) ) 
       ) {
	print "\$3 $varpackage $var $newname\n" if ($$text =~ s/\$$var\b/$newname/gms );
	print "\$3 $varpackage $var $newname\n" if ($$text =~ s/\$\{$var\}/$newname/gms );
#	print "\$3 $varpackage $var $newname\n" if ($$text =~ s/([^\\](\\\\)*)\$$var\b/$1$newname/gms );
#	print "\$3 $varpackage $var $newname\n" if ($$text =~ s/([^\\](\\\\)*)\$\{$var\}/$1$newname/gms );
	print "\#" if ($$text =~ s/\$\#\{?$var\}?\b/\$\#\{$newname\}/gms );
	print "L" if ($$text =~ s/([\%\@])\{?$var\}?\b/$1\{$newname\}/gms );
    }
}


#--------------------------------------------------------------------------------------------------------
# 
#--------------------------------------------------------------------------------------------------------

#--------------------------------------------------------------------------------------------------------
# objects
#--------------------------------------------------------------------------------------------------------
sub replaceObject (\$$) {
    my $text = shift;
    my $package = shift;
    
print "replaceObject ... $package\n" if $DEBUG;
    # TODO: remove vars?
    # remove global vars
    $$text =~ s/^\s*use\s+vars\s+qw\s*\(.*?\)\s*;//gms ;
    $$text =~ s/^\s*use\s+vars\s+'.*?'\s*;//gms ;

    # add $config arg to 'new'
   print "n" if ($$text =~ s/^(\s*sub\s+new\s*)(\([\\\$\@\%]+\))((\s*\#.*?\n)*\{.*?)$/$1(\%$2)$3\n\tmy \$dummy = shift;\n\tmy \$config = shift; \n\tunshift \@_, \$dummy ;\n/ms );
   print "n" if ($$text =~ s/^(\s*sub\s+new\s*(\(\s*\))?(\s*\#.*?\n)*\{.*?)$/$1 \n\tmy \$dummy = shift;\n\tmy \$config = shift;\n\tunshift \@_,\$dummy ;\n/ms );
    
    # add $config to $self just before return
    print "n" if ($$text =~ s/^(\s*bless\b.*?;\s*)$/\n\t\$self->{config}=\$config;\n$1\n/gms );
    
    # replace global vars
    foreach $vp (keys %vars) {
	foreach $var (@{$vars{$vp}}) {
	    &replaceGlobalVariable($text,$vp,$var,$package,1);
	}
    }

    # add $config to ->new calls
    foreach $op (@objects) {
        # don't change order two next lines
	print "-> $op $package " if ($$text =~ s/($op\-\>new\b\s*\()\s*([^\)].*?)$/$1\$config, $2/gms  );
	print "-> $op $package " if ($$text =~ s/($op\-\>new\b\s*\()\s*\)/$1\$config \) /gms  );
    }
    

    # add $self to init_config function definition and call to init_config
    if ( grep { /^init_config$/ } @{$funcs{$package}} ) {
        print "n" if ($$text =~ s/^(\s*bless\b.*?;\s*)$/$1\n\t\$self->init_config();\n/gms );
    }

    # add $config to all function definitions
    foreach $f (@{$funcs{$package}}) {
	next if ( $f eq "new" );
	    print "w" if ($$text =~ s/^(\s*sub\s+$f\b[^}]+my\s*\(?\s*\$self.*?;)(.*?\})/$1\n\tmy \$config = \$self->{config} ;\n$2/gms );
    }
}

#--------------------------------------------------------------------------------------------------------
# packages
#--------------------------------------------------------------------------------------------------------
sub noObj2Obj(\$$) {
    my $text = shift;
    my $package = shift;
    
print "replacePackage ... $package\n" if $DEBUG;

    # remove global vars
    $$text =~ s/^\s*use\s+vars\s+qw\s*\(.*?\)\s*;//gms ;



    # create a string with call to new for each new obj and old obj in TWiki.pm
    if ( $package =~ /^TWiki$/ ){
       my $allNew1 = "\n";
       my $allNew2 = "\n";
       foreach $fp (keys %funcs) {
         my $fpkey=$fp;
         $fpkey=~ s/::/\}->\{/g;
           if ( $$text =~ /^\s*use\s+$fp\s*;/ms ) {
               my $confVar="";
               if ( !(grep { /^$fp$/ } @objects ) ) {
                  $confVar="\$config";
               }
               # to have the string of pack and a string of pack::pack 
               # and call the first and then the second 
               my @rec_f = split ( "::" , $fp );
               if ( $#rec_f == 1 ) {
               $allNew1 = $allNew1 . "   \$config->{$fpkey}=$fp->new($confVar) ;\n";
               }else{
               $allNew2 = $allNew2 . "   \$config->{$fpkey}=$fp->new($confVar) ;\n";

               }
         }
       }
       
       #print "P" if ($$text =~ s/(^\s*sub\s+init_config\b(.*?)(\#.*?\n)*\s*\{.*?)/$1\n$allNew1\n$allNew2\n/gms );
       print "P" if ($$text =~ s/(^\$wikiversion)/\n$allNew1\n$allNew2\n$1/gms );
      }



    # add $self to all function definitions in ./lib
    # add $config to all function definitions in ./bin
    if ( $package =~ /^TWiki/ ){
      foreach $f (@{$funcs{$package}}) {
	next if ( $f eq "new" || grep { /^$f$/ } @{$funcsObj{$package}} ) ;
	print "u" if ($$text =~ s/^(\s*sub\s+$f\b\s*)\(([\\\$\@\%]+)\)(\s*(\#.*?\n)\s*\{.*?)/$1(\\\%$2)$3\n   my \$self = shift;\n/gms );
	print "s" if ($$text =~ s/^(\s*sub\s+$f\b\s*(\(\s*\))?\s*(\#.*?\n)?\s*\{.*?)/$1 \n   my \$self = shift;\n/gms );
      }
    }else{
      foreach $f (@{$funcs{$package}}) {
	next if ( $f eq "new" || grep { /^$f$/ } @{$funcsObj{$package}} ) ;
	print "u" if ($$text =~ s/^(\s*sub\s+$f\b\s*)\(([\\\$\@\%]+)\)(\s*(\#.*?\n)\s*\{.*?)/$1(\\\%$2)$3\n   my \$config = shift;\n/gms );
	print "s" if ($$text =~ s/^(\s*sub\s+$f\b\s*(\(\s*\))?\s*(\#.*?\n)?\s*\{.*?)/$1 \n   my \$config = shift;\n/gms );
      }
    }



    # add sub new to package first of all sub 
    if ( $package =~ /^TWiki/ ){
      print "I" if ($$text =~ s/^(\s*sub\s+.*?)$/\nsub new {\n   my ( \$proto ) =\@_ ;\n   my \$class = ref(\$proto) || \$proto ;\n   my \$self;\n   bless ( \$self );\n   return \$self ;\n}\n$1\n/ms );
      push @{$funcs{$package}}, 'new' ;
    }

}

sub sub2meth(\$$) {
    my $text = shift;
    my $package = shift;
    
print "replacePackageMethod ... $package\n" if $DEBUG;

    # trasform function calls to method call
    foreach $fp (keys %funcs) {
        my $fpkey=$fp;
        $fpkey=~ s/::/\}->\{/g;
	foreach $f (@{$funcs{$fp}}) {
	  ##next if ( grep { /^$f$/ }  @{$funcsObj{$fp}} );
         if ( $fp =~ /^TWiki/ ){
	    if (!$fp || $fp eq $package){
               # don't change order two next lines
	       print "&" if ($$text =~ s/(&$f\b\s*)(;)/\$config->{$fpkey}->$f $2/gms  );
	       print "&" if ($$text =~ s/(&$f\b\s*)(\(\s*[^\)].*?)$/\$config->{$fpkey}->$f $2/gms  );
	       print "&" if ($$text =~ s/(&$f\b\s*)(\(\s*\))/\$config->{$fpkey}->$f $2 /gms  );
	       print "&" if ($$text =~ s/([^:>_A-Za-z0-9])$f\b\s*(\(\s*[^\)].*?)/$1\$config->{$fpkey}->$f $2/gms  );
	       print "&" if ($$text =~ s/([^:>_A-Za-z0-9])$f\b\s*(\(\s*\))/$1\$config->{$fpkey}->$f $2 /gms  );
              #for calls whitout "(" like writeDebug 
	      print "&" if ($fp =~ /^TWiki$/ && $f =~ /writeDebug|writeWarning/ && $$text =~ s/([^sub ]\s*)$f(\s*["'].*?);/$1\$config->{$fpkey}->$f ( $2 );/gms  );
	    }
            # test also if  $fp eq $package
	    print "&" if ($$text =~ s/(&?$fp\:\:$f)(\b\s*.*?;)/\$config->{$fpkey}->$f $2/gms  );
	 }else{
         #if here the package fp is in bin so it'snt an obj and anly add $config to parameter
	    if (!$fp || $fp eq $package){
               # don't change order two next lines
	       print "&" if ($$text =~ s/([^:>A-Za-z0-9]$f\b\s*\()(\s*[^\)].*?)$/$1 \$config, $2/gms  );
	       print "&" if ($$text =~ s/([^:>A-Za-z0-9]$f\b\s*\()(\s*\))/$1 \$config $2 /gms  );
            }
	    print "&" if ($$text =~ s/($fp\:\:$f\b\s*\()(.*?;)/$1 \$config, $2/gms  );
        }
      }
   }
}

#--------------------------------------------------------------------------------------------------------
# TODO raccogliere qui tutte le trasformazioni relative alle initialize
sub replaceInitialize (\$$) {
    my $text = shift;
    my $package = shift;

print "replaceInitialize ... $package\n" if $DEBUG;


   if ( grep { /^init_config$/ } @{$funcs{$package}} ) {
	print "B" if ($$text =~ s/^(\s*sub\s+basicInitialize\b(.*?)(\#.*?\n)*\s*\{.*?)$/$1 \n\t \&init_config\(\);\n/gms );
	print "I" if ($$text =~ s/^(\s*sub\s+initialize\b(.*?)(\#.*?\n)*\s*\{.*?)$/$1 \n\t \&init_config\(\);\n/gms );
	print "PG" if ($$text =~ s/^(\s*sub\s+initPlugin\b(.*?)(\#.*?\n)*\s*\{.*?)$/$1 \n\t \&init_config\(\);\n/gms );

   }

   print "T" if ( $$text =~ s/TWiki\.cfg/\$config->{fileConfig}.pm/gms );

}

#--------------------------------------------------------------------------------------------------------
# TODO raccogliere qui tutte le trasformazioni relative ai main
sub replaceMain (\$$) {
    my $text = shift;
    my $package = shift;

print "replaceMain ... $package\n" if $DEBUG;


#
# In sub main add 
# my %configHash;
# my $config = \%configHash ;
# my $twikiUri = $ENV{"REQUEST_URI"};
# $twikiUri =~ s!/+!/!g ;               # remove multiple '/'
# my @twikiUriItem = split ( '/' , $twikiUri ) ;
# $$config{'fileConfig'} = $ENV{"SERVER_NAME"} . "Port" . $ENV{"SERVER_PORT"} . $twikiUriItem[$#twikiUriItem - 2 ];
#
#
# test if is a  file in directory  bin
#
   if ( $package eq "testenv" )
   {
      print "X" if ($$text =~ s/^(\s*sub\s+main\b\s*(\(\s*\))?\s*(\#.*?\n)*\s*\{.*?)$/$1 \n   my \%configHash; \n   my \$config = \\\%configHash;\n   my \$twikiUri = \$ENV{"REQUEST_URI"};\n   \$twikiUri =~ s!\/+!\/!g ; # remove multiple'\/' \n   my \@twikiUriItem = split ( '\/' , \$twikiUri ) ;\n   \$config->{fileConfig} = \$ENV{"SERVER_NAME"} . "Port" . \$ENV{"SERVER_PORT"} . \$twikiUriItem\[ 1 ];\n   \&init_config\(\);\n/gms );
   
   }elsif ( $$text =~ /^(\s*sub\s+main\b)/ms ) {

      print "H" if ($$text =~ s/(^\s*sub\s+main(.*?){)/$1\n\n   my \%configHash;\n   my \$config = \\\%configHash;\n   my \$twikiUri = \$ENV{"REQUEST_URI"};\n   \$twikiUri =~ s!\/+!\/!g ; # remove multiple'\/' \n   my \@twikiUriItem = split ( '\/' , \$twikiUri ) ;\n   \$config->{fileConfig} = \$ENV{"SERVER_NAME"} . "Port" . \$ENV{"SERVER_PORT"} . \$twikiUriItem\[ 1 ];\n   \$config->{TWiki}=TWiki->new( \$config );\n   \$config->{TWiki}->init_config();\n/ms );

   }else{

      print "H" if ($$text =~ s/(^\s*use\s+TWiki(.*?)\s*;)/$1\n\n   my \%configHash;\n   my \$config = \\\%configHash;\n   my \$twikiUri = \$ENV{"REQUEST_URI"};\n   \$twikiUri =~ s!\/+!\/!g ; # remove multiple'\/' \n   my \@twikiUriItem = split ( '\/' , \$twikiUri ) ;\n   \$config->{fileConfig} = \$ENV{"SERVER_NAME"} . "Port" . \$ENV{"SERVER_PORT"} . \$twikiUriItem\[ 1 ];\n   \$config->{TWiki}=TWiki->new( \$config );\n   \$config->{TWiki}->init_config();\n/ms );

   }

   if ( grep { /^init_config$/ } @{$funcs{$package}} ) {
        print "M1";
	print "M" if ($$text =~ s/(\$config->\{TWiki\}->init_config\(\);)/$1\n\t \&init_config\(\);\n/ms );
   }

   print "T" if ( $$text =~ s/TWiki\.cfg/\$config->{fileConfig}.pm/gms );

}

#-------------------------------------------------------------------
sub replaceCall ($) {
    my $match = shift;
    return $match 		if ($match =~ /\bsub\b/ );
    return "$match \$config, ";
}

#-------------------------------------------------------------------
sub getGlobals ($$) {
	my $file = shift;
	my $inpath = shift;

	local $/;

	open INPUT,  "<$inpath/$file";
	my $text = <INPUT>;
	close INPUT;

	my @path_file = split '/',$file ;
	my $package = $path_file[$#path_file] ;
	my @v = ();
	if ($text =~ /^\s*package\s+(.*?)\s*;/m && $package ne "testenv" ) {
	    $package = $1 ;
print "found package: $package\n" if $DEBUG;
	}

	$vars{$package} = [] if (!defined $vars{$package});
	while ( $text =~ /^\s*use\s+vars\s+qw\s*\((.*?)\)\s*;/gms ) {
	    @v = grep { $_ } split /\s+/s, $1;
	    push @{$vars{$package}}, @v;
	}	
	while ( $text =~ /^\s*use\s+vars\s+'(.*?)'\s*;/gms ) {
	    @v = grep { $_ } split /\s+/s, $1;
	    push @{$vars{$package}}, @v;
	}	
print "found vars: $package => ", join("\n\t", @{$vars{$package}}), "\n" if $DEBUG;

	$funcs{$package} = [] if (!defined $funcs{$package});
	$funcsObj{$package} = [] if (!defined $funcsObj{$package});
	while ( $text =~ /^\s*sub\s+(\w+)/gm ) {
	    push @{$funcs{$package}}, $1 if ( ($1 ne 'main') && ( ! grep { /^$1$/ } @{$funcs{$package}} ) )  ;
	}
	if ( grep { /^new$/ } @{$funcs{$package}} ) {
	    push @objects, $package; 
	}else{
	    push @packages, $package; 
       }

print "found funcs: $package => ", join("\n\t", @{$funcs{$package}}), "\n" if ($DEBUG && $funcs{$package});
print "found funcs in obj : $package => ", join("\n\t", @{$funcsObj{$package}}), "\n" if ($DEBUG && $funcsObj{$package});

}

#-------------------------------------------------------------------

__END__

