view release on metacpan or  search on metacpan

magicrcs  view on Meta::CPAN

  $have_vc_rcs_file=0;
} elsif ($@) {
  die;
}

use strict;
use integer;
use vars qw($opt_h $opt_v $opt_d $opt_s $opt_r $opt_t $opt_u $opt_g
	    $opt_c $opt_x $opt_w $opt_l $opt_dwim $syslevel $sig);
# $syslevel is current syslog seriousness level
# $sig is current signal

my ($logseq, $fam, $md5, %md5, %monitor, %discard)=(0, undef, new MD5);
# $logseq is logging sequencer
# $fam is FAM handle
# $md5 is MD5 context (reusable)
# %md5 is hash from file names to last-seen MD5 hashes
# %monitor is map from monitored file or dir names, to 1.
# %discard is map from full path names to time_t of last modification.

sub msg($;$;) {
  my ($text, $reqd)=@_;
  return unless $reqd or $opt_v;
  if ($opt_s) {
    syslog($syslevel, "$0: (%04d) $text", ++$logseq);
  } else {
    print STDERR "$0 (" . localtime() . "): $text\n";
  }
}

sub excluded($;) {
  my ($path)=@_;
  msg("Excluding $path (nonexistent)"), return 1 unless -e $path;
  msg("Excluding $path (special file)"), return 1 unless -d _ or -f _;
  msg("Excluding $path (RCS directory)"), return 1 if -d _ and basename($path) eq 'RCS';
  msg("Excluding $path (binary file)"), return 1 if -f _ and $opt_t and -s _ and -B _;
  msg("Excluding $path (regex match)"), return 1 if $opt_x and $path =~ /$opt_x/o;
  0;
}

sub chmog($$$) {
  my ($path, $mode, $serious)=@_;
  return unless $opt_u or $opt_g or $mode;
  msg sprintf "Chmog $path: mode=%s%06o user=%s group=%s",
  ($mode < 0 ? '&' : '|'), abs($mode),
  (defined $opt_u ? $opt_u : ''), (defined $opt_g ? $opt_g : '');
  my $warn_or_die=sub {
    my ($msg)=@_;
    $msg .= ": $!" if $!;
    if ($serious) {
      die $msg;
    } else {
      warn $msg;
    }
  };
  my @stat=stat $path or (&$warn_or_die("Stat $path"), return);
  if ($opt_u or $opt_g) {
    my ($user, $group)=@stat[4, 5];
    $user=$opt_u if $opt_u;
    $group=$opt_g if $opt_g;
    chown $user, $group, $path or (&$warn_or_die("Chown $user.$group $path"), return);
    $discard{$path}{change}=time;
  }
  if ($mode) {
    use integer;
    my $omode=$stat[2] & 077777;
    if ($mode > 0) {
      $omode |= $mode;
    } else {
      $omode &= ~(-$mode);
    }
    chmod $omode, $path or (&$warn_or_die(sprintf("Chmod %06o $path", $omode)), return);
    $discard{$path}{change}=time;
  }
}

sub rcsperm($;) {
  my ($file)=@_;
  chmog $file, 0200 | (defined($opt_g) ? 0020 : 0), 1;
  my ($base, $dir)=fileparse($file);
  chmog "${dir}RCS/$base,v", 0, 0;
}

sub md5($;) {
  my ($file)=@_;
  $md5->reset;
  $md5->addfile(IO::File->new($file) or die "Open $file: $?$!");
  $md5->hexdigest;
}

sub rcscommit($;) {
  my ($file)=@_;
  my $newmd5=md5 $file;
  if ($md5{$file} eq $newmd5) {
    msg "Skipping commit on $file (unchanged: $newmd5)";
    return;
  }
  msg "Committing changes to $file ($md5{$file} -> $newmd5)";
  my ($author, $message);
  if ($opt_l) {
    my $log=new IO::File "$file.log";
    if ($log) {
      my @lines=<$log>;
      if (@lines) {
	if ($lines[0] =~ /^-(.*)$/) {
	  shift @lines;
	  $author=$1;
	}
	if (@lines) {
	  $message=join '', @lines;
	}
      }
      $log=new IO::File ">$file.log";
      if ($log) {
	print $log "-$author\n" if $author;
      } else {
	warn "Clearing of $file.log failed: $!";
      }
    } else {
      msg "No log file available for $file: $!";
    }