source: trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Task/Unexportexpired.pm @ 1880

package LATMOS::Accounts::Task::Unexportexpired;

use strict;
use warnings;
use base qw(LATMOS::Accounts::Task);
use LATMOS::Accounts;
use LATMOS::Accounts::Log;
use LATMOS::Accounts::Utils;
use DateTime;

=head1 NAME

LATMOS::Accounts::Task::Refreshexpired - Task to disable expired users

=head1 DESCRIPTION

Some base doesn't handle accounts expiration. One way to do it is to synchronize
user with value denying login (wrong UNIX shell, password entry set to false,
...).

For performance issue, objects are not written at each synchronisation, only
when they changes.

This module find expired user and refresh modification time to ensure
propagation to other database.

=cut

# Every 10 minutes
sub runDelay { 20 * 60 }

sub init {
    my ($self) = @_;
    my $LA = LATMOS::Accounts->new($self->{config}, noacl => 1);
    my $labase = $self->{base} ? $LA->base($self->{base}) : $LA->base;
    $labase && $labase->load or die "Cannot load base";

    $self->{_la} = $LA;
    $self->{_base} = $labase;

    1;
}

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

    my $now = DateTime->now();
    my $nowtext = $now->iso8601();

    foreach my $otype (qw(Aliases Nethost Address)) {

        foreach my $name (
            $self->{_base}->search_objects($otype, 'exported=t', "expire<$nowtext")) {
            my $obj = $self->{_base}->get_object($otype, $name);
            la_log(LA_NOTICE, "Unexport %s/%s object due to expire (%s)", $otype, $name, $obj->_get_attributes('expire') ||'');
            $obj->_set_c_fields(unexported => 1);
            $self->{_base}->commit;
        }

    }

    1;
}

1;

__END__

=head1 SEE ALSO

L<LATMOS::Accounts>, L<LATMOS::Accounts::Task>

=head1 AUTHOR

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

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2012 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