App-Padadoy

 view release on metacpan or  search on metacpan

lib/App/Padadoy.pm  view on Meta::CPAN

use strict;
use warnings;
package App::Padadoy;
{
  $App::Padadoy::VERSION = '0.125';
}
#ABSTRACT: Simply deploy PSGI applications

use 5.010;
use autodie;
use Try::Tiny;
use IPC::System::Simple qw(run capture $EXITVAL);
use File::Slurp;
use List::Util qw(max);
use File::ShareDir qw(dist_file);
use File::Path qw(make_path);
use File::Basename qw(dirname);
use File::Spec::Functions qw(catdir catfile rel2abs);
use Git::Repository;
use Sys::Hostname;
use YAML::Any qw(LoadFile Dump);
use Cwd;

# required for deployment
use Plack::Handler::Starman qw();
use Carton qw(0.9.4);

# required for testing
use Plack::Test qw();
use HTTP::Request::Common qw();

our @commands = qw(init start stop restart config status create checkout
        deplist cartontest remote version update enable logs);
our @remote_commands = qw(init start stop restart config status version); # TODO: create deplist checkout cartontest
our @configs = qw(user base repository port pidfile quiet remote);

# _msg( $fh, [\$caller], $msg [@args] )
sub _msg (@) { 
    my $fh = shift;
    my $caller = ref($_[0]) ? ${(shift)} :
            ((caller(2))[3] =~ /^App::Padadoy::(.+)/ ? $1 : '');
    my $text  = shift;
    say $fh (($caller ? "[$caller] " : "") 
        . (@_ ? sprintf($text, @_) : $text));
}

sub fail (@) {
    _msg(*STDERR, @_);
    exit 1;
}

sub msg {
    my $self = shift;
    _msg( *STDOUT, @_ ) unless $self->{quiet};
}


sub new {
    my ($class, $config, %values) = @_;

    my $self = bless { }, $class;
    my $yaml = { };

    if ($config) {
        # $self->msg("Reading configuration from $config");
        try {
            $yaml = LoadFile( $config );
        } catch {
            fail $_;
        };
        $self->{base} = rel2abs(dirname($config));
    } else {
        $self->{base} = $values{base} // cwd;
    }

    foreach (@configs) {
        $yaml->{$_} = $values{$_} if defined $values{$_};
    }

    $self->{user}       = $yaml->{user} || getlogin || getpwuid($<);
    $self->{repository} = $yaml->{repository} || catdir($self->{base},'repository');
    $self->{port}       = $yaml->{port} || 6000;
    $self->{pidfile}    = $yaml->{pidfile} || catfile($self->{base},'starman.pid');
    $self->{remote}     = $yaml->{remote};

    # config file
    $self->{config} = $config;

    # TODO: validate config values

    fail "Invalid remote value: ".$self->{remote} 
        if $self->{remote} and $self->{remote} !~ qr{^[^@]+@[^:]+:[~/].*$};

    $self;
}


sub create {
    my $self   = shift;
    my $module = shift;

    $self->{module} = $module;
    fail("Invalid module name: $module") 

lib/App/Padadoy.pm  view on Meta::CPAN

    # .openshift/      - hooks for OpenShift (o)
    #   action_hooks/  - scripts that get run every git push (o)
}


sub deplist {
    my $self = shift;

    eval "use Perl::PrereqScanner";
    fail "Perl::PrereqScanner required" if $@;

    fail "not implemented yet";

    # TODO: dependencies should be detectable automatically
    # with Perl::PrereqScanner::App

    $self->msg("You must initialize a git repository and add remotes");
}


