| 1 | #!/usr/bin/perl -w |
|---|
| 2 | use strict; |
|---|
| 3 | |
|---|
| 4 | use FindBin; |
|---|
| 5 | use lib "$FindBin::RealBin/../lib"; |
|---|
| 6 | |
|---|
| 7 | use Getopt::Long; |
|---|
| 8 | use YAML; |
|---|
| 9 | use Plack::Runner; |
|---|
| 10 | use File::Pid; |
|---|
| 11 | use File::Spec::Functions qw{catfile rel2abs}; |
|---|
| 12 | use Cwd; |
|---|
| 13 | |
|---|
| 14 | GetOptions( |
|---|
| 15 | 'file=s' => \my $CONFIG_FILE, |
|---|
| 16 | 'verbose|v' => \my $VERBOSE, |
|---|
| 17 | 'D=s' => \my %DEFINES, |
|---|
| 18 | ); |
|---|
| 19 | |
|---|
| 20 | my %default_config = ( |
|---|
| 21 | server_root => cwd, |
|---|
| 22 | port => 5000, |
|---|
| 23 | access_log => 'access', |
|---|
| 24 | error_log => 'errors', |
|---|
| 25 | pid_file => 'pid', |
|---|
| 26 | ); |
|---|
| 27 | |
|---|
| 28 | my %run = ( |
|---|
| 29 | init => sub { |
|---|
| 30 | $CONFIG_FILE ||= 'server.yml'; |
|---|
| 31 | my $config = { |
|---|
| 32 | %default_config, |
|---|
| 33 | %DEFINES, |
|---|
| 34 | }; |
|---|
| 35 | print Dump($config) if $VERBOSE; |
|---|
| 36 | YAML::DumpFile($CONFIG_FILE, $config); |
|---|
| 37 | print "Wrote config to $CONFIG_FILE\n" if $VERBOSE; |
|---|
| 38 | }, |
|---|
| 39 | run => \&run_server, |
|---|
| 40 | start => \&start_server, |
|---|
| 41 | stop => sub { signal_server('QUIT') }, |
|---|
| 42 | restart => sub { signal_server('HUP') }, |
|---|
| 43 | ); |
|---|
| 44 | |
|---|
| 45 | my $command = shift or die "Usage: $0 <" . join('|', keys %run) . ">\n"; |
|---|
| 46 | |
|---|
| 47 | exists $run{$command} or die "Unrecognized command $command\n"; |
|---|
| 48 | $run{$command}->(); |
|---|
| 49 | |
|---|
| 50 | sub get_config { |
|---|
| 51 | $CONFIG_FILE ||= 'server.yml'; |
|---|
| 52 | my $config_from_file = -e $CONFIG_FILE ? YAML::LoadFile($CONFIG_FILE) : {}; |
|---|
| 53 | |
|---|
| 54 | my $config = { |
|---|
| 55 | %default_config, |
|---|
| 56 | %{ $config_from_file }, |
|---|
| 57 | %DEFINES, |
|---|
| 58 | }; |
|---|
| 59 | |
|---|
| 60 | # make config paths absolute before handing off to the app |
|---|
| 61 | for my $file_key (qw{dbname htdigest access_log error_log pid_file}) { |
|---|
| 62 | if ($config->{$file_key}) { |
|---|
| 63 | $config->{$file_key} = rel2abs($config->{$file_key}, $config->{server_root}); |
|---|
| 64 | } |
|---|
| 65 | } |
|---|
| 66 | |
|---|
| 67 | warn Dump($config) if $VERBOSE; |
|---|
| 68 | |
|---|
| 69 | return $config; |
|---|
| 70 | } |
|---|
| 71 | |
|---|
| 72 | sub run_server { |
|---|
| 73 | my $config = get_config(); |
|---|
| 74 | |
|---|
| 75 | require BookmarksApp; |
|---|
| 76 | my $app = BookmarksApp->new({ config => $config })->to_app; |
|---|
| 77 | |
|---|
| 78 | my $runner = Plack::Runner->new(server => 'Starman'); |
|---|
| 79 | $runner->parse_options( |
|---|
| 80 | '--listen', ':' . $config->{port}, |
|---|
| 81 | ); |
|---|
| 82 | $runner->run($app); |
|---|
| 83 | } |
|---|
| 84 | |
|---|
| 85 | sub start_server { |
|---|
| 86 | my $config = get_config(); |
|---|
| 87 | |
|---|
| 88 | require BookmarksApp; |
|---|
| 89 | my $app = BookmarksApp->new({ config => $config })->to_app; |
|---|
| 90 | |
|---|
| 91 | my $runner = Plack::Runner->new(server => 'Starman'); |
|---|
| 92 | $runner->parse_options( |
|---|
| 93 | '--daemonize', |
|---|
| 94 | '--listen', ':' . $config->{port}, |
|---|
| 95 | '--pid', $config->{pid_file}, |
|---|
| 96 | '--error-log', $config->{error_log}, |
|---|
| 97 | '--access-log', $config->{access_log}, |
|---|
| 98 | ); |
|---|
| 99 | $runner->run($app); |
|---|
| 100 | } |
|---|
| 101 | |
|---|
| 102 | sub signal_server { |
|---|
| 103 | my $config = get_config(); |
|---|
| 104 | my $signal = shift; |
|---|
| 105 | |
|---|
| 106 | my $pid_path = $config->{pid_file}; |
|---|
| 107 | unless (-e $pid_path) { |
|---|
| 108 | warn "$pid_path does not exist\n"; |
|---|
| 109 | return; |
|---|
| 110 | } |
|---|
| 111 | |
|---|
| 112 | my $pid_file = File::Pid->new({ |
|---|
| 113 | file => $pid_path, |
|---|
| 114 | }); |
|---|
| 115 | |
|---|
| 116 | if (my $pid = $pid_file->running) { |
|---|
| 117 | kill $signal, $pid; |
|---|
| 118 | } |
|---|
| 119 | } |
|---|