The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package VCS::CSync::Task;

# Creates a single task

use strict;
use UNIVERSAL    'isa';
use Params::Util '_HASH';
use File::Spec   ();
use File::Flat   ();
use VCS::CSync   ();
use overload 'bool' => sub () { 1 },
             '""'   => 'dest';

use vars qw{$VERSION};
BEGIN {
	$VERSION = '0.01';
}





#####################################################################
# Constructor

sub new {
	my $class = ref $_[0] ? ref shift : shift;
	my $dest  = defined $_[0] ? shift : return undef;
	my $hash  = _HASH(shift) or return undef;

	# Some minor prep
	$dest =~ s/^\s+//;
	$dest =~ s/\s+$//;

	# Create the empty object
	my $self = bless {
		dest => $dest,
		}, $class;

	# Does the task need to be done as a specific user
	if ( $hash->{user} ) {
		unless ( defined scalar(getpwnam($hash->{user})) ) {
			# User does not exist on local system
			return error(
				"User '$hash->{user}' does not exist on this host"
				);
		}
		$self->{user} = $hash->{user};
	}

	# Get the driver for the task
	my $driver = lc $hash->{driver} or return error(
		"Missing configuration value 'driver'"
		);
	if ( $driver eq 'cvs' ) {
		return $self->cvs_init( $hash );
	} elsif ( $driver eq 'svn' ) {
		return $self->svn_init( $hash );
	}

	# Unsupported driver '$hash->{driver}'
	return error(
		"Unknown or unsupported driver '$hash->{driver}'"
		);
}

sub user   { $_[0]->{user}   }
sub dest   { $_[0]->{dest}   }
sub driver { $_[0]->{driver} }





#####################################################################
# Main Methods

sub run {
	my $self = shift;

	# Check the destination
	unless ( $self->dest_ok ) {
		return error("Task $self: Failed destination check");
	}
	unless ( $self->user_ok ) {
		return error("Task $self: Failed user check");
	}

	# Do the initial export
	unless ( $self->export ) {
		return error("Task $self: Failed to export from the repository");
	}

	# Overwrite to the destination
	unless ( $self->overwrite ) {
		return error("Task $self: Failed to move the export directory to the destination");
	}

	1;
}

sub export {
	my $self = shift;
	my $to   = $self->export_dest;

	if ( -e $to ) {
		trace( "Removing export directory '$to'" );
		File::Flat->remove( $to ) or return error(
			"Failed to remove existing export directory"
			);
	}

	if ( $self->driver eq 'cvs' ) {
		return $self->cvs_export($to);
	} elsif ( $self->driver eq 'svn' ) {
		return $self->svn_export($to);
	}

	die "VCS::CSync::Task->export called for unknown driver";
}

sub overwrite {
	my $self = shift;
	my $from = $self->export_dest;
	my $to   = $self->dest;

	# Remove the old version of the directory
	shell( "chmod -R u+w $to" ) or return '';
	File::Flat->remove( $to )
		or return error("Failed to remove existing directory '$to'" );

	# Move in the new version
	File::Flat->move( $from, $to )
		or return error("Failed to overwrite '$to' with '$from'");

	# Update the permissions to reflect the read-only nature of the files
	shell( "chmod -R a-w $to/*"  ) or return '';
	shell( "chmod -R a+rX $to" ) or return '';

	1;
}





#####################################################################
# Support Methods

# For now, only export to dests that already exist
sub dest_ok {
	my $self = shift;
	my $dest = $self->dest;
	unless ( -e $dest ) {
		return error("Destination directory '$dest' does not exist");
	}
	unless ( -d $dest ) {
		return error("A non-directory exists where expecting directory '$dest'");
	}
	unless ( (stat($dest))[4] == $< ) {
		return error("Current user does not own directory '$dest'");
	}
	return 1;
}

sub user_ok {
	my $self = shift;
	my $user = $self->{user} or return 1;
	my $uid  = getpwnam($user) or die "User '$user' does not exist";
	unless ( $< == $uid ) {
		return error("Task '$self' can only be run by user '$self->{user}'");
	}
	1;
}

# The directory to do the initial export to
sub export_dest {
	my $self = shift;
	$self->dest . '.new';
}

# Trace message.
# Pass it straight on to the main trace function
sub trace {
	# (works as function or method)
	shift if isa($_[0], __PACKAGE__);
	VCS::CSync::trace( @_ );
}

# Error message.
sub error {
	shift if isa($_[0], __PACKAGE__);
	VCS::CSync::error( @_ );
}

# Execute a shell command
sub shell {
	shift if isa($_[0], __PACKAGE__);
	VCS::CSync::shell( @_ );
}





#####################################################################
# CVS Support

sub cvs_init {
	my $self = shift;
	my $hash = _HASH(shift) or return undef;

	# They must have a CVSROOT
	$self->{cvsroot} = $hash->{cvsroot} or return error(
		"Missing configuration value 'cvsroot'"
		);

	# They must have a module
	$self->{cvspath} = $hash->{module} or return error(
		"Missing configuration value 'module'"
		);

	# They can optionally have a revision
	if ( $hash->{tag} ) {
		$self->{cvstag} = $hash->{tag};
	} else {
		$self->{cvstag} = 'HEAD';
	}

	$self->{driver} = 'cvs';

	$self;
}

sub cvs_export {
	my $self     = shift;
	my $to       = shift or die "No dir passed to ->cvs_export";
	my $CVSROOT  = $self->{cvsroot}   or die "cvsroot is missing";
	my $module   = $self->{cvspath}   or die "cvspath is missing";
	my $revision = $self->{cvstag}    or die "cvstag is missing";

	# Determine the command to execute
	my ($parent, $dir) = _split_dir( $to );
	-d $parent or die "Directory '$parent' does not exist";
	$dir or die "Do not have directory";
	my $quiet = $VCS::CSync::VERBOSE ? '-q' : '-Q';
	my $cmd   = "cd $parent; ";
	$cmd     .= "cvs -d $CVSROOT $quiet export -r $revision -d $dir $module";

	shell( $cmd, "Failed to export module '$module' to directory '$to'" ) or return undef;
	unless ( -d $to ) {
		return error("Export did not actually create directory $to");
	}

	1;
}

sub _split_dir {
	my $dir = shift;
	my @parts = File::Spec->splitdir( $dir );
	my $end = pop @parts;
	return ( File::Spec->catdir(@parts), $end );
}





#####################################################################
# Subversion Support

sub svn_init {
	my $self = shift;
	my $hash = _HASH(shift) or return undef;

	die "SVN driver is not yet implemented";

	# They must have a URL
	$self->{url} = $hash->{url} or return undef;

	$self->{driver} = 'svn';

	$self;
}

sub svn_export {
	my $self = shift;
	my $dir  = shift or die "No dir passed to ->svn_export";
	error("Export functionality for the SVN driver has not been implemented");
}

1;