论坛 › Perl › 用Perl 修改CVS Root

xinghe0 发表于 2015-12-27 15:08:10

用Perl 修改CVS Root

##############################################
##Change CVS Root
##Author: jthou
##2007-6-4
##############################################
#!c:/perl/bin/perl #-w
use Win32::File;

$str1 = "ur11";
$str2 = "url2";
our @stack;

print "Please Enter your work path: ";
$cin_t=<STDIN>;
chomp $cin_t;

&FindAllCVSFileAndChangeRoot($cin_t);

#&ChangeEntries($cin_t);

##########################
sub FindAllCVSFileAndChangeEntries
{
    @dir_f = @_;
$path = join(//, @dir_f);      
$ret = opendir(CURDIR, $path);   
if (!$ret)
{
      goto MARK;                                        # It's a file, not a dir.
}

@f_d = readdir(CURDIR);         
for($i = 0; $i<@f_d; $i++)
{
      if($f_d[$i] eq "." || $f_d[$i] eq ".."){next;}    # skip . and ..
      if($f_d[$i] eq "CVS")
      {
          $ret = opendir(CVSDIR, "$path\\$f_d[$i]") || die ("can not open $path\\$f_d[$i]\n");
          @sub_f_d = readdir(CVSDIR);
          for($j=0; $j<@sub_f_d; $j++)
          {
            if(@sub_f_d[$j] eq "Root")
            {
                  $file_path = "$path\\$f_d[$i]\\@sub_f_d[$j]";
                  &ChangeRoot($file_path);
                  print "$file_path\n";
            }
          }
          close(CVSDIR);
      }
      else
      {
      $subdir_t = $f_d[$i];
      $subdir = "$path\\$subdir_t";
      &PushDirs($subdir);                  
      }
}
closedir(CURDIR);
MARK:
$sub_dir = &PopDirs();
&FindAllCVSFileAndChangeEntries($sub_dir);      
}   

##############################
sub ChangeRoot         # replace CVS root
{
my ($fname) = @_;
my @new_file;
Win32::File::GetAttributes($fname, $attrib) || die $!;   
Win32::File::SetAttributes($fname, NORMAL) || die $!;   #change file attribute to writeble

open(FILE, "<$fname") || die "Can't open the file $fname\n";
while($line = <FILE>)
{
      if(($start = index ($line, $str1, 0)) != -1)
    {
#         $line=~s/$str1/$str2/;
      $len = rindex $str1."\$", "\$";
      substr($line, $start, $len)=$str2;
      print $line;
      print "\n";
    }
    push @new_file, $line;

}
close(FILE);

open(FILE," >$fname") || die "Can't store the file $fname\n";
for $i(0..$#new_file){
    print FILE $new_file[$i];
}
close(FILE);
Win32::File::SetAttributes($fname, $attrib) || die $!;#change file attribute back
}

##############################
sub PushDirs       # Push a dir name
{
    my @dir_fs = @_;
   
    my $path_fs = join(//, @dir_fs);
    push (@stack, $path_fs);
}

##############################
sub PopDirs         # Pop a dir name。
{
    $size = @stack;
    if($size != 0)
    {
    $buf_pop = pop(@stack);
      return $buf_pop;   
    }
    print "complete!";
    exit();
}

查看完整版本: 用Perl 修改CVS Root