source: bookmarks/trunk/bin/bkmkd @ 119

#!/usr/bin/perl -w
use strict;

use FindBin;
use lib "$FindBin::RealBin/../lib";

use Getopt::Long;
use YAML;
use Plack::Runner;
use File::Pid;
use File::Spec::Functions qw{catfile rel2abs};
use Cwd;

GetOptions(
    'file=s'    => \my $CONFIG_FILE,
    'verbose|v' => \my $VERBOSE,
    'D=s'       => \my %DEFINES,
);

my %run = (
    run     => \&run_server,
    start   => \&start_server,
    stop    => sub { signal_server('QUIT') },
    restart => sub { signal_server('HUP') },
);

my %default_config = (
    server_root => cwd,
    port        => 5000,
    access_log  => 'access',
    error_log   => 'error',
    pid_file    => 'pid',
);

my $command = shift or die "Usage: $0 <" . join('|', keys %run) . ">\n";

exists $run{$command} or die "Unrecognized command $command\n";
$run{$command}->();

sub get_config {
    $CONFIG_FILE ||= 'server.yml';
    my $config_from_file = -e $CONFIG_FILE ? YAML::LoadFile($CONFIG_FILE) : {};

    my $config = {
        %default_config,
        %{ $config_from_file },
        %DEFINES,
    };

    # make config paths absolute before handing off to the app
    for my $file_key (qw{dbname htdigest access_log error_log pid_file}) {
        if ($config->{$file_key}) {
            $config->{$file_key} = rel2abs($config->{$file_key}, $config->{server_root});
        }
    }

    warn Dump($config) if $VERBOSE;

    return $config;
}

sub run_server {
    my $config = get_config();

    require BookmarksApp;
    my $app = BookmarksApp->new({ config => $config })->to_app;

    my $runner = Plack::Runner->new(server => 'Starman');
    $runner->parse_options(
        '--listen', ':' . $config->{port},
    );
    $runner->run($app);
}

sub start_server {
    my $config = get_config();

    require BookmarksApp;
    my $app = BookmarksApp->new({ config => $config })->to_app;

    my $runner = Plack::Runner->new(server => 'Starman');
    $runner->parse_options(
        '--daemonize',
        '--listen',     ':' . $config->{port},
        '--pid',        $config->{pid_file},
        '--error-log',  $config->{error_log},
        '--access-log', $config->{access_log},
    );
    $runner->run($app);
}

sub signal_server {
    my $config = get_config();
    my $signal = shift;

    my $pid_path = $config->{pid_file};
    unless (-e $pid_path) {
        warn "$pid_path does not exist\n";
        return;
    }

    my $pid_file = File::Pid->new({
        file => $pid_path,
    });

    if (my $pid = $pid_file->running) {
        kill $signal, $pid;
    }
}