#!/usr/bin/perl

use strict;
use Cwd;
use File::Basename;


scandir('.');

########################################
sub scandir {

  # Used before svn commit
  # Sets up the properties for uid, gid, mode, symlinks

  my ($currentdir) = @_;

  # $d is a directory handle
  opendir(my $d,$currentdir) or die "$currentdir: $!";

  # First thing to do is to determine what we are going to ignore
  my @getignores = ("/usr/bin/svn propget svn:ignore","$currentdir");
  my @ignorelist = `@getignores`;
  # Need to make this into a list and discard the last newline
  chomp @ignorelist;

  # Comes out like this:
  #<testfile
  # nextfile
  #
  #>
  # Comes out like this:
  #<testfile nextfile >
  # Need to get rid of that last space?

  my %ignore;
  $ignore{$_} = undef foreach(@ignorelist);

  print "\n";
  print "current dir: $currentdir\n";

  # Gather up the contents but neither . nor ..
  # I also want to *not* match items that are in @ignorelist
  # . and .. and anything in ignorelist
  my @contents =
    grep { !m/^\.\.?$/ } readdir $d;

  # symlink_list must include things that are ignored as symlinks are ignored:
  my @symlink_list =
    grep { -l "$currentdir/$_" } @contents;

  # the list of directories to process should not include:
  # things that are ignored
  # .svn directories
  # .. nor . directories
  my @directory_list =
    grep { -d "$currentdir/$_"
	     && ! -l "$currentdir/$_"
	       && !/\.svn$/
		 && not exists $ignore{$_} } @contents;

  # The list of files to process shouldn't contain items listed in the ignores
  my @file_list =
    grep { -f "$currentdir/$_"
	     && ! -l "$currentdir/$_"
	       && not exists $ignore{$_} } @contents;

  my @device_list =
    grep { ( -c "$currentdir/$_" || -b "$currentdir/$_" ) && ! -l "$currentdir/$_" } @contents;

  ########################################
  # Note passing references
  dodevices( $currentdir, \@device_list, \%ignore ) if @device_list;

  ########################################
  # Note passing references
  dosymlinks( $currentdir, \@symlink_list, \%ignore ) if @symlink_list;

  ########################################

  dodirectories( $currentdir, @directory_list) if @directory_list;

  ########################################

  dofiles( $currentdir, @file_list) if @file_list;

  ########################################
  # Recursive call
  # directory_list doesn't contain any .. . or .svn
  foreach my $sub (@directory_list) {
    scandir ("$currentdir/$sub");
  }
}
# End scandir

