bin/drogo - metacpan.org

#!/usr/bin/perl

eval 'exec /usr/bin/perl  -S $0 ${1+"$@"}'
    if 0; # not running under some shell

=head1 NAME

drogo - Bootstrap a Drogo application

=head1 SYNOPSIS

drogo --help

usage: drogo [ options ]
  Options:
    --help                 (displays this message)
    --create=[projectname] (creates a new drogo project)
    --dump_config          (dumps generated nginx.conf only)
    --bind=[address|all]
    --server=[server]      (default nginx)
    --apache2=[path]       (default /usr/sbin/apache2)
    --config=path/to/conf  (default conf/ngs.conf)
    --port=[port]          (default 8080)
    --access_log=[on|off]  (default on)
    --error_log=[on|off]   (default on)
    --access_log_path=/pa  (default /dev/stdout)
    --error_log_path=/pa   (default /dev/stdout)
    --ssl                  (auto enable ssl on port 9080)
    --ssl_port=[port]      (enables ssl)
    --worker_processes=[#processes]
    --worker_connections=[#connections]
    --single               (only run one worker process)
    --nginx=/usr/local/nginx/sbin/nginx
    --package=[package]    (default to dev)
  Daemon Mode:
    --daemon|--start       (default off)
    --list                 (list all active sessions)
    --prune                (cleanup all defunct sessions)
    --stop                 (stop session based on config)

=cut

use YAML;
use strict;
use Data::Dumper;
use File::Path;
use Time::HiRes 'usleep';
use Cwd;

my $tmp_dir  = "/tmp";

my %default_options = (
    config             => 'conf/ngs.conf',
    port               => 8080,
    host               => '127.0.0.1',
    bind               => '127.0.0.1',
    worker_processes   => 5,
    worker_connections => 1024,
    access_log_path    => '/dev/stdout',
    error_log_path     => '/dev/stdout',
    nginx              => '/usr/local/nginx/sbin/nginx',
    server             => 'nginx',
);

my $tmp_path = "$tmp_dir/td-$$";

my $is_daemon = 0;

$SIG{TERM} = \&cleanup;
$SIG{INT}  = \&cleanup;

# our primary dispatched sub
sub run
{
    my $self = shift;
    my $cwd  = cwd;

    $self->parse_options;

    # load yaml
    $self->load_config
        unless $self->{options}{create};

    for my $key (keys %default_options)
    {
        $self->{options}{$key} = $default_options{$key}
        unless $self->{options}{$key} or $self->{config}{$key};
    }

    return $self->help           if $self->{options}{help};
    return $self->create         if $self->{options}{create};
    return $self->list_processes if $self->{options}{list};
    return $self->prune          if $self->{options}{prune};
    return $self->stop           if $self->{options}{stop};

    # hack for --single to work
    $self->{options}{worker_processes} = 1
        if $self->{options}{single};

    # apache httpd holdover
    $self->{options}{worker_processes} = 1
        if $self->{options}{X};

    # hack for --start to work
    $self->{options}{daemon} = 1
        if $self->{options}{start};

    $self->prune
        if $self->{options}{start};

    return $self->write_nginx_config(dump => 1)
        if $self->{options}{dump_config} and
           $self->{options}{server} eq 'nginx';

    return $self->write_apache2_config(dump => 1)
        if $self->{options}{dump_config} and
           $self->{options}{server} eq 'apache2';

    if ($self->config_option('daemon'))
    {
        my $basename = (split('/', $0))[-1];
        warn "[$basename] - started as daemon\n";
        exit(0) if fork;
        $is_daemon = 1;
    }

    # reassert PID, in case we fork.
    $tmp_path = "$tmp_dir/td-$$";
    mkdir($tmp_path) unless -d $tmp_path;

    my $config_file = $self->config_file;
    my $cwd = ($config_file !~ /^\//) ? cwd : '';

    open(MT, ">$tmp_path/config.path");
    print MT "$cwd/$config_file\n";
    close(MT);

    open(MT, ">$tmp_path/td.pid");
    print MT "$$\n";
    close(MT);

    if ($self->{options}{server} eq 'nginx')
    {
        # write mime types, if needed
        $self->write_nginx_mime_types;
        $self->write_nginx_config;
        $self->start_nginx;
    }
    elsif ($self->{options}{server} eq 'apache2')
    {
        $self->write_apache2_config;
        $self->start_apache2;
    }

    # wait! (no need to take up 100% of cpu)
    while (getc()) {};
}

sub create
{
    my $self = shift;
    my $project = $self->config_option('create');

    if (not $project or $project eq '1')
    {
        die "project name required.\n";
    }

    if (-e $project)
    {
        die "directory $project already exists\n";
    }

    warn "creating directory: $project\n";
    mkdir($project);

    warn "creating directory: $project/conf\n";
    mkdir("$project/conf");

    warn "creating directory: $project/lib\n";
    mkdir("$project/lib");

    warn "creating directory: $project/lib/$project\n";
    mkdir("$project/lib/$project");

    warn "creating directory: $project/lib/$project/App\n";
    mkdir("$project/lib/$project/App");

    warn "writing: $project/app.psgi\n";
    open(X, ">$project/app.psgi");

    print X <<END;
use lib './lib';
use Drogo::Server::PSGI;
use ${project}::App;

my \$app = sub {
    my \$env = shift;

    return sub {
        my \$respond = shift;

        # create new server object
        my \$server = Drogo::Server::PSGI->new( env => \$env, respond => \$respond );

        ${project}::App->handler( server  => \$server );
    }
};

END

    close(X);

    warn "writing: $project/conf/ngs.conf\n";
    open(X, ">$project/conf/ngs.conf");
    print X qq[project: $project
access_log: off
worker_processes: 3
require_modules:
   - $project/App.pm
host: 127.0.0.1
bind: all
locations:
  - path: /
    handler: ${project}::App::handler_nginx
];
    close(X);


    warn "writing: $project/lib/$project/App.pm\n";
    open(X, ">$project/lib/$project/App.pm");
    print X <<END;
package ${project}::App;
use strict;

use Drogo::Dispatch( auto_import => 1 );

# if you do not use import_drogo_methods, all the drogo methods are
# available under the ->r method


sub handler_nginx
{
    my \$r = shift;
    require Drogo::Server::Nginx;

    my \$server_obj = Drogo::Server::Nginx->initialize(\$r);

    return __PACKAGE__->handler( server => \$server_obj );
}

sub init
{
    my \$self = shift;

    \$self->{foo} = 'bar';
}

sub bad_dispatch
{
    my \$self = shift;
    
    \$self->r->header('text/html'); # default
    \$self->r->status(404);

    \$self->r->print('bad dispatch!');
}

sub error
{
    my \$self = shift;
    
    \$self->r->header('text/html'); # default
    \$self->r->status(500);

    \$self->r->print('oh gosh');
}

sub primary :Index
{
    my \$self = shift;

    # $self->r is a shared response/requet object
    # $self->request/req gives a request object
    # $self->response/res gives a response object
    # $self->dispatcher returns drogo object
    # $self->server is a server object

    \$self->r->header('text/html'); # default
    \$self->r->status(200); # defaults to 200 anyways

    \$self->r->print('Welcome!');
    \$self->r->print(q[Go here: <a href="/moo">Mooville</a>]);
}

sub moo :Action
{
    my \$self = shift;
    \$self->r->print("Moo!");
    \$self->r->print(q[Go here: <a href="/taco/forest">Taco Forest!</a>]);
}

# referenced by /zoo/whatever
sub zoo :ActionMatch
{
    my \$self = shift;
    my \@matches = \$self->r->matches;

    \$self->r->print('Howdy: ' . \$matches[0]);
}

sub stream_this :Action
{
    my \$self = shift;

    # stop dispatcher
    \$self->dispatcher->dispatching(0);

    \$self->r->server->header_out('ETag' => 'fakeetag');
    \$self->r->server->header_out('Cache-Control' => 'public, max-age=31536000');
    \$self->r->server->send_http_header('text/html');
    \$self->r->server->print('This was directly streamed');
}

sub cleanup
{
    my \$self = shift;

    warn sprintf(
        "[%s]\t%s\t%s\\n",
        scalar localtime,
        \$self->r->remote_addr,
        \$self->r->uri,
        );
}

1;

END

    close(X);

    warn "writing: $project/lib/$project/App/taco.pm\n";
    open(X, ">$project/lib/$project/App/taco.pm");
print X <<END;
package ${project}::App::taco;
use strict;

use base '${project}::App';

sub primary_sub_here :Index
{
    my \$self = shift;

    \$self->r->print('move along');
}

sub forest :Index
{
    my \$self = shift;

    \$self->r->print("Word of day: \$self->{foo}");
}

# referenced by taco/king/rattle/snake/dance
sub beavers :ActionRegex('king/(.*)/snake/(.*)')
{
    my \$self = shift;
    my \@args = \$self->r->matches;

    \$self->r->print("roar: \$args[0], \$args[1]");
}

1;

END

    close(X);
}

sub stop
{
    my $self = shift;

    my @procs = $self->get_active_pids;
    my $config_file = $self->config_file;
    my $cwd         = ($config_file !~ /^\//) ? cwd : '';
    my $full_config = "$cwd/$config_file";

    my $killed = 0;
    for my $proc (@procs)
    {
        $full_config =~ s{//}{/};

        next unless $proc->{config_file} eq $full_config;
        kill(15, $proc->{pid});
        print "killed: [pid: $proc->{pid}] $proc->{config_file}\n";
        $killed++;
    }

    $self->prune;

    print "No active sessions.\n" unless $killed;
}

sub list_processes
{
    my $self = shift;

    my @procs = $self->get_active_pids;

    unless (@procs)
    {
        print "No active sessions.\n";
        return;
    }

    print "Active sessions:\n";
    for my $proc (@procs)
    {
        my $pid = $proc->{pid} || 'ZOMBIE';
        print "  [pid: $pid] $proc->{config_file} [$proc->{dir}]\n";
    }
}

sub get_active_pids
{
    my $self = shift;

    opendir(DIR, $tmp_dir);
    my @dirs = grep { -d "$tmp_dir/$_" and $_ =~ /^td-\d+$/ } readdir(DIR);
    closedir(DIR);

    my @pid_data;
    for my $dir (@dirs)
    {
        # is this process running?
        open (NGPID, "$tmp_dir/$dir/server.pid");
        my $pid = <NGPID>;
        close(NGPID);

        # clense
        $pid =~ s/[\n\r]//g;
        
        next unless -d "/proc/$pid";

        open(CF, "$tmp_dir/$dir/config.path");
        my $config_location = <CF>;
        close(CF);

        chomp($config_location);

        # avoid path starting with //
        $config_location =~ s{//}{/};

        push @pid_data, {
            config_file => $config_location,
            pid         => $pid,
            dir         => "$tmp_dir/$dir/",
        };
    }

    return @pid_data;
}

sub prune
{
    my $self = shift;

    opendir(DIR, $tmp_dir);
    my @dirs = grep { -d "$tmp_dir/$_" and $_ =~ /^td-\d+$/ } readdir(DIR);
    closedir(DIR);

    for my $dir (@dirs)
    {
        # is this process running?
        open (NGPID, "$tmp_dir/$dir/server.pid");
        my $pid = <NGPID>;
        close(NGPID);

        # clense
        $pid =~ s/[\n\r]//g;

        next if -d "/proc/$pid" and $pid;

        open(CF, "$tmp_dir/$dir/server.pid");
        my $server_pid = <CF>;
        close(CF);

        kill(15, $server_pid)
            if $server_pid and -d "/proc/server.pid";

        rmtree("$tmp_dir/$dir");
        print "Pruned: $tmp_dir/$dir\n";
    }
}

sub cleanup
{
    my $self   = shift;
    my $daemon = $is_daemon;

    if (-e "$tmp_path/server.pid")
    {
        open(PID, "$tmp_path/server.pid");
        my $pid = <PID>;
        close(PID);

        kill(15, $pid) if $pid;
    }

    unless ($daemon)
    {
        usleep(200000);
    }

    unlink("$tmp_path/nginx.conf");
    unlink("$tmp_path/error.log");
    unlink("$tmp_path/access.log");
    unlink("$tmp_path/mime.types");
    rmtree($tmp_path);

    if ($daemon)
    {
        exit(0);
    }
    else
    {
        die "\n\nServer stopped successfully.\n";
    }
}

sub start_nginx
{
    my $self = shift;
    my $path = $self->config_option('nginx');

    my $daemon   = $self->config_option('daemon');
    my $project  = $self->config_option('project');

    warn "Starting $project...\n\n" if $project and not $daemon;

    system($path, '-c', "$tmp_path/nginx.conf");

    my $bind     = $self->config_option('bind');
    my $ssl_port = $self->config_option('ssl_port');

    my $o_bind = $bind;
    $bind = 'localhost' if $bind eq 'all';

    unless ($daemon)
    {
        my $port    = $self->config_option('port');
        warn "Nginx is running on: http://$bind:$port/\n";
        warn "  * Running with SSL on port $ssl_port.\n" if $ssl_port;
        warn "  * Bound to all sockets.\n" if $o_bind eq 'all';
        warn "\n";
    }
}

sub start_apache2
{
    my $self = shift;
    my $path = $self->config_option('apache2');

    my $daemon   = $self->config_option('daemon');
    my $project  = $self->config_option('project');

    warn "Starting $project...\n\n" if $project and not $daemon;

    system($path, '-c', "$tmp_path/apache2.conf");

    my $bind     = $self->config_option('bind');
    my $ssl_port = $self->config_option('ssl_port');

    my $o_bind = $bind;
    $bind = 'localhost' if $bind eq 'all';

    unless ($daemon)
    {
        my $port    = $self->config_option('port');
        warn "Apache2 is running on: http://$bind:$port/\n";
        warn "  * Running with SSL on port $ssl_port.\n" if $ssl_port;
        warn "  * Bound to all sockets.\n" if $o_bind eq 'all';
        warn "\n";
    }
}


sub config_option
{
    my ($self, $key) = @_;

    my $config  = $self->{config};
    my $options = $self->{options};

    return $options->{$key} || $config->{$key} || '';
}

sub write_nginx_mime_types
{
    my $self = shift;

    return if -e ">$tmp_path/mime.types";

    my $txt = q[types {
    text/html                             html htm shtml;
    text/css                              css;
    text/xml                              xml rss;
    image/gif                             gif;
    image/jpeg                            jpeg jpg;
    application/x-javascript              js;
    application/atom+xml                  atom;

    text/mathml                           mml;
    text/plain                            txt;
    text/vnd.sun.j2me.app-descriptor      jad;
    text/vnd.wap.wml                      wml;
    text/x-component                      htc;

    image/png                             png;
    image/tiff                            tif tiff;
    image/vnd.wap.wbmp                    wbmp;
    image/x-icon                          ico;
    image/x-jng                           jng;
    image/x-ms-bmp                        bmp;
    image/svg+xml                         svg;

    application/java-archive              jar war ear;
    application/mac-binhex40              hqx;
    application/msword                    doc;
    application/pdf                       pdf;
    application/postscript                ps eps ai;
    application/rtf                       rtf;
    application/vnd.ms-excel              xls;
    application/vnd.ms-powerpoint         ppt;
    application/vnd.wap.wmlc              wmlc;
    application/vnd.wap.xhtml+xml         xhtml;
    application/x-cocoa                   cco;
    application/x-java-archive-diff       jardiff;
    application/x-java-jnlp-file          jnlp;
    application/x-makeself                run;
    application/x-perl                    pl pm;
    application/x-pilot                   prc pdb;
    application/x-rar-compressed          rar;
    application/x-redhat-package-manager  rpm;
    application/x-sea                     sea;
    application/x-shockwave-flash         swf;
    application/x-stuffit                 sit;
    application/x-tcl                     tcl tk;
    application/x-x509-ca-cert            der pem crt;
    application/x-xpinstall               xpi;
    application/zip                       zip;

    application/octet-stream              bin exe dll;
    application/octet-stream              deb;
    application/octet-stream              dmg;
    application/octet-stream              eot;
    application/octet-stream              iso img;
    application/octet-stream              msi msp msm;

    audio/midi                            mid midi kar;
    audio/mpeg                            mp3;
    audio/x-realaudio                     ra;

    video/3gpp                            3gpp 3gp;
    video/mpeg                            mpeg mpg;
    video/quicktime                       mov;
    video/x-flv                           flv;
    video/x-mng                           mng;
    video/x-ms-asf                        asx asf;
    video/x-ms-wmv                        wmv;
    video/x-msvideo                       avi;
}
];    

    open(MT, ">$tmp_path/mime.types");
    print MT $txt;
    close(MT);
}

sub base_path
{
    my $self = shift;

    return $self->config_option('root')
        if $self->config_option('root');

    my $config_file = $self->config_file;
    my $cwd         = ($config_file !~ /^\//) ? cwd : '';
    my $full_config = "$cwd/$config_file";

    my @paths = split ('/', $full_config);
    pop @paths; # rid of file name
    pop @paths if $paths[-1] eq 'conf'; # rid of config directory

    return join '/', @paths;
}

sub write_nginx_config
{
    my ($self, %params)    = @_;
    my $base_path          = $self->base_path;
    my $worker_processes   = $self->config_option('worker_processes');
    my $worker_connections = $self->config_option('worker_connections');
    my $require_module     = $self->config_option('require_module');
    my $handler            = $self->config_option('handler');
    my $app_path           = $self->config_option('app_path');

    my @lj = grep { $_ } (
        $self->config_option('bind'), $self->config_option('port')
    );

    $self->{options}{ssl_port} = $self->config_option('port') + 1000
        if $self->config_option('ssl') and not $self->config_option('ssl_port');

    # remove when bind is 'all'
    shift @lj if $self->config_option('bind') eq 'all';

    my $listen = join(':', @lj);
    my $host   = $self->config_option('host');
    my $port   = $self->config_option('port');

    my @required = @{$self->{config}{require_modules} || [ ]};
    my $perl_requires = '';
    for my $req (@required)
    {
        $perl_requires .= "perl_require $req;\n";
    }

    my $locations = '';
    my @locations = @{$self->{config}{locations} || [ ]};
    for my $location (@locations)
    {
        if ($location->{handler})
        {
            $locations .= "\n";
            $locations .= "\tlocation $location->{path} {\n";
            $locations .= "\t\tperl $location->{handler};\n";
            $locations .= "\t}\n";
        }
        else
        {
            $locations .= "\n";
            $locations .= "\tlocation $location->{path} {\n";
            $locations .= "\t\troot $base_path/$location->{root};\n";
            $locations .= "\t\tindex $location->{index};\n";
            $locations .= "\t}\n";
        }
    }            

    $locations .= $self->config_option('location_raw')
        if $self->config_option('location_raw');

    my $ssl_port = $self->config_option('ssl_port');
    my $package  = $self->config_option('package') || 'dev';
    my $set_package  = " set \$app_package \"$package\";";

    my $ssl = '';
    if ($ssl_port)
    {
        my @slj = grep { $_ } (
            $self->config_option('bind'), $self->config_option('ssl_port')
        );

        # remove when bind is 'all'
        shift @slj if $self->config_option('bind') eq 'all';

        my $ssl_listen = join(':', @slj);

        $ssl = qq|
    server {      
        listen       $ssl_listen;
        set          \$is_ssl   1;
        set          \$ssl_port $ssl_port;
        $set_package
        server_name  $host;

        error_page   404              /404.html;
        error_page   500 502 503 504  /50x.html;

        ssl                  on;
        ssl_certificate      $base_path/ssl/cert.pem;
        ssl_certificate_key  $base_path/ssl/cert.key;
        ssl_session_timeout  5m;
        ssl_protocols  SSLv2 SSLv3 TLSv1;
        ssl_ciphers  ALL:!ADH:!EXPORT56:RC4+RSA:+HIGH:+MEDIUM:+LOW:+SSLv2:+EXP;
        ssl_prefer_server_ciphers   on;
        gzip on;

        $locations
    }
|;
    }

    my $access_log_path = $self->config_option('access_log_path');
    my $error_log_path = $self->config_option('error_log_path');

    my $access_log = $self->config_option('access_log') eq 'off'
        ? 'access_log  /dev/null  main;' : "access_log  $access_log_path  main;";

    my $error_log = $self->config_option('error_log') eq 'off'
        ? 'error_log  /dev/null;' : "error_log  $error_log_path;";

    my $set_ssl_port = $ssl_port ? " set  \$ssl_port $ssl_port; " : '';

    my $template = qq|
worker_processes  $worker_processes;

pid        $tmp_path/server.pid;

$error_log

events {
    worker_connections  $worker_connections;
}                            

http {
    include       $tmp_path/mime.types;
    default_type  application/octet-stream;

    log_format  main  '[\$time_local] \$remote_addr - \$request '
                      '"\$status" \$body_bytes_sent';              

    $access_log

    sendfile           on;
    keepalive_timeout  65;

    perl_modules $base_path/lib;
    
    $perl_requires

    server {                                                                    
        listen       $listen;
        server_name  $host;
        $set_ssl_port
        $set_package
        gzip on;

        # 640kb ought to be enough for anybody.
        # - Bill Gates
        client_max_body_size 100M;

        error_page   404              /404.html;
        error_page   500 502 503 504  /50x.html;

        $locations
    }

    $ssl
}
|;

    if ($params{dump})
    {
        print $template;
    }
    else
    {
        open(CT, ">$tmp_path/nginx.conf");
        print CT $template;
        close(CT);
    }
}

sub write_apache2_config
{
    my ($self, %params)    = @_;
    my $base_path          = $self->base_path;
    my $worker_processes   = $self->config_option('worker_processes');
    my $worker_connections = $self->config_option('worker_connections');
    my $require_module     = $self->config_option('require_module');
    my $handler            = $self->config_option('handler');
    my $app_path           = $self->config_option('app_path');

    my @lj = grep { $_ } (
        $self->config_option('bind'), $self->config_option('port')
    );

    $self->{options}{ssl_port} = $self->config_option('port') + 1000
        if $self->config_option('ssl') and not $self->config_option('ssl_port');

    # remove when bind is 'all'
    shift @lj if $self->config_option('bind') eq 'all';

    my $listen = join(':', @lj);
    my $host   = $self->config_option('host');
    my $port   = $self->config_option('port');

    my @required = @{$self->{config}{require_modules} || [ ]};
    my $perl_requires = '';
    for my $req (@required)
    {
        $perl_requires .= "PerlModule $req\n";
    }

    my $locations = '';
    my @locations = @{$self->{config}{locations} || [ ]};
    for my $location (@locations)
    {
        if ($location->{handler})
        {
            $locations .= "\n";
            $locations .= "<Location $location->{path}>\n";
            $locations .= "\tSetHandler modperl\n";
            $locations .= "\tPerlResponseHandler $location->{handler}\n";
            $locations .= "</Location>\n";
        }
        else
        {

        }
    }            

    $locations .= $self->config_option('location_raw')
        if $self->config_option('location_raw');

    my $ssl_port = $self->config_option('ssl_port');
    my $package  = $self->config_option('package') || 'dev';
    my $set_package  = " set \$app_package \"$package\";";

    my $ssl = '';
    if ($ssl_port)
    {
        my @slj = grep { $_ } (
            $self->config_option('bind'), $self->config_option('ssl_port')
        );

        # remove when bind is 'all'
        shift @slj if $self->config_option('bind') eq 'all';

        my $ssl_listen = join(':', @slj);

        $ssl = qq|
        |;
    }

    my $access_log_path = $self->config_option('access_log_path');
    my $error_log_path = $self->config_option('error_log_path');

    my $access_log = $self->config_option('access_log') eq 'off'
        ? '/dev/null' : "$access_log_path";

    my $error_log = $self->config_option('error_log') eq 'off'
        ? '/dev/null' : "$error_log_path";

    my $set_ssl_port = $ssl_port ? " set  \$ssl_port $ssl_port; " : '';

    my $use_module = $self->config_option('perl_module') ||
        '/usr/lib/apache2/modules/mod_perl.so';

    my $template = qq|
LoadModule perl_module $use_module
<Perl>
use lib "$base_path/lib";
</Perl>

MaxClients $worker_processes
PidFile    $tmp_path/server.pid

ErrorLog   $error_log
Listen     $listen



$perl_requires
$locations


|;

    if ($params{dump})
    {
        print $template;
    }
    else
    {
        open(CT, ">$tmp_path/apache2.conf");
        print CT $template;
        close(CT);
    }
}


sub load_config
{
    my $self = shift;
    my $config_file = $self->config_file;

    my $str_data;
    open(CF, $config_file);
    read(CF, $str_data, -s $config_file);
    close(CF);

    my $config = Load($str_data);

    $self->{config} = $config;
}

sub config_file
{
    my $self = shift;
    my $file = $self->{options}{config} || 'conf/ngs.conf';
    if ($file)
    {
        unless (-e $file)
        {
            my $basename = (split('/', $0))[-1];

            warn "[$basename] fatal error: '$file' does not exist\n";
            $self->help;
        }
    }
    else
    {
        $self->error("You must specify a config path.");
    }

    return $file;
}

sub error
{
    my ($self, $error) = @_;
    my $basename = (split('/', $0))[-1];

    die "[$basename] fatal error: $error\n";
}

sub help
{
    my $basename = (split('/', $0))[-1];
    my $usage  = "usage: $basename [ options ]\n";
    $usage    .= "  Options:\n";
    $usage    .= "    --create=[projectname] (creates a new drogo project)\n";
    $usage    .= "    --help                 (displays this message)\n";
    $usage    .= "    --dump_config          (dumps generated nginx.conf only)\n";
    $usage    .= "    --bind=[address|all]\n";
    $usage    .= "    --server=[server]      (default nginx)\n";
    $usage    .= "    --apache2=[path]       (default /usr/sbin/apache2)\n";
    $usage    .= "    --config=path/to/conf  (default conf/ngs.conf)\n";
    $usage    .= "    --port=[port]          (default 8080)\n";
    $usage    .= "    --access_log=[on|off]  (default on)\n";
    $usage    .= "    --error_log=[on|off]   (default on)\n";
    $usage    .= "    --access_log_path=/pa  (default /dev/stdout)\n";
    $usage    .= "    --error_log_path=/pa   (default /dev/stdout)\n";
    $usage    .= "    --ssl                  (auto enable ssl on port 9080)\n";
    $usage    .= "    --ssl_port=[port]      (enables ssl)\n";
    $usage    .= "    --worker_processes=[#processes]\n";
    $usage    .= "    --worker_connections=[#connections]\n";
    $usage    .= "    --single               (only run one worker process)\n";
    $usage    .= "    --nginx=/usr/local/nginx/sbin/nginx\n";
    $usage    .= "    --package=[package]    (default to dev)\n";
    $usage    .= "  Daemon Mode:\n";
    $usage    .= "    --daemon|--start       (default off)\n";
    $usage    .= "    --list                 (list all active sessions)\n";
    $usage    .= "    --prune                (cleanup all defunct sessions)\n";
    $usage    .= "    --stop                 (stop session based on config)\n";

    die $usage;
}

# quick and dirty
sub parse_options
{
    my $self    = shift;
 
    my %options;

    my @acceptable_options = qw(
        bind      port         access_log         error_log 
        ssl       ssl_port     worker_processes   single     
        nginx     help         worker_connections config
        host      X            access_log_path    error_log_path
        daemon    list         prune              stop
        start     dump_config  package            location_raw
        server    apache2      create
    );

    for my $arg (@ARGV)
    {
        # cleanse all parameters of all unrighteousness
        #   `--` & `-` any parameter shall be removed
        $arg =~ s/^--//;
        $arg =~ s/^-//;

        # does this carry an assignment?
        if ($arg =~ /=/)
        {
            my ($key, $value) = split('=', $arg);

            $options{$key} = $value;
        }
        else
        {
            $options{$arg} = 1;
        }
    }

    for my $option (keys %options)
    {
        $self->error("`$option` is an invalid option")
            unless (grep { $_ eq $option } @acceptable_options)
    }

    $self->{options} = \%options;

    return \%options;
}

# BANG!
my $run = {}; 
bless($run);
$run->run;

=head1 COPYRIGHT

Copyright 2011, 2012 Ohio-Pennsylvania Software, LLC.

=head1 LICENSE

This library is free software. You can redistribute it and/or modify it under the same terms as Perl itself.

=cut

1;
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)