source: trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Sql/Stat.pm @ 1427

package LATMOS::Accounts::Bases::Sql::Stat;

use 5.010000;
use strict;
use warnings;
use LATMOS::Accounts::Log;

use base qw(LATMOS::Accounts::Bases::Sql::objects);

our $VERSION = (q$Rev$ =~ /^Rev: (\d+) /)[0];

=head1 NAME

LATMOS::Accounts::Bases::Sql::Site - Common Location/Address object

=head1 DESCRIPTION

Store common to many people office address (typically building location).

=cut

sub _object_table { 'stat' }

sub _key_field { 'name' }

sub _has_extended_attributes { 1 }

sub _get_attr_schema {
    my ($class, $base) = @_;

    $class->SUPER::_get_attr_schema($base,
        {
            name   => { ro => 1, inline => 1, },
            cn     => { ro => 1, inline => 1, iname => 'name' },
            date   => { ro => 1, inline => 1, },
            create => { ro => 1, inline => 1, },
            filter => { multiple => 1 },
            refFilter => { multiple => 1 },
            refall => { },
            otype  => { },
            attribute => { },
            description => { },
            delay => { },
            lastStatId => { },
        }
    )
}

=head2 compute()

=cut

sub compute {
    my ($self) = @_;

    my $otype = $self->_get_attributes('otype') or return;
    my $attribute = $self->_get_attributes('attribute') or return;

    my %stats;
    my $reffiltered = undef;

    if (my $attr = $self->base->attribute($otype, $attribute)) {
        if (my $obj = $attr->reference) {
            if (my @reffilter = $self->_get_attributes('refFilter')) {
                $reffiltered = {};
                foreach ($self->base->search_objects($obj, @reffilter)) {
                    $reffiltered->{$_} = 1;
                }
            }
        }
        if ($self->_get_attributes('refall') && $attr->has_values_list) {
            foreach ($attr->can_values) {
                if ($reffiltered && !$reffiltered->{$_}) {
                    next;
                }
                $stats{$_} = 0;
            } 
        }
    } else {
        $self->base->log(LA_ERR, "Cannot find attribute %s for object type %s", $attribute, $otype);
    }

    my %filtered;
    if (my @fil = $self->_get_attributes('filter')) {
        %filtered = map { $_ => 1 } $self->base->search_objects($otype, @fil);
    } else {
        %filtered = map { $_ => 1 } $self->base->list_objects($otype);
    }

    my %results = $self->base->attributes_summary_by_object($otype, $attribute);
    foreach my $id (keys %results) {
        $filtered{ $id } or next;
        foreach (@{ $results{ $id }}) {
            if ($reffiltered && !$reffiltered->{$_}) {
                next;
            }
            $stats{ $_ } ||= 0;
            $stats{ $_ }++;
        }
    }

    return %stats;
}

=head2 collect()

Store statistics for $attribute on $otype. @filters allow to limit result on
$otype object matching the filters

=cut

sub collect {
    my ($self) = @_;

    my $otype = $self->_get_attributes('otype') or return;
    my $attribute = $self->_get_attributes('attribute') or return;

    if (my $days = $self->_get_attributes('delay')) {
        my $sth = $self->db->prepare(
            q{
            select tstamp from statsentry where okey = ?
                and tstamp > now() - (? * '1 day'::interval)
                order by tstamp desc
                limit 1
            }
        );
        $sth->execute($self->Iid, $days);
        if (my $res = $sth->fetchrow_hashref) {
            $self->base->log(LA_DEBUG, "Stat %s/%s done recently: %s", $self->id, $otype, $res->{tstamp});
            return 1;
        }
    }

    my %stats = $self->compute();

    my $sthr = $self->db->prepare(
        q{ INSERT INTO statsentry (okey) values (?) }
    );
    $sthr->execute($self->Iid);

    my $id = $self->db->last_insert_id(undef,undef,'statsentry',undef);

    my $sthv =  $self->db->prepare(
        q{
        INSERT INTO statvalues (sid, value, count) values (?,?,?)
        }
    );
    foreach (keys %stats) {
        $sthv->execute($id, $_, $stats{$_});
    }
    $self->_set_c_fields('lastStatId' => $id) or do {
        $self->base->log(LA_ERR, "Cannot update Stat object");
        return;
    };

    return 1;
}


1;

__END__

=head1 SEE ALSO

L<LATMOS::Accounts::Bases::Sql>

=head1 AUTHOR

Olivier Thauvin, E<lt>olivier.thauvin@latmos.ipsl.frE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2008, 2009 CNRS SA/CETP/LATMOS

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.10.0 or,
at your option, any later version of Perl 5 you may have available.


=cut