view release on metacpan or  search on metacpan

lib/CfgTie/filever.pm  view on Meta::CPAN

=item C<RollSep>

Controls the separator between the file name and the backup number.
I<[Default: >C<~>I<]>

=back

=head2 C<RCS_path (>I<RCSObj>,I<path>C<)>

For the given RCS object, this sets the working directory and the file.

=head2 find_by_user

This function attempts to locate all of the files in the system that are owned
by the specified users.  It takes the following parameters:

=over 1

=item C<Base>

C<Base> can be a string to the base path or a reference to a list of base
paths to search.

=back

Return Value:

=over 1

=item C<undef> if there was an error

=item otherwise the list of file that matched

=back

=head1 Author

Randall Maas (L<randym@acm.org>, L<http://www.hamline.edu/~rcmaas/>)

=cut

my $RollDepth = 4;
my $RollSep = '~';

sub Rotate
{
   my($Old, $New) =  @_;
   if (!defined $Old) {die "Rotate: old not defined, but $New is!\n";}
   if ($Old eq $New) {return;}

   my @S =stat $Old;
   #If the old file does exist we need to do a bit of work (we use stat
   #since the other bits of information are relevant too)
   if (scalar @S)
     {
        #Migrate us to some backup copies, use one more than default so we
        #can unroll
        &Roll($Old,$RollDepth+1);

        # Modify the permissions of the new file to match that of the old one.
        if (!chmod($S[2], $New) ||

        # Modify the ownership of the new file to match that of the old one.
            !chown($S[4], $S[5], $New)||

            !rename($New, $Old))
          {
             die "bad things happened: $New doesn't exist? $!\n";
             &Unroll($Old,$RollDepth+1);
             return -1;
          }
     }
    else
     {
        rename ($New,$Old) || return -1;
     }
    0;
}


sub Roll
{
   my ($File,$Num,$Sep) =@_;
   if (!defined $File) {die "File not defined!\n";}
   if (!defined $Sep) {$Sep = $RollSep;}
   if (!defined $Num) {$Num = $RollDepth;}

   if ($Num < 1) {return;}

   my $Base = $File.$Sep;
   for (my $I=$Num-1; $I; $I--)
    {rename $Base.$I,$Base.($I+1);}

   link $File, $Base."1";
   #rename $File, $Base."1";
}

sub Unroll
{
  my ($File,$Num,$Sep) =@_;
  if (!defined $Sep) {$Sep = $RollSep;}
  if (!defined $Num) {$Num = $RollDepth;}

  if ($Num < 1) {return;}

  my $Base = $File.$Sep;
  rename $Base.'1',$File;
  for (my $I=1; $I < $RollDepth; $I++)
   {rename $Base.($I+1),$Base.$I;}
}

sub RCS_path($$)
{
   my ($RCSObj, $Path) = @_;
   if ($Path =~ /^(.+)\/([^\/]+)$/)
     {
        $RCSObj->workdir($1);
        $RCSObj->file($2);

        #Make the working directory and archive directory make sense
        my $t = $RCSObj->rcsdir;