The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# ABSTRACT: Top-layer class to start a dancer app
package Dancer2::Core::Runner;
{
  $Dancer2::Core::Runner::VERSION = '0.04';
}

use Moo;
use Dancer2::Core::Types;
use Dancer2::Core::MIME;
use Carp 'croak';

use Dancer2::FileUtils;
use File::Basename;
use File::Spec;

with 'Dancer2::Core::Role::Config';


has postponed_hooks => (
    is      => 'rw',
    isa     => HashRef,
    default => sub { {} },
);


# the path to the caller script that is starting the app
# mandatory, because we use that to determine where the appdir is.
has caller => (
    is       => 'ro',
    isa      => Str,
    required => 1,
    trigger  => sub {
        my ($self, $script) = @_;
        $self->_build_location($script);
    },
);


has server => (
    is      => 'rw',
    isa     => ConsumerOf ['Dancer2::Core::Role::Server'],
    lazy    => 1,
    builder => '_build_server',
);

# when the runner is created, it has to init the server instance
# according to the configuration
sub _build_server {
    my $self         = shift;
    my $server_name  = $self->config->{apphandler};
    my $server_class = "Dancer2::Core::Server::${server_name}";

    eval "use $server_class";
    croak "Unable to load $server_class : $@" if $@;

    return $server_class->new(
        host      => $self->config->{host},
        port      => $self->config->{port},
        is_daemon => $self->config->{is_daemon},
        runner    => $self,
    );
}


has mime_type => (
    is      => 'rw',
    isa     => InstanceOf ["Dancer2::Core::MIME"],
    default => sub { Dancer2::Core::MIME->new(); },
);

sub _build_environment {
    $ENV{DANCER_ENVIRONMENT} || $ENV{PLACK_ENV} || 'development';
}


# our Config role needs a default_config hash
sub default_config {

    $ENV{PLACK_ENV}
      and $ENV{DANCER_APPHANDLER} = 'PSGI';

    my ($self) = @_;
    {   apphandler   => ($ENV{DANCER_APPHANDLER}   || 'Standalone'),
        content_type => ($ENV{DANCER_CONTENT_TYPE} || 'text/html'),
        charset      => ($ENV{DANCER_CHARSET}      || ''),
        warnings     => ($ENV{DANCER_WARNINGS}     || 0),
        traces       => ($ENV{DANCER_TRACES}       || 0),
        logger       => ($ENV{DANCER_LOGGER}       || 'console'),
        host         => ($ENV{DANCER_SERVER}       || '0.0.0.0'),
        port         => ($ENV{DANCER_PORT}         || '3000'),
        is_daemon    => ($ENV{DANCER_DAEMON}       || 0),
        appdir       => $self->location,
        import_warnings => 1,
    };
}


has location => (
    is  => 'rw',
    isa => Str,

    # make sure the path given is always absolute
    coerce => sub {
        my ($value) = @_;
        return File::Spec->rel2abs($value)
          if !File::Spec->file_name_is_absolute($value);
        return $value;
    },
);

sub _build_config_location { $_[0]->location }

sub _build_location {
    my ($self, $script) = @_;

    # default to the dir that contains the script...
    my $location = Dancer2::FileUtils::dirname($script);

    #we try to find bin and lib
    my $subdir       = $location;
    my $subdir_found = 0;

    #maximum of 10 iterations, to prevent infinite loop
    for (1 .. 10) {

        #try to find libdir and bindir to determine the root of dancer app
        my $libdir = Dancer2::FileUtils::path($subdir, 'lib');
        my $bindir = Dancer2::FileUtils::path($subdir, 'bin');

        #try to find .dancer_app file to determine the root of dancer app
        my $dancerdir = Dancer2::FileUtils::path($subdir, '.dancer');

        # if one of them is found, keep that
        if ((-d $libdir && -d $bindir) || (-f $dancerdir)) {
            $subdir_found = 1;
            last;
        }
        $subdir = Dancer2::FileUtils::path($subdir, '..');
    }

    $self->location($subdir_found ? $subdir : $location);
}


sub start {
    my ($self) = @_;
    my $server = $self->server;

    $_->finish for @{$server->apps};

    # update the server config if needed
    my $port      = $self->setting('server_port');
    my $host      = $self->setting('server_host');
    my $is_daemon = $self->setting('server_is_daemon');

    $server->port($port)           if defined $port;
    $server->host($host)           if defined $host;
    $server->is_daemon($is_daemon) if defined $is_daemon;
    $server->start;
}

# Used by 'logger' to get a name from a Runner
sub name {"runner"}

1;


#still exists?
#=method BUILD
#
#The builder initializes the proper server instance (C<Dancer2::Core::Server::*>)
#and sets the C<server> attribute to it.
#
#=method get_environment
#
#Returns the environment. Same as C<< $object->environment >>.



__END__
=pod

=head1 NAME

Dancer2::Core::Runner - Top-layer class to start a dancer app

=head1 VERSION

version 0.04

=head1 DESCRIPTION

Runs Dancer2 app.

Inherits from L<Dancer2::Core::Role::Config>.

=head2 environment

The environment string. The options, in this order, are:

=over 4

=item * C<DANCER_ENVIRONMENT>

=item * C<PLACK_ENV>

=item * C<development>

=back

=head1 ATTRIBUTES

=head2 postponed_hooks

Postponed hooks will be applied at the end, when the hookable objects are 
instantiated, not before.

=head2 caller

The path to the caller script that is starting the app.

This is required in order to determine where the appdir is.

=head2 server

A read/write attribute to that holds the proper server.

It checks for an object that consumes the L<Dancer2::Core::Role::Server> role.

=head2 mime_type

A read/write attribute that holds a L<Dancer2::Core::MIME> object.

=head2 location

Absolute path to the directory where the server started.

=head1 METHODS

=head2 default_config

It then sets up the default configuration.

=head2 start

Runs C<finish> (to set everything up) on all of the server's applications. It
then Sets up the current server and starts it by calling its C<start> method.

=head1 AUTHOR

Dancer Core Developers

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2013 by Alexis Sukrieh.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut