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 )