########################################
sub dosymlinks {
  ########################################
  # Argument processing
  my ($currentdir, $symlinkref, $ignoreref) = @_;
  # Since I wanted both an array and a hash as arguments to this subroutine,
  # I use references
  my @symlinks    = @$symlinkref;
  my %old_ignores = %$ignoreref;
  ########################################
#  print "Symlinks = ", ( join(":", @symlinks), "\n");
  ########################################
  # Get the current symlink list
  my @old_symlinks    = `svn propget dir:symlinks $currentdir`;
  chomp @old_symlinks;
  # Process old_symlinks to remove the "-> target" component
  map  { chomp; s/\s->\s+.+$// } @old_symlinks;
  # differences = old_ignore_list - old_symlinks;
  my %old_symlinks;
  $old_symlinks{$_} = undef foreach(@old_symlinks);
  my @differences = grep { not exists $old_symlinks{$_} } %old_ignores;
  # print "Non-symlink ignores = ",  ( join(":", @differences ), "\n");
  # Preprocessing is done and we have extracted the non-symlink ignores
  ########################################
  # We create an svn:ignore property from the list of symlinks
  # and add the old list of ignores as not all of these might be symlinks
  my $ignores = join("\n", @differences) . "\n" . join("\n", @symlinks) . "\n";
  # Set the property
  my @set_ignore_prop  =
    ("svn", "propset", "svn:ignore", $ignores, $currentdir);
  system(@set_ignore_prop) == 0
    or die "problem setting svn:ignore property on $currentdir: $!\n";
  # svn:ignore property set
  ########################################
  my $symlinks  = "";
  foreach my $symlink (@symlinks) {
    # Find the target of the symlink;
    my $target = readlink "$currentdir/$symlink";
#    print "Target = <$target>\n";
    # Create a string with embedded newlines for the property.
    # Note that the format of the dir:symlink property is the same as that
    # of the cfengine links specification

    # Lose the . off the front of $thisfile
    my $preened_currentdir = $currentdir;
    # $currentdir is either . or a path
    # If its a . then we just drop it
    # if its a path we strip the leading ./
    #if     ( ) { } elsif ( ) { } else { }
#    print "Currentdir = <$currentdir>\n";
    if ( $preened_currentdir eq '.' ) {
#      print "Current dir is a dot\n";
      $preened_currentdir = "";
    } else {
#      print "Current dir is a path\n";
      $preened_currentdir =~ s|^\./?(.+)$|$1/|;
    }

    $symlinks .= "$symlink -> $target\n";
    #print "New symlink = </${target_path}${preened_currentdir}${symlink} -> $target>\n";

  }
  my @set_symlink_prop =
    ("svn", "propset", "dir:symlinks", $symlinks, $currentdir);
  system(@set_symlink_prop) == 0
    or die "problem setting dir:symlinks property on $currentdir: $!";
  # dir:symlinks property set.
}
# End dosymlinks

########################################
sub dofiles {
  my ( $currentdir, @files) = @_;
  ########################################
#  print "Files:\n", ( join("\n", @files), "\n");
  ########################################
  foreach my $file (@files) {
    # If this file isn't under subversion control, then svn status will return
    # ?      $currentdir/$file
    # so we just skip if this matches a ? at the start of a line:
    # I discovered that some file patterns are automagically ignored by svn
    # but don't get listed in svn:ignore so I still have to check whether
    # svn ignores it or doesn't know about it
    next if grep { m/^(\?|I).+$/ } (`svn status $currentdir/$file`);
    ########################################
    # set properties for files
    # get the mode, get the uid, get the gid
    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks)
      = stat "$currentdir/$file";

    # Unfortunately perl adds the filetype info to its mode string, discard it:
    $mode &= 07777;
    # Also, perl likes mode to be in decimal. We want an octal representation:
    my $octmode = sprintf "%lo", $mode;
    # print "Octal mode of $file = $octmode\n";
    # massage the filename to add path information
    my $workingfile = $currentdir . "/" . $file;
    my @set_mode_prop = ("svn", "propset", "file:mode", $octmode, $workingfile);
    system(@set_mode_prop) == 0
      or die "problem setting file:mode property on $workingfile: $!";
    my @set_uid_prop  = ("svn", "propset", "file:uid", $uid, $workingfile);
    system(@set_uid_prop) == 0
      or die "problem setting file:uid property on $workingfile: $!";
    my @set_gid_prop  = ("svn", "propset", "file:gid", $gid, $workingfile);
    system(@set_gid_prop) == 0
      or die "problem setting file:gid property on $workingfile: $!";
    # svn properties for file:mode, file:uid, file:gid are all set
    ########################################
  }
}
# End dofiles

