starman results from the CPAN

starman

App-Padadoy

view release on metacpan or search on metacpan


# 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") 
        if $module and $module !~ /^([a-z][a-z0-9]*(::[a-z][a-z0-9]*)*)$/i;

    $self->_provide_config('create');

    $self->msg('Using base directory '.$self->{base});
    chdir $self->{base};

    $self->msg('app/');
    mkdir 'app';

    $self->msg('app/Makefile.PL');
    write_file('app/Makefile.PL',{no_clobber => 1},
        read_file(dist_file('App-Padadoy','Makefile.PL')));

    if ( $module ) {
        $self->msg("app/app.psgi (calling $module)");
        my $content = read_file(dist_file('App-Padadoy','app2.psgi'));
        $content =~ s/YOUR_MODULE/$module/mg;
        write_file('app/app.psgi',{no_clobber => 1},$content);

        my @parts = ('app', 'lib', split('::', $module));
        my $name = pop @parts;

        my $path = join '/', @parts;
        $self->msg("$path/");
        make_path ($path);

        $self->msg("$path/$name.pm");
        $content = read_file(dist_file('App-Padadoy','Module.pm.tpl'));
        $content =~ s/YOUR_MODULE/$module/mg;
        write_file( "$path/$name.pm", {no_clobber => 1}, $content );

        $self->msg('app/t/');
        make_path('app/t');

        $self->msg('app/t/basic.t');
        my $test = read_file(dist_file('App-Padadoy','basic.t'));
        $test =~ s/YOUR_MODULE/$module/mg;
        write_file('app/t/basic.t',{no_clobber => 1},$test);
    } else {

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

    # 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'),
    );
    run('carton','exec','-Ilib','--',@opt);
}


sub stop {
    my $self = shift;

    my $pid = $self->_pid;
    if ( $pid ) {
        $self->msg("killing old process");
        run('kill',$pid);
    } else {
        $self->msg("no PID file found");
    }
}

sub _pid {
    my $self = shift;
    return unless $self->{pidfile} and -f $self->{pidfile};
    my $pid = read_file($self->{pidfile}) || 0;
    return ($pid =~ s/^(\d+).*$/$1/sm ? $pid : 0);
}


sub status {
    my $self = shift;

    fail "No configuration file found" unless $self->{config};
    $self->msg("Configuration from ".$self->{config});

    # PID file?
    my $pid = $self->_pid;
    if ($pid) {
        $self->msg("Process running: $pid (PID in %s)", $self->{pidfile});
    } else {
        $self->msg("PID file %s not found or broken", $self->{pidfile});
    }

    my $port = $self->{port};
    
    # something listening on the port?
    my $sock = IO::Socket::INET->new( PeerAddr => "localhost:$port" );
    $self->msg("Port is $port - " . ($sock ? "currently used" : "not used"));

    # find out whether this users owns the socket (there should be a better way!) 
    my ($command,$pid2,$user);
    my @lsof = eval { grep /LISTEN/, ( capture('lsof','-i',":$port") ) };
    if (@lsof) { 
        foreach (@lsof) { # there may be multiple processes
            my @f = split /\s+/, $_;
            ($command,$pid2,$user) = @f if !$pid2 or $f[1] < $pid2;
        }
    } else {
        $self->msg("Not listening at port $port");
    }

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


    app/
       app.psgi      - application startup script
       lib/          - local perl modules (at least the actual application)
       t/            - unit tests
       Makefile.PL   - used to determine required modules and to run tests

    deplist.txt      - a list of perl modules required to run (o)
      
    data/            - persistent data (o)

    dotcloud.yml     - basic configuration for dotCloud (o)
    
    libs -> app/lib                - symlink for OpenShift (o)
    deplist.txt -> app/deplist.txt - symlink for OpenShift (o)
    perl/index.pl                  - CGI script for OpenShift (o)

This directory layout helps to easy deploy on multiple platforms. Files and 
directories marked by C<(o)> are optional, depending on what platform you want
to deploy. Padadoy also facilitates deploying to your own servers just like
a PaaS provider.

On the deployment machine there is a directory with the following structure:

    repository/      - the bare git repository that the app is pushed to
    current -> ...   - symbolic link to the current working directory
    new -> ...       - symbolic link to the new working directory on updates
    padadoy.yml      - local configuration

You can create this layout with C<padadoy remote init>. After adding the remote
repository as git remote, you can simply deploy new versions with C<git push>.

=head1 METHODS

=head2 new ( [$configfile] [%configvalues] )

Start padadoy, optionally with some configuration (C<padadoy.yml>).

=head2 create

Create an application boilerplate.

=head2 deplist

List dependencies (not implemented yet).

=head2 init

Initialize on your deployment machine.

=head2 config

Show configuration values.

=head2 restart

Start or gracefully restart the application if running.

=head2 start

Start starman webserver with carton.

=head2 stop

Stop starman webserver.

=head2 status

Show some status information.

=head2 checkout ( [$revision], [$directory], [$current] ) 

Check out a revision to a new working directory. If no directory name is
specified, the revision name will be concatenated to the base directory.
If a current directory is specified, the C<local> directory will first be 
copied with rsync to avoid reinstallation of dependent packages with carton.

=head2 cartontest

Update dependencies with carton and run tests.

=head2 update ( [$revision] )

Checkout a revision, test it, and create a symlink called C<new> on success.

=head2 enable

This method is called as post-receive hook in the deployment repository.  It
creates (or changes) the symlink C<new> to the symlink C<current> and
restarts the application.

=head2 remote ( $command [@options] )

Run padadoy on a remote machine.

=head2 logs

Consult logfiles.

=head2 version

Show version number and exit.

=head1 DEPLOYMENT

Actually, you don't require padadoy if you only deploy at some PaaS provider, but
deployment at dotCloud and OpenShift is also documented below for convenience.

=head2 On your own server

The following should work at least with a fresh Ubuntu installation and Perl >=
5.10.  First you need to install git, a build toolchain, and cpanminus:

  $ sudo apt-get install git-core build-essential lbssl-dev
  $ wget -O - http://cpanmin.us | sudo perl - --self-upgrade

Now you can install padadoy from CPAN:

  $ sudo cpanm App::Padadoy

Depending on the Perl modules your application requires, you may need some
additional packages, such as C<libexpat1-dev> for XML. For instance for HTTPS 
you need L<LWP::Protocol::https> that requires C<libnet-ssleay-perl> to build:

  $ sudo apt-get install libnet-ssleay-perl

( run in 0.525 second using v1.01-cache-2.11-cpan-e93a5daba3e )