App-Padadoy
view release on metacpan or search on metacpan
lib/App/Padadoy.pm view on Meta::CPAN
sub _provide_config {
my ($self, $caller) = @_;
return if $self->{config};
$self->{config} = cwd.'/padadoy.yml';
$self->msg(\$caller,"Writing default configuration to ".$self->{config});
# TODO: better use template with comments instead
write_file( $self->{config}, $self->_config );
}
sub checkout {
my ($self, $revision, $directory, $current) = @_;
$revision ||= 'master';
$directory ||= catdir($self->{base},$revision);
my $git_dir = $self->{repository};
fail("git repository directory not found: $git_dir") unless -d $git_dir;
$self->msg("checking out $revision to $directory");
fail("Working directory already exists: $directory")
if -e $directory;
if ( $current ) {
fail("Current working directory not found") unless -d $current;
} else {
$current = catdir($self->{base},'current');
}
mkdir $directory;
my $local = catdir( $current, 'app', 'local' );
if (-d $local) {
my $newlocal = catdir($directory,'app');
$self->msg("rsyncing $local into $newlocal");
mkdir $newlocal;
run('rsync', '-a', $local, catdir($directory,'app') );
}
$self->msg("repository is $git_dir");
my $r = Git::Repository->new(
work_tree => $directory,
git_dir => $git_dir,
);
$r->run( checkout => '-q', '-f', $revision );
}
sub cartontest {
my $self = shift;
chdir $self->{base}.'/app';
$self->msg("installing dependencies and testing");
run('carton install');
run('perl Makefile.PL');
run('carton exec -Ilib -- make test');
run('carton exec -Ilib -- make clean > /dev/null');
}
sub update {
my $self = shift;
my $revision = shift || 'master';
$self->msg("updating to revision $revision");
# check out to $newdir
$self->checkout($revision);
my $revdir = catdir($self->{base},$revision);
my $newdir = catdir($self->{base},'new');
# TODO: call directly
run('padadoy','cartontest',"base=$revdir");
chdir $self->{base};
run('rm','-f','new');
symlink $revision, 'new';
$self->msg("revision $revision checked out and tested at $newdir");
}
sub enable {
my $self = shift;
fail "Missing directory ".$self->{base} unless -d $self->{base};
chdir $self->{base};
my $new = catdir($self->{base},'new');
my $current = catdir($self->{base},'current');
fail "Missing directory $new" unless -d $new;
$self->msg("$new -> current");
run('rm','-f','current');
run('mv','new','current');
chdir $current;
# TODO: re-read full configuration (?)
$self->{base} = $current;
# graceful restart seems broken
$self->stop;
$self->start;
# TODO: cleanup old revisions?
}
sub remote {
my $self = shift;
my $command = shift;
fail 'no remote configured' unless $self->{remote};
fail 'missing remote command' unless $command;
fail "command $command not supported on remote"
unless grep { $_ eq $command } @remote_commands;
$self->{remote} =~ /^(.+):(.+)$/ or fail 'invalid remote value: '.$self->{remote};
( run in 2.032 seconds using v1.01-cache-2.11-cpan-9581c071862 )