########################################
sub dodirectories{
  my ($currentdir, @directories) = @_;
  ########################################
#  print "Dirs:\n", ( join("\n", @directories), "\n");
  ########################################
  foreach my $directory (@directories) {
    ########################################
    # If this directory isn't under subversion control,
    # then svn status will return
    # ?      $currentdir/$dir
    # so we just skip if this matches a ? at the start of a line:
    # I discovered that some file patterns are automagically ignored by svn
    # but don't get listed in svn:ignore so I still have to check whether
    # svn ignores it or doesn't know about it
    next if grep { m/^(\?|I).+$/ } (`svn status $currentdir/$directory`);
    ########################################
    # set properties for directories
    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks)
      = stat "$currentdir/$directory";

    # Unfortunately perl adds the filetype info to its mode string, discard it:
    $mode &= 07777;
    # Also, perl likes mode to be in decimal. We want an octal representation:
    my $octmode = sprintf "%lo", $mode;
    # massage the name to add path information
    my $workingdir = $currentdir . "/" . $directory;

    my @set_mode_prop = ("svn", "propset", "dir:mode", $octmode, $workingdir);
    system(@set_mode_prop) == 0
      or die "problem setting dir:mode property $octmode on $workingdir: $!";

    my @set_uid_prop = ("svn", "propset", "dir:uid", $uid, $workingdir);
    system(@set_uid_prop) == 0
      or die "problem setting dir:uid property on $workingdir: $!";

    my @set_gid_prop = ("svn", "propset", "dir:gid", $gid, $workingdir);
    system(@set_gid_prop) == 0
      or die "problem setting dir:gid property on $workingdir: $!";
    # svn properties for dir:mode, dir:uid, dir:gid are all set
    ########################################
  }
}
# End dodirs

sub dodevices{
  print "doing devices\n";
  ########################################
  # Argument processing
  my ($currentdir, $deviceref, $ignoreref) = @_;
  # Since I wanted both an array and a hash as arguments to this subroutine,
  # I use references
  my @devices    = @$deviceref;
  my %old_ignores = %$ignoreref;
  ########################################
  print "Devices = ", ( join(":", @devices), "\n");
  ########################################
  # Get the current symlink list
  my @old_devices    = `svn propget dir:devices $currentdir`;
  chomp @old_devices;
  # Process old_symlinks to remove the "-> target" component
  map  { chomp; s/\s->\s+.+$// } @old_devices;
  # differences = old_ignore_list - old_symlinks;
  my %old_devices;
  $old_devices{$_} = undef foreach(@old_devices);
  my @differences = grep { not exists $old_devices{$_} } %old_ignores;
  print "Non-device ignores = ",  ( join(":", @differences ), "\n");
  # Preprocessing is done and we have extracted the non-symlink ignores
  ########################################
  # We create an svn:ignore property from the list of symlinks
  # and add the old list of ignores as not all of these might be symlinks
  my $ignores = join("\n", @differences) . "\n" . join("\n", @devices) . "\n";
  # Set the property
  my @set_ignore_prop  =
    ("svn", "propset", "svn:ignore", $ignores, $currentdir);
  system(@set_ignore_prop) == 0
    or die "problem setting svn:ignore property on $currentdir: $!";
  # svn:ignore property set
  ########################################
  my $devices  = "";
  foreach my $device (@devices) {

    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks)
      = stat "$currentdir/$device";

    # rdev is (major number * 256) + minor number
    # need integer division for now
    use integer;
    my ($major,$minor) = ( $rdev / 256 , $rdev % 256 );
    # not any more
    no integer;

    # Unfortunately perl adds the filetype info to its mode string, discard it:
    $mode &= 07777;
    # Also, perl likes mode to be in decimal. We want an octal representation:
    my $octmode = sprintf "%lo", $mode;

    my $device_type;
    if ( -b "$currentdir/$device" ){
      $device_type = "b"
    } elsif ( -c "$currentdir/$device" ) {
      $device_type = "c"
    }

    $devices .= "$device $device_type $major $minor -m $octmode\n";
    print "New device = <$device $device_type $major $minor -m $octmode>\n";
  }
  my @set_device_prop =
    ("svn", "propset", "dir:devices", $devices, $currentdir);
  system(@set_device_prop) == 0
    or die "problem setting dir:devices property on $currentdir: $!";
  # dir:symlinks property set.

}
# End dodevices