sub init {
    my $self = shift;
    $self->msg("Initializing environment");

    fail "Expected to run in ".$self->{base} 
        unless cwd eq $self->{base};
    fail 'Expected to run in an EMPTY base directory' 
        if grep { $_ ne $0 and $_ ne 'padadoy.yml' } <*>;

    $self->_provide_config('init');

    try { 
        my $out = capture('git', 'init', '--bare', $self->{repository});
        $self->msg(\'init',$_) for split "\n", $out;
    } catch {
        fail 'Failed to init git repository in ' . $self->{repository};
    };

    my $file = $self->{repository}.'/hooks/update';
    $self->msg("$file as executable");
    write_file($file, read_file(dist_file('App-Padadoy','update')));
    chmod 0755,$file;

    $file = $self->{repository}.'/hooks/post-receive';
    $self->msg("$file as executable");
    write_file($file, read_file(dist_file('App-Padadoy','post-receive')));
    chmod 0755,$file;

    $self->msg("logs/");
    mkdir 'logs';
 
    $self->msg("app -> current/app");
    symlink 'current/app','app';

    $self->msg("Pushing to git repository %s@%s:%s will update", 
        $self->{user}, hostname, $self->{repository});
}


sub config {
    say shift->_config;
}

sub _config {
    my $self = shift;
    Dump( { map { $_ => $self->{$_} // '' } @configs } );
}


sub restart {
    my $self = shift;

    my $pid = $self->_pid;
    if ($pid) {
        $self->msg("Gracefully restarting starman as deamon on port %d (pid in %s)",
            $self->{port}, $self->{pidfile});
        run('kill','-HUP',$pid);
    } else {
        $self->start;
    }
}


sub start {
    my $self = shift;

    fail "No configuration file found" unless $self->{config};

    chdir $self->{base}.'/app';


if (0) { # FIXME
    # check whether dependencies are satisfied
    my @out = split "\n", capture('carton check --nocolor 2>&1');
    if (@out > 1) { # carton check always seems to exit with zero (?!)
        $out[0] = 
        _msg( *STDERR, \'start', $_) for @out;
        exit 1;
    }
}

    # make sure log files exist
    my $logs = catdir($self->{base},'logs');
    make_path($logs) unless -d $logs;

    foreach ( grep { ! -e $_ } 
              map { catfile($logs,$_) } qw(error.log access.log) ) {
        open (my $fh, '>>', $_); 
        close $fh;
    }

    $self->msg("Starting starman as deamon on port %d (pid in %s)",
        $self->{port}, $self->{pidfile});

    # TODO: refactor after release of carton 1.0
    $ENV{PLACK_ENV} = 'production';
    my @opt = (
        'starman','--port' => $self->{port},
        '-D','--pid'   => $self->{pidfile},
        '--error-log'  => catfile($logs,'error.log'),
        '--access-log' => catfile($logs,'access.log'),

lib/App/Padadoy.pm  view on Meta::CPAN

    $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};
    my ($userhost,$dir) = ($1,$2);
    fail 'remote directory should not contain spaces' if $dir =~ /\s/;

    $self->msg("running padadoy on ".$self->{remote});

    run('ssh',$userhost,"cd $dir && padadoy $command ".join ' ', @_);
}


sub logs {
    my $self = shift;
    my $logs = catdir($self->{base},'logs');
    run('tail','-F', map { catfile($logs,$_) } qw(error.log access.log));
}


sub version {
    say 'This is padadoy version '.($App::Padadoy::VERSION || '??');
    exit;
}

1;


__END__
=pod

=head1 NAME

App::Padadoy - Simply deploy PSGI applications

=head1 VERSION

version 0.125

=head1 SYNOPSIS

Create a new application and start it locally on your development machine:

  $ padadoy create Your::Module
  $ plackup app/app.psgi

Start application locally as deamon with bundled dependencies:

  $ padadoy cartontest
  $ padadoy start

Show status of your running application and stop it:

  $ padadoy status
  $ padadoy stop

Manage your application files in a git repository:

  $ git add *
  $ git commit -m "inial commit"

Deploy the application at dotCloud

  $ dotcloud create nameoryourapp
  $ dotcloud push nameofyourapp

Prepare your own deployment machine (as C<remote> in C<padadoy.yml>):

  $ padadoy remote init

Add your deployment machine as git remote and deploy:

  $ git remote add prod ...
  $ git push prod master

=head1 DESCRIPTION

I<This is an early preview release, be warned! Design changes are likely,
at least until a stable carton 1.0 has been released!>

L<Padadoy|padadoy> is a command line application to facilitate deployment of
L<PSGI> applications, inspired by L<http://dotcloud.com>. Padadoy is based on