The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Mail::Decency::Core::Server;


use Moose;
extends 'Mail::Decency::Core::Meta';

use version 0.74; our $VERSION = qv( "v0.1.4" );

use Data::Dumper;
use Scalar::Util qw/ weaken blessed /;

use Mail::Decency::Helper::Cache;
use Mail::Decency::Helper::Database;
use Mail::Decency::Helper::Logger;
#use POE::Component::Server::Postfix;

use YAML;


=head1 NAME

Mail::Decency::Core::Server

=head1 DESCRIPTION

Base module for all decency servers (policy, content filter, syslog parser).


=head1 CLASS ATTRIBUTES

=head2 inited Bool

Wheter the server is inited or not

=cut

has inited => ( is => 'ro', isa => 'Bool' );


=head2 inited ArrayRef[Mail::Decency::Core::Child]

List of all (enabled) modules for this server.. Will be required when called handle

=cut

has childs => (
    is      => 'rw',
    isa     => 'ArrayRef[Mail::Decency::Core::Child]',
    default => sub { [] }
 );


=head1 METHODS


=head2 init

Init class for the server

=cut

sub init {
    die "Init method has to be overwritten by server methosd\n";
}


=head2 init_postfix_server

Setup POE::Component::Server::Postfix

=cut

sub init_postfix_server {
    my ( $self ) = @_;
    
    # check server config
    die "server config missing!\n"
        unless defined $self->config->{ server } && ref( $self->config->{ server } ) eq 'HASH';
    die "set either host and port OR socket for server\n"
        if (
            ! defined $self->config->{ server }->{ host }
            && ! defined $self->config->{ server }->{ port }
            && ! defined $self->config->{ server }->{ socket }
        ) || (
            defined $self->config->{ server }->{ host }
            && defined $self->config->{ server }->{ socket }
        );
    
    return 1;
}


=head2 init_logger

Setup logger facility

=cut

sub init_logger {
    my ( $self ) = @_;
    
    # setup logger
    ( my $prefix = ref( $self ) ) =~ s/^.*:://; 
    my $logger = Mail::Decency::Helper::Logger->new(
        %{ $self->config->{ logging } },
        prefix => $prefix
    );
    $self->{ logger } = $logger;
    # $self->{ logger } = sub {
    #     $logger->log( @_ );
    # };
    
    return 1;
}


=head2 init_cache

Setup cache facility ( $self->cache )

=cut

sub init_cache {
    my ( $self ) = @_;
    
    # setup cache
    die "cache config missing!\n"
        unless defined $self->config->{ cache };
    $self->{ cache } = blessed( $self->config->{ cache } )
        ? $self->config->{ cache }
        : Mail::Decency::Helper::Cache->new( %{ $self->config->{ cache } } )
    ;
    
    return 1;
}


=head2 init_database

Initi's database

=cut

sub init_database {
    my ( $self ) = @_;
    
    # setup cache
    die "database config missing!\n"
        unless defined $self->config->{ database };
    
    if ( blessed( $self->config->{ database } ) ) {
        $self->{ database } =  $self->config->{ database };
    }
    else {
        my $type = $self->config->{ database }->{ type }
            or die "Missing type for database (main)!\n";
        
        eval {
            $self->{ database } = Mail::Decency::Helper::Database
                ->create( $type => $self->config->{ database } );
        };
        die "Cannot create main database: $@\n" if $@;
        
    }
    
    weaken( my $self_weak = $self );
    $self->database->logger( $self->logger->clone( "$self/db" ) );
}



=head2 run 

Run the server

=cut

sub run {
    die "Run method has to be overwritten my server\n";
}


=head2 gen_child

=cut

sub gen_child {
    my ( $self, $base, $name, $config_ref, $init_args_ref ) = @_;
    
    # if not hashref as config .. check wheter file
    if ( ! ref( $config_ref ) ) {
        
        # having config dir ?
        if ( ! $self->has_config_dir && defined $self->config->{ config_dir } ) {
            if ( -d $self->config->{ config_dir } ) {
                $self->config_dir( $self->config->{ config_dir } );
            }
            else {
                die "Provided config_dir '". $self->config->{ config_dir }. "' is not a directory or not readable\n";
            }
        }
        
        # having dir-name ?
        if ( ! -f $config_ref && $self->has_config_dir && -f $self->config_dir . "/$config_ref" ) {
            $config_ref = $self->config_dir . "/$config_ref";
        }
        
        # having file ..
        if ( -f $config_ref ) {
            eval {
                $config_ref = YAML::LoadFile( $config_ref );
            };
            if ( $@ ) {
                die "Error loading config file '$config_ref' for $name: $@\n";
            }
        }
        else {
            die "Sorry, cannot find config file '$config_ref' for $name. (config_dir: ". ( $self->has_config_dir ? $self->config_dir : "not set" ). ")\n"; 
        }
    }
    
    # being disabled ?
    return if $config_ref->{ disable };
    
    # weak reference to self
    weaken( my $self_weak = $self );
    
    # havin extra databas for this fellow ?
    my $database;
    if ( defined $config_ref->{ database } ) {
        my $type = $config_ref->{ database }->{ type }
            or die "Missing required 'type' for database ($name)!\n";
        eval {
            $database = Mail::Decency::Helper::Database
                ->create( $type => $config_ref->{ database } );
        };
        die "Cannot create database for $name: $@\n" if $@;
    }
    else {
        weaken( $database = $self->database );
    }
    
    # determine module base
    my $module = "$base\::$name";
    eval "use $module";
    die "Missing policy module '$name' ($module)\n" if $@;
    
    # create instance of sub module
    my $obj;
    eval {
        my $logger = $self->logger->clone( lc( $self->logger->prefix. "/$name" ) );
        
        # delegate logger if new database
        $database->logger( $logger->clone->prefix. "/db" )
            if ( defined $config_ref->{ database } );
        
        # create the object itself
        $obj = $module->new(
            name     => $name,
            config   => $config_ref,
            cache    => $self->cache,
            database => $database,
            server   => $self,
            logger   => $logger,
            %$init_args_ref
        );
        
        # check database, if can .. don't start with corrupted !
        if ( $obj->can( 'check_database' ) && ! $ENV{ NO_CHECK_DATABASE } ) {
            ( my $db_class = ref( $self->database ) ) =~ s/^.+:://;
            $obj->check_database( $obj->schema_definition )
                or die "Please create the database yourself (class: $db_class)\n";
        }
        
    };
    
    die "Error creating $name: $@\n" if $@;
    
    # add to meta list of childs
    push @{ $self->childs }, $obj;
    
    return $obj;
}


=head2 maintenance 

Call maintenance, cleanup databases.

=cut

sub maintenance {
    my ( $self ) = @_;
    
    $self->logger->info( "Running in maintenance mode" );
    
    foreach my $policy( @{ $self->childs } ) {
        $policy->maintenance() if $policy->can( 'maintenance' );
    }
    
    $self->logger->info( "Maintenance performed" );
    
    exit 0;
}


=head2 disable_logging

Disables all loggers in all modules

=cut

sub disable_logging {
    my ( $self ) = @_;
    $self->logger->disabled( 1 );
    $self->database->logger->disabled( 1 );
    foreach my $child( @{ $self->childs } ) {
        $child->logger->disabled( 1 );
        $child->database->logger->disabled( 1 );
    }
}


=head1 AUTHOR

Ulrich Kautz <uk@fortrabbit.de>

=head1 COPYRIGHT

Copyright (c) 2010 the L</AUTHOR> as listed above

=head1 LICENCSE

This library is free software and may be distributed under the same terms as perl itself.

=cut



1;