用Perl 修改CVS Root

最新推荐文章于 2021-05-14 07:27:50 发布

weixin_30614587

最新推荐文章于 2021-05-14 07:27:50 发布

阅读量61

点赞数

CC 4.0 BY-SA版权

原文链接：http://www.cnblogs.com/jthou/articles/779866.html

本文介绍了一个Perl脚本，用于递归地查找CVS仓库中的所有Root文件，并将指定的URL替换为新的URL。该脚本适用于Windows环境，通过修改CVS的配置来变更项目的版本控制系统设置。

##############################################
##  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();
}

转载于:https://www.cnblogs.com/jthou/articles/779866.html