dancerctl

#!/usr/bin/env perl
#
# dancerctl - like apachectl for perl/Dancer apps
#
# Copyright (c) 2011, Nick Knutov, nick@knutov.com
# https://github.com/knutov/dancerctl
#
# License: BSD 2-Clause License (http://en.wikipedia.org/wiki/BSD_licenses)
#
our $VERSION = '0.04';

use 5.10.1;
use feature 'switch';
use feature 'say';
use strict;
# no strict 'refs';
# use Getopt::Std;
use Config::Auto;
use Data::Dumper;

my $global = $ENV{DANCERCTL_CONF} || '/etc/dancerctl.conf';  # better should be 644


# load defaults
# FIXME: it assumes now that all users are in /home/
my $default = Config::Auto::parse($global, format => "yaml") if -f $global;

$default->{conf}      ||= '.dancerctl'; # default ~user/.dancerctl/appname
                                        # TODO: or, if not exists, 
                                        #       ~user/.dancerctl as one config 
                                        #       for all apps 
$default->{workers}   ||= 2;            # default number of workers
$default->{host}      ||= 'localhost';  # default host to bind (localhost, ip or *)
$default->{port}      ||= '3000';       # default port
$default->{sockets}   ||= '';           # socket path (start from user dir or absolute or relative to app path)
$default->{pids}      ||= '';           # pid path (start from user dir or absolute or relative to app path)
$default->{users}     ||= '';           # TODO: enabled users for dancerctl, comma and/or space separated. 
                                        #       blank means all users are enabled
$default->{server}    ||= 'Starman';
$default->{env}       ||= 'production'; # default environment
$default->{path}      ||= 'apps/';      # relative to $home prefix to path with all apps
$default->{method}    ||= 'port';
$default->{autoall}   ||= 1;            # auto _all action if no app specified
$default->{autostart} ||= undef;        # autostart is enabled for all apps by default if enabled
$default->{debug}     ||= undef;
$default->{chmod}     ||= '0666';       # default chmod for socket (and pid file?)
# $default->{daemon}    ||= 1;            # should be plackup daemonized(-D)? Default: yes

my $debug = $default->{debug}; $debug = $ENV{DANCERCTL_DEBUG} if $ENV{DANCERCTL_DEBUG};


my $root = $< == 0; # true if user is root
my $argc = scalar(@ARGV);
my ($home,$user,$action,$app,$env);
($user,$action,$app,$env) = @ARGV if $root and $argc == 4;
($user,$action,$app,    ) = @ARGV if $root and $argc == 3;
($user,$action,         ) = @ARGV if $root and $argc == 2;
(      $action          ) = @ARGV if $root and $argc == 1;
($action,$app,$env) = @ARGV if not $root and $argc >= 3;
($action,$app     ) = @ARGV if not $root and $argc == 2;
($action          ) = @ARGV if not $root and $argc == 1;
$user   ||= $ENV{USER};
# $action ||= @ARGV[0];
$action ||= 'help';
$home     = $ENV{HOME};

# autodetect positions - you can use 'start app' and 'app start' now.
if ( $action and $app and 
	$action !~ /^start|stop|restart|status$/ and 
	$app    =~ /^start|stop|restart|status$/ 
) {
	my $tmp = $action;
	$action = $app;
	$app    = $tmp;
}

# checking list of known actions
unless ( $action =~ /^[start|stop|restart|status]{1}[all]{0,1}|help|init$/ ) {
	help();
	say "\nError: unknown action: $action\n";
	exit;
}

if ( $debug ) {
	say 'Root?......: '.$root;
	say 'Home.......: '.$home;
	say 'User.......: '.$user;
	say 'App........: '.$app;
	say 'Action.....: '.$action;
	say 'Environment: '.$env;
}

help()                     if $action eq 'help';
# shift @ARGV && init(@ARGV) if $action eq 'init';

# FIXME: no root for now

