#!/usr/bin/perl

use strict;
use warnings;
use 5.010;
use lib qw/lib/;
use Urb::Dom;
use Urb::Dom::Fitness;
use File::stat;
use File::Spec;
use YAML;
use Carp;

my $sig_term = 0;
local $SIG{INT} = sub {$sig_term = 1};
local $SIG{TERM} = sub {$sig_term = 1};

my $overlay = undef;
if (-e 'occlusion.field')
{
    say STDERR 'Using occlusion overlay field';
    $overlay = Urb::Field::Occlusion->new;
    open my $YAML, '<', 'occlusion.field' or croak "$!";
    my $string = join '', (<$YAML>);
    close $YAML;
    $overlay->Deserialise ($string);
}

my $config = undef;
my $path_patterns = File::Spec->catfile (File::Spec->updir(), 'patterns.config');
if (-e $path_patterns)
{
    say STDERR 'Using project level patterns config file';
    $config = YAML::LoadFile ($path_patterns);
}
if (-e 'patterns.config')
{
    say STDERR 'Using patterns config file';
    my $config_temp = YAML::LoadFile ('patterns.config');
    for my $key (keys %{$config_temp})
    {
        $config->{$key} = $config_temp->{$key};
    }
}

my $costs = undef;
my $path_costs = File::Spec->catfile (File::Spec->updir(), 'costs.config');
if (-e $path_costs)
{
    say STDERR 'Using project level costs config file';
    $costs = YAML::LoadFile ($path_costs);
}
if (-e 'costs.config')
{
    say STDERR 'Using costs config file';
    my $costs_temp = YAML::LoadFile ('costs.config');
    for my $key (keys %{$costs_temp})
    {
        $costs->{$key} = $costs_temp->{$key};
    }
}

my $assessor = Urb::Dom::Fitness->new ($config, $costs);

my $first = 1;

for my $path_yaml (@ARGV)
{
    exit 0 if $sig_term;
    unless (-e $path_yaml)
    {
        say STDERR "File not found, skipping: $path_yaml";
        next;
    }

    my $path_score = "$path_yaml.score";
    my $path_fails = "$path_yaml.fails";

    next if (-e $path_score
         and -e $path_fails
         and (!$ENV{DEBUG})
         and (!$ENV{FORCE_UPDATE})
         and stat ($path_score)->mtime >= stat ($path_yaml)->mtime 
         and stat ($path_fails)->mtime >= stat ($path_yaml)->mtime);

    my @items = YAML::LoadFile ($path_yaml);
    next unless scalar @items;
    my $dom = Urb::Dom->new;
    $dom->Deserialise (@items);

    exit 0 if $sig_term;
    if ($first)
    {
        $assessor->{_occlusion} = $dom->Occlusion ($overlay);
        $assessor->{_occlusion}->{nocache} = 1;
    }
    undef $first;

    exit 0 if $sig_term;
    # calculate a score, print and write out a file
    my $score = sprintf ("%.40f", $assessor->_apply ($dom));

    say STDERR $score;

    unlink $path_score;
    open my $SCORE, '>', $path_score or croak "$!";
    say $SCORE $score;
    close $SCORE;

    # get list of failures generated during scoring, write to file
    my @failures = $dom->Failures;

    unlink $path_fails;
    open my $FAILS, '>', $path_fails or croak "$!";
    say $FAILS join "\n", @failures;
    close $FAILS;
    $dom->DESTROY;
}

0;

__END__

=head1 NAME

urb-fitness - score members of a population

=head1 SYNOPSIS

urb-fitness.pl <dom1.dom> <dom2.dom> [...]

=head1 DESCRIPTION

B<urb-fitness> takes a list of L<Urb::Dom> objects, an optional occlusion field
defined by a file named 'occlusion.field', and optional fitness parameters
defined in a file called 'patterns.config' in the current folder, and
scores each in turn.  

Scores are written to a <filename>.score file as a single float number.

Failures are written to a <filename>.fails file as a list of messages, one per
line.

If the output files already exist and are newer than the object to be scored
then scoring will be skipped, this behaviour can be overrrided by setting the
DEBUG environmental variable.

=head1 COPYRIGHT

Copyright (c) 2004-2013 Bruno Postle <bruno@postle.net>.

This file is part of Urb.

Urb is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

Urb is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with Urb.  If not, see <http://www.gnu.org/licenses/>.

=head1 SEE ALSO

L<Urb>

=cut

