The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Toadfarm;

=head1 NAME

Toadfarm - One Mojolicious app to rule them all

=head1 VERSION

0.44

=head1 DESCRIPTION

Toadfarm is wrapper around L<hypnotoad|Mojo::Server::Hypnotoad> that allow
you to mount many L<Mojolicious> applications inside one hypnotoad server.

The L<Mojolicious::Plugin::Mount> plugin is useful if your applications
are hard coupled, while Toadfarm provide functionality to route requests
to a standalone application based on HTTP headers instead. This is
functionality that you expect from a reverse proxy, such as Nginx.

=head1 DOCUMENTATION INDEX

=over 4

=item * L<Toadfarm::Manual::Intro> - Introduction.

=item * L<Toadfarm::Manual::Config> - Config file format.

=item * L<Toadfarm::Manual::RunningToadfarm> - Command line options.

=item * L<Toadfarm::Manual::BehindReverseProxy> - Toadfarm behind nginx.

=item * L<Toadfarm::Manual::VirtualHost> - Virtual host setup.

=back

=head1 PLUGINS

=over 4

=item * L<Toadfarm::Plugin::AccessLog>

=item * L<Toadfarm::Plugin::Reload>

=back

=cut

use Mojo::Base 'Mojolicious';
use Mojo::Util 'class_to_path';
use File::Which;

our $VERSION = '0.44';

$ENV{MOJO_CONFIG} = $ENV{TOADFARM_CONFIG} if $ENV{TOADFARM_CONFIG};

sub startup {
  my $self = shift;
  my $config = $ENV{MOJO_CONFIG} ? $self->plugin('Config') : {};

  # remember the config when hot reloading the app
  $ENV{TOADFARM_CONFIG} = delete $ENV{MOJO_CONFIG};

  if($config->{log}{file}) {
    my $log = Mojo::Log->new;
    $log->path($config->{log}{file});
    $log->level($config->{log}{level} || 'info');
    $self->log($log);
  }

  for my $type (qw/ renderer static /) {
    my $paths = $config->{paths}{$type} or next;
    $self->$type->paths($paths);
  }

  $self->secrets([$config->{secret}]) if $config->{secret};
  $self->secrets($config->{secrets}) if $config->{secrets};
  $self->_start_apps(@{ $config->{apps} }) if $config->{apps};
  $self->_start_plugins(@{ $config->{plugins} }) if $config->{plugins};

  # need to add the root app afterwards
  if(my $app = delete $self->{root_app}) {
    $self->log->info("Mounting $app->[0] without condition");
    $self->routes->route('/')->detour(app => $app->[1]);
  }
}

sub _start_apps {
  my $self = shift;
  my $routes = $self->routes;
  my $config = $self->config;
  my $n = 0;

  if($config->{log}{combined}) {
    $self->log->info('All apps will log to ' .$config->{log}{file});
  }

  while(@_) {
    my($name, $rules) = (shift @_, shift @_);
    my $server = Mojo::Server->new;
    my $path = $name;
    my $mount_point = delete $rules->{mount_point};
    my($app, $request_base, @over, @error);

    $path = File::Which::which($path) || class_to_path($path) unless -r $path;
    $app ||= eval { $server->load_app($path) } or push @error, $@;
    $app ||= eval { $server->build_app($name) } or push @error, $@;

    if(!$app) {
      die join "\n", @error;
    }
    if($config->{log}{combined}) {
      $app->log($self->log);
    }
    if(ref $rules->{config} eq 'HASH') {
      my $local = delete $rules->{config};
      $app->config->{$_} = $local->{$_} for keys %$local;
    }

    $app->config->{$_} ||= $config->{$_} for keys %$config;

    for my $k (qw( local_port remote_address remote_port )) {
      push @over, $self->_skip_if(tx => $k, delete $rules->{$k});
    }

    for my $name (sort keys %$rules) {
      $request_base = $rules->{$name} if $name eq 'X-Request-Base';
      push @over, $self->_skip_if(header => $name, $rules->{$name});
    }

    if(@over) {
      $app->log->info("Mounting $path with conditions");
      unshift @over, "sub { my \$h = \$_[1]->req->headers;\n";
      push @over, "\$_[1]->req->url->base(Mojo::URL->new('$request_base'));" if $request_base;
      push @over, "return 1; }";
      $routes->add_condition("toadfarm_condition_$n", => eval "@over" || die "@over: $@");
      $routes->route($mount_point || '/')->detour(app => $app)->over("toadfarm_condition_$n");
    }
    elsif($mount_point) {
      $routes->route($mount_point)->detour(app => $app);
    }
    else {
      $self->{root_app} = [ $path => $app ];
    }

    $n++;
  }

  $self;
}

sub _start_plugins {
  my $self = shift;

  unshift @{ $self->plugins->namespaces }, 'Toadfarm::Plugin';

  while(@_) {
    my($plugin, $config) = (shift @_, shift @_);
    $self->log->info("Loading plugin $plugin");
    $self->plugin($plugin, $config);
  }
}

sub _skip_if {
  my($self, $type, $k, $value) = @_;
  my $format = $type eq 'tx' ? '$_[1]->tx->%s' : $type eq 'header' ? q[$h->header('%s')] : q[INVALID(%s)];

  if(!defined $value) {
    return;
  }
  elsif(ref $value eq 'Regexp') {
    return sprintf "return 0 unless +($format || '') =~ /%s/;", $k, $value;
  }
  else {
    return sprintf "return 0 unless +($format || '') eq '%s';", $k, $value;
  }
}

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2014, Jan Henning Thorsen

This program is free software, you can redistribute it and/or modify it
under the terms of the Artistic License version 2.0.

=head1 AUTHOR

Jan Henning Thorsen - C<jhthorsen@cpan.org>

=cut

1;