view release on metacpan or  search on metacpan

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

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 {
        $self->msg('app/app.psgi');
        write_file('app/app.psgi',{no_clobber => 1},
            read_file(dist_file('App-Padadoy','app1.psgi')));

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