The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Monitoring::Spooler::Web;
$Monitoring::Spooler::Web::VERSION = '0.05';
BEGIN {
  $Monitoring::Spooler::Web::AUTHORITY = 'cpan:TEX';
}
# ABSTRACT: baseclass for any webinterface

use 5.010_000;
use mro 'c3';
use feature ':5.10';

use Moose;
use namespace::autoclean;

# use IO::Handle;
# use autodie;
# use MooseX::Params::Validate;
# use Carp;
# use English qw( -no_match_vars );
# use Try::Tiny;
use Plack::Request;

use Config::Yak;
use Log::Tree;
use Monitoring::Spooler::DB;

# extends ...
# has ...
has 'dbh' => (
    'is'      => 'ro',
    'isa'     => 'Monitoring::Spooler::DB',
    'lazy'    => 1,
    'builder' => '_init_dbh',
);

has 'config' => (
    'is'      => 'ro',
    'isa'     => 'Config::Yak',
    'lazy'    => 1,
    'builder' => '_init_config',
);

has 'logger' => (
    'is'      => 'ro',
    'isa'     => 'Log::Tree',
    'lazy'    => 1,
    'builder' => '_init_logger',
);

has '_fields' => (
    'is'        => 'ro',
    'isa'       => 'ArrayRef',
    'lazy'      => 1,
    'builder'   => '_init_fields',
);
# with ...
# initializers ...
sub _init_dbh {
    my $self = shift;

    my $DBH = Monitoring::Spooler::DB::->new({
        'config'        => $self->config(),
        'logger'        => $self->logger(),
    });

    return $DBH;
}

sub _init_fields {
    return [];
}

sub _init_config {
    my $self = shift;

    my $Config = Config::Yak::->new({
        'locations'     => [qw(conf /etc/mon-spooler)],
    });

    return $Config;
}

sub _init_logger {
    my $self = shift;

    my $Logger = Log::Tree::->new('mon-spooler-web');

    return $Logger;
}

# your code here ...
sub run {
    my $self = shift;
    my $env = shift;

    my $plack_request = Plack::Request::->new($env);
    my $request = $self->_filter_params($plack_request);

    # log request and ip
    $self->_log_request($request);

    return $self->_handle_request($request);
}

sub _filter_params {
    my $self = shift;
    my $request = shift;

    my $params = $request->parameters();

    my $request_ref = {};
    foreach my $key (@{$self->_fields()}) {
        if (defined($params->{$key})) {
            $request_ref->{$key} = $params->{$key};
        }
    }

    # add the remote_addr
    $request_ref->{'remote_addr'} = $request->address();

    # add the path
    $request_ref->{'path'} = $request->path_info;

    return $request_ref;
}

sub _handle_request {
    my $self = shift;
    my $request = shift;
    # this _must_ be implemented by subclasses

    return [
        500,
        [],
        ['Not implemented'],
    ];
}

sub _log_request {
    my $self = shift;
    my $request_ref = shift;

    my $remote_addr = $request_ref->{'remote_addr'};
    # turn key => value pairs into smth. like key1=value1,key2=value2,...
    my $args = join(',', map { $_.'='.$request_ref->{$_} } keys %{$request_ref});

    $self->logger()->log( message => 'New Request from '.$remote_addr.'. Args: '.$args, level => 'debug', );

    return 1;
}

no Moose;
__PACKAGE__->meta->make_immutable;

1;

__END__

=pod

=encoding utf-8

=head1 NAME

Monitoring::Spooler::Web - baseclass for any webinterface

=head1 ATTRIBUTES

=head2 dbh

The Database connection. Must be an instance of
Monitoring::Spooler::DB.

=head2 config

The config object. Must be an instance of
Config::Yak.

=head2 logger

The logger object. Must be an instance of
Log::Tree.

=head1 NAME

Monitoring::Spooler::Web - baseclass for any webinterface

=head1 AUTHOR

Dominik Schulz <tex@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2012 by Dominik Schulz.

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