$action = 'statusall' if not $app and $action eq 'status' and $default->{autoall};

if ( $app ) {
	start($user,$home,$app,$env)   if $action eq 'start';
	stop($user,$home,$app,$env)    if $action eq 'stop';
	status($user,$home,$app,$env)  if $action eq 'status';
	restart($user,$home,$app,$env) if $action eq 'restart';
	init($user,$home,$app,$env)    if $action eq 'init'; # env is path here
} else {
	start_all($user)   if $action eq 'startall';
	stop_all($user)    if $action eq 'stopall'  ;
	status_all($user)  if $action eq 'statusall' ;
	restart_all($user) if $action eq 'restartall' ;
}
#===============================================================================
# init will create default recommended config
# format:  dancerctl init $appname $path [force]
# note:    path counted from user dir: app -> /home/user/app
#          when 'force' the config file will be overwritten if exists.
# example 1: 
#   dancerctl init app projects/app
# example 2: 
#   cd path/to/app
#   dancerctl init app `pwd`  
sub init {
	my($user,$home,$app,$path) = @_;
	$path =~ s#^$home\/##;

	my $confdir = $home.'/'.$default->{conf};
	system("mkdir -p ".$confdir) unless -d $confdir;
	
	my $conf = $confdir.'/'.$app;
	say "Config for '$app' already exists. Please remove $conf first." and exit(-1)
		if -f $conf and not $ARGV[3] eq 'force';
	say "Config for '$app' already exists. If will be overwritten."
		if -f $conf and $ARGV[3] eq 'force';

	use YAML::Tiny;
	my $p; while (<DATA>) { $p .= $_ }
	my $yaml = YAML::Tiny->read_string($p);
	$yaml->[0] = $default->{recommended} if $default->{recommended};
	$yaml->[0]->{path} = $path;
	$yaml->write($conf);
	
	# TODO: find the way to keep key order. SortKeys = 0 does not help.
	# use YAML;
	# local $YAML::SortKeys = 0;
	# my $p; while (<DATA>) { $p .= $_ }
	# my $yaml = Load($p);
	# $yaml = $default->{recommended} if $default->{recommended};
	# $yaml->{path} = $path;
	# YAML::DumpFile($conf, $yaml);
	
	say "Config for '$app' successfully written, please edit $conf (and change port) before first run."	
}
#===============================================================================
# starts all apps of user with default environment
sub start_all {
	my $user = shift;
	my @apps = get_user_apps($user);

	foreach my $f ( @apps ) {
		my $p = $home.'/'.$default->{conf}.'/'.$f;
		my $c = Config::Auto::parse($p, format => "yaml");
		start($user,$home,$f) if $c->{autostart} or (not defined $c->{autostart} and $default->{autostart});
	}
}
#===============================================================================
# stops all apps of user
sub stop_all {
	my $user = shift;
	my @apps = get_user_apps($user);
	foreach my $f ( @apps ) {
		stop($user,$home,$f);
	}
}
#===============================================================================
# restart all apps of user, not runned apps with autostart will also be started
sub restart_all {
	my $user = shift;
	stop_all($user);
	start_all($user);
}
#===============================================================================
# status for all apps of user (for default environment)
# TODO: check for every environment
sub status_all {
	my $user = shift;
	my @apps = get_user_apps($user);
	foreach my $f ( @apps ) {
		status($user,$home,$f);
	}
}
#===============================================================================
sub get_user_apps {
	my $user = shift or return undef;
	my $path = $home.'/'.$default->{conf};
	my @files;
	my @dirs;
	opendir DIR, $path or die "$path: $!\n";
	for (readdir DIR) {
		next if /^\.\.?$/;
		push @files => $_ if -f "$path/$_";
		push @dirs => $_ if -d _;
	}
	closedir DIR;
	@files = sort @files; # each file is app
	return @files;
}
#===============================================================================
sub start {
	my ($user,$home,$app,$env) = @_;

	my ($app_path,$server,$workers,$method,$listen,$pidfile,$opt,$chmod,$daemon);
	($app_path,$env,$server,$workers,$method,$listen,$pidfile,$opt,$chmod,$daemon) = 
		parse_user_config($user,$home,$app,$env);
	
	die "Error: wrong method '$method'" unless $method =~ /^socket|port$/;
	
	my   @cmd = ();
	push @cmd, "cd $app_path && plackup";
	push @cmd, '-E',    $env;
	push @cmd, '-s',    $server;
	push @cmd, '-w',    $workers;
	push @cmd, '-l',    $listen;
	push @cmd, '--pid', $pidfile;
	
	# TODO: "--access-log $logs/$access.log"
	# TODO: "--error-log $logs/$error.log"
	# TODO: reload - reopens logs without restart
    
	push @cmd, '-a ./bin/app.pl';
	push @cmd, $opt if $opt;
	push @cmd, '&& chmod', $chmod, $listen if $method eq 'socket' and $chmod;
	
	my $cmd = join(" ", @cmd); say $cmd if $debug;
	
	my $ok = system($cmd) == 0;
	say "Application '$app' started in '$env' mode."       if $daemon and $ok;
	say "Browse at http://$listen" if $method eq 'port'   and $daemon and $ok;
	say "Listen on $listen"        if $method eq 'socket' and $daemon and $ok;
}
#===============================================================================
sub parse_user_config {
	my ($user,$home,$app,$env) = @_;
	my ($p,$c);
	$p = $home.'/'.$default->{conf}.'/'.$app if -d $home.'/'.$default->{conf};
	
	say "Error: no config $p" and
	say "You should create it first with `dancerctl init`" and exit 
		unless -f $p;
	
	$c = Config::Auto::parse($p, format => "yaml");
	
	$env    ||= $c->{env};
	$env    ||= $default->{env};
	
	$env = $c->{env_alias}->{$env} 
		if not defined $c->{$env}
			and defined $c->{env_alias}->{$env} 
			and defined $c->{$c->{env_alias}->{$env}};
	
	my $app_path  = $home.'/'; $app_path .= $c->{path} || $default->{path}.$app;
	
	my $method = $c->{$env}->{method} || $default->{method};
	my $host   = $c->{$env}->{host}   || $default->{host};
	my $port   = $c->{$env}->{port}   || $default->{port};	
	
	my @cmd = ();
	push @cmd, 'cd '.$app_path.' && ';
	push @cmd, 'plackup -E '.$env;
	my $server  = $c->{$env}->{server}  || $c->{server}  || $default->{server};
	my $workers = $c->{$env}->{workers} || $c->{workers} || $default->{workers};
	
	my $listen;
	if ( $method eq 'socket' ) {
		my $sock = $c->{$env}->{socket_path} || $c->{socket_path} || $default->{sockets};
		given ( $sock ) {
			when ( m#^\/# )  {} # absolute path
			when ( m#^~\/# ) { $sock =~ s/^~//; $sock = $home.$sock.'/' } # relative to user home
			default { $sock = $app_path.'/'.$sock}
		}
		my $socket_name = $c->{$env}->{socket_name} || $app.'.sock';
		$listen = $sock.$socket_name;
	} elsif ( $method eq 'port') {
		$listen = "$host:$port";		
	} else {
		die "Error: wrong method '$method'";
	}
	
	my $pid = $c->{$env}->{pid_path} || $c->{pid_path} || $default->{pids};
	given ( $pid ) {
		when ( m#^\/# )  {} # absolute path
		when ( m#^~\/# ) { $pid =~ s/^~//; $pid = $home.$pid } # relative to user home
		default { $pid = $app_path.'/'.$pid}
	}
	my $pid_name = $c->{$env}->{pid_name} || $app.'.pid';
	my $pidfile  = $pid.$pid_name;
	
	my $opt      = $c->{$env}->{opt};
	$opt .= ' -r -R ' . $c->{$env}->{autoreload} if $c->{$env}->{autoreload};
	
	my $daemon   = 1 unless $c->{$env}->{daemon} eq '0';
	$opt .= ' -D ' if $daemon;
	
	my $chmod    = $c->{$env}->{chmod} || $c->{chmod} || $default->{chmod};
	
	return ($app_path,$env,$server,$workers,$method,$listen,$pidfile,$opt,$chmod,$daemon);
}
#===============================================================================
sub status {
	my ($user,$home,$app,$env) = @_;

	my ($app_path,$server,$workers,$method,$listen,$pidfile,$opt);
	($app_path,$env,$server,$workers,$method,$listen,$pidfile,$opt) = parse_user_config($user,$home,$app,$env);

	# based on web_ctl.pl by Puneet Kishor, https://github.com/punkish/web_ctl
	# tested under Ubuntu 11.04
	if (-e $pidfile) {
		# open(PS_F, "ps lax | grep '[s]tarman master\|TIME COMMAND'|");
		open(PS_F, "ps lax | grep '[s]tarman master'|");

		say 'F   UID   PID  PPID PRI  NI    VSZ   RSS WCHAN  STAT TTY        TIME COMMAND';
		
		PS: while (<PS_F>) 
		{
			chomp;
			my $line = $_ = trim($_);
			# say $_;
			# F   UID   PID  PPID      PRI   NI    VSZ   RSS WCHAN  STAT TTY        TIME COMMAND
			# 1  1000  6460     1       20    0  25012 15532 poll_s Ss   ?          0:00 starman master
			my ($f, $uid, $pid, $ppid, $pri, $ni, $sz, $rss, $wchan, $s,  $tty, $time, $cmd) = split /\s+/;

			my $pid_in_file = qx{head -1 $pidfile}; #"

			if ($pid_in_file == $pid) {
				my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks) = stat($pidfile);
				say $line;
				say "\tApplication  : $app\n" . 
					"\tRunning since: " . localtime($ctime) . "\n" . 
					"\tEnvironment  : $env" ;
				say "\tBrowse at    : http://$listen" if $method eq 'port';
				say "\tListen at    : $listen" if $method eq 'socket';
				last PS;
			}
		}
		close(PS_F);
	} else {
		say "The app '$app' doesn't seem to be running in mode '$env'";
	}
}
#===============================================================================
sub stop {
	my ($user,$home,$app,$env,$force) = @_;

	my ($app_path,$server,$workers,$method,$listen,$pidfile,$opt);
	($app_path,$env,$server,$workers,$method,$listen,$pidfile,$opt) = parse_user_config($user,$home,$app,$env);

	unless (-e $pidfile) {
		say "The app '$app' doesn't seem to be running... nothing to do.";
		return undef;
	}

	my $cmd = "cat $pidfile | xargs kill"; $cmd .= " -9" if $force;
	say $cmd if $debug;
	system($cmd);
	say "Stopped $app"; # TODO: read error code from system and use it
}
#===============================================================================
sub restart {
	stop(@_);
	start(@_);
}
#===============================================================================
sub trim {
    my $string = shift;
    if ($string) {
        $string =~ s/^\s+//;
        $string =~ s/\s+$//;
        return $string;
    }
}
#===============================================================================
sub help {
	say "dancerctl version $VERSION, Copyright (c) 2011, Nick Knutov, nick\@knutov.com";
	say "Usage: dancerctl action [appname [environment]]";
	say "Please see https://github.com/knutov/dancerctl for more help";
}
__DATA__
# This can also be placed in 'recommended:' section in /etc/dancerctl.conf
env: production
autostart: 1
production:
  workers: 2
  method: socket
  chmod: 0666
development:
  workers: 1
  method: port
  host: *
  port: 3000
  pid_name: dev.pid
  autoreload: "./lib/Routes,./lib"
  daemon: 0
env_alias:
  dev: development
  prod: production