view release on metacpan or  search on metacpan

lib/File/DirSync.pm  view on Meta::CPAN

        print "$dst: Removing tree\n" if $self->{verbose};
        $self->rmtree($dst) or warn "$dst: Failed to rmtree!\n";
      } elsif (-e $dst) {
        # Regular file (or something else) needs to go
        print "$dst: Removing\n" if $self->{verbose};
        unlink $dst or warn "$dst: Failed to purge: $!\n";
      }
      if (-l $dst || -e $dst) {
        warn "$dst: Still exists after wipe?!!!\n";
      }
      $point = $1 if $point =~ /^(.+)$/; # Taint
      # Point to the same place that $src points to
      print "$dst -> $point\n" if $self->{verbose};
      symlink $point, $dst or warn "$dst: Failed to create symlink: $!\n";
      $self->_op(5) if $self->{_gentle_percent};
      return;
    }
  }

  if ($self->{nocache} && -d _) {
    $size_dst = -1;
  }
  # Short circuit and kick out the common case:
  # Nothing to do if the timestamp and size match
  if ( defined ( $when_src && $when_dst && $size_src && $size_dst) &&
       $when_src == $when_dst && $size_src == $size_dst ) {
    push @{ $self->{_tracking}->{skipped} }, $dst if $self->{_tracking};
    return;
  }

  # Regular File Check
  if (-f _) {
    # Source is a plain file
    if (-l $dst) {
      # Dest is a symlink
      print "$dst: Removing symlink\n" if $self->{verbose};
      unlink $dst or warn "$dst: Failed to remove symlink: $!\n";
      $self->_op if $self->{_gentle_percent};
    } elsif (-d _) {
      # Wipe directory
      print "$dst: Removing tree\n" if $self->{verbose};
      $self->rmtree($dst) or warn "$dst: Failed to rmtree: $!\n";
    }
    $self->_op if $self->{_gentle_percent};
    $0 = "$self->{proctitle} - copying: $src => $dst" if $self->{proctitle};
    if ($self->copy($src, $dst)) {
      print "$dst: Updated\n" if $self->{verbose};
      push @{ $self->{_tracking}->{updated} }, $dst if $self->{_tracking};
    } else {
      warn "$dst: Failed to copy: $!\n";
    }
    if (!-e $dst) {
      warn "$dst: Never created?!!!\n";
      push @{ $self->{_tracking}->{failed} }, $dst if $self->{_tracking};
      $self->_op if $self->{_gentle_percent};
      return;
    }
    # Force permissions to match the source
    chmod( $stat_src[2] & 0777, $dst) or warn "$dst: Failed to chmod: $!\n";
    # Force user and group ownership to match the source
    chown( $stat_src[4], $stat_src[5], $dst) or warn "$dst: Failed to chown: $!\n";
    # Force timestamp to match the source.
    utime $when_src, $when_src, $dst or warn "$dst: Failed to utime: $!\n";
    $self->_op(4) if $self->{_gentle_percent};
    return;
  }

  # Missing Check
  if (!-e _) {
    # The source does not exist
    # The destination must also not exist
    print "$dst: Removing\n" if $self->{verbose};
    $0 = "$self->{proctitle} - removing: $dst" if $self->{proctitle};
    if ( $self->rmtree($dst) ) {
      push @{ $self->{_tracking}->{removed} }, $dst if $self->{_tracking};
    } else {
      push @{ $self->{_tracking}->{failed} }, $dst if $self->{_tracking};
      warn "$dst: Failed to rmtree!\n";
    }
    return;
  }

  # Finally, the recursive Directory Check
  if (-d _) {
    # Source is a directory
    if (-l $dst) {
      # Dest is a symlink
      print "$dst: Removing symlink\n" if $self->{verbose};
      unlink $dst or warn "$dst: Failed to remove symlink: $!\n";
      $self->_op if $self->{_gentle_percent};
    }
    if (-f $dst) {
      # Dest is a plain file
      # It must be wiped
      print "$dst: Removing file\n" if $self->{verbose};
      if ( unlink($dst) ) {
        push @{ $self->{_tracking}->{removed} }, $dst if $self->{_tracking};
      } else {
        push @{ $self->{_tracking}->{failed} }, $dst if $self->{_tracking};
        warn "$dst: Failed to unlink file: $!\n";
      }
      $self->_op if $self->{_gentle_percent};
    }
    if (!-d $dst) {
      if ( mkdir $dst, 0755 ) {
        push @{ $self->{_tracking}->{updated} }, $dst if $self->{_tracking};
      } else {
        push @{ $self->{_tracking}->{failed} }, $dst if $self->{_tracking};
        warn "$dst: Failed to mkdir: $!\n";
      }
      $self->_op if $self->{_gentle_percent};
    }
    -d $dst or warn "$dst: Destination directory cannot exist?\n";
    $self->_op(4) if $self->{_gentle_percent};

    # If nocache() was not specified, then it is okay
    # skip this directory if the timestamps match.
    if (!$self->{nocache}) {
      # (The directory sizes do not really matter.)
      # If the timestamps are the same, nothing to do
      # because rebuild() will ensure that the directory
      # timestamp is the most recent within its
      # entire descent.
      if ( defined ( $when_src && $when_dst) &&
           $when_src == $when_dst ) {
        push @{ $self->{_tracking}->{skipped} }, $dst if $self->{_tracking};
        return;
      }
    }

    print "$dst: Scanning...\n" if $self->{verbose};

    # I know the source is a directory.
    # I know the destination is also a directory
    # which has a different timestamp than the
    # source.  All nodes within both directories
    # must be scanned and updated accordingly.

    my ($handle, $node, %nodes);

    $handle = do { local *FH; };
    $0 = "$self->{proctitle} - src: $src" if $self->{proctitle};
    return unless opendir($handle, $src);
    while (defined ($node = readdir($handle))) {
      next if $node =~ /^\.\.?$/;
      next if $self->{ignore}->{$node};
      next if ($self->{localmode} &&
               !-l "$src/$node" &&
               -d _);
      $nodes{$node} = 1;
      $self->_op if $self->{_gentle_percent};
    }
    closedir($handle);

    $handle = do { local *FH; };
    $0 = "$self->{proctitle} - dst: $dst" if $self->{proctitle};
    return unless opendir($handle, $dst);
    while (defined ($node = readdir($handle))) {
      next if $node =~ /^\.\.?$/;
      next if $self->{ignore}->{$node};
      next if ($self->{localmode} &&
               !-l "$src/$node" &&
               -d _);
      $nodes{$node} = 1;
      $self->_op if $self->{_gentle_percent};
    }
    closedir($handle);

    $0 = "$self->{proctitle} - syncing: $src => $dst" if $self->{proctitle};
    # %nodes is now a union set of all nodes
    # in both the source and destination.
    # Recursively call myself for each node.
    foreach $node (keys %nodes) {
      $self->_dirsync("$src/$node", "$dst/$node");
    }
    # Force permissions to match the source
    chmod( $stat_src[2] & 0777, $dst) or warn "$dst: Failed to chmod: $!\n";
    # Force user and group ownership to match the source
    chown( $stat_src[4], $stat_src[5], $dst) or warn "$dst: Failed to chown: $!\n";
    # Force timestamp to match the source.
    utime $when_src, $when_src, $dst or warn "$dst: Failed to utime: $!\n";
    $self->_op(5) if $self->{_gentle_percent};
    return;
  }

  print "$src: Unimplemented weird type of file! Skipping...\n" if $self->{verbose};
}

sub only {
  my $self = shift;
  push (@{ $self->{only} }, @_);
}

sub maxskew {
  my $self = shift;
  $self->{maxskew} = shift || 0;
}

sub dst {
  my $self = shift;
  $self->{dst} = shift;
}

sub src {
  my $self = shift;
  $self->{src} = shift;
}

sub ignore {
  my $self = shift;
  $self->{ignore} ||= {};
  # Load ignore into a hash
  foreach my $node (@_) {
    $self->{ignore}->{$node} = 1;
  }
}

sub lockfile {
  my $self = shift;
  my $lockfile = shift or return;
  open (LOCK, ">$lockfile") or return;
  if (!flock(LOCK, 6)) { # (LOCK_EX | LOCK_NB)
    print "Skipping due to concurrent process already running.\n" if $self->{verbose};
    exit;
  }
}

sub verbose {
  my $self = shift;
  if (@_) {
    $self->{verbose} = shift;
  }
  return $self->{verbose};
}

sub localmode {
  my $self = shift;
  if (@_) {
    $self->{localmode} = shift;