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;