source: trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Task/Delexpiredusers.pm @ 2439

package LATMOS::Accounts::Task::Delexpiredusers;

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::Expiredusers - Warn and unexport expired user

=head1 DESCRIPTION

This module unexport user when they are expired since a given delay.

Before deleting a warning can be sent to the manager.

=head1 PARAMETER

=head2 warndelay

The number of days before warning manager the user will be unexported.

If unset the warning is disable.

=head2 unexportdelay

The number of days after C<warndelay> the user is effectivelly unexported.

If unset no user are unexported.

=head2 modifdelay

The time to wait in minutes after user modification before unexporting it.

This time avoid the module deleting a user in the same time an administrator
is trying to reactivate it.

Default is 60 minutes.

=head2 test

If set only log are emitted but changes are not done and mail not really sent

=head2 warn_manager

If set, send a warning to manager of user after L<warndelay>.

If not, a mail is sent only to L<summary> (if set).

=head2 cc

A copy of warning are sent to this email address

=head2 summary

If set, send a summmary to this address

=head2 to

Instead sending mail to manager mail are sent to this email address.

=head1 warndelay/unexportdelay example

Unexporting user immediatly /o any warning:

    # warndelay = 0
    unexportdelay = 0

Warning manager with immediate unexport:

    warndelay = 0
    unexportdelay = 0

Warning manager immediatelly but unexporting user 15 days later

    warndelay = 0
    unexportdelay = 15

Wait 6 month after expiration, unexport user 15 days after warning:

    warndelay = 180
    unexportdelay = 15

=cut

# Run every 2 hours
sub runDelay { 2 * 60 * 60 }

# Wait 30 minutes
sub waitDelay { 30 * 60 }

sub _DATEFLAG { 'expireText' }

sub init {
    my ($self) = @_;
    my $LA = $self->LA;
    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) = @_;

    $self->_unexport;

    $self->_send_warning;

    1;
}

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

    my $test = $self->{syncm}->ini->val($self->{name}, 'test');
    my $warnDelay = $self->{syncm}->ini->val($self->{name}, 'warndelay');

    my $modifDelay = $self->{syncm}->ini->val($self->{name}, 'modifdelay', 60);
    my $waitAfterModif = DateTime->now->subtract( minutes => $modifDelay  )->iso8601;
       
    defined($warnDelay)  or do {
        $self->{_base}->log(LA_DEBUG, "Don't warning manager because no warndelay given");
        return;
    };

    my $expiredDate = DateTime->now()->subtract(days => $warnDelay);

    my %expired;

    foreach my $user ($self->{_base}->search_objects('user',
            'exported=1',
            'expire<' . $expiredDate->ymd('-'),
            'date<' . $waitAfterModif,
            'oalias=NULL'
        )) {
        my $ouser = $self->{_base}->get_object('user', $user) or next;

        if ($ouser->get_attributes('nextEmployment')) {
            # This user has expire account but a futur employement is coming
            next;
        }


        my $manager = $ouser->get_attributes('manager') || 'N/A';
 
        $expired{$manager} ||= { users => [] };
        push (@{$expired{$manager}{users}}, $ouser);
    }

    if ($self->{syncm}->ini->val('warn_manager')) {
        my $lamail = LATMOS::Accounts::Mail->new(
            $self->{_la},
            'account_expired_reminder.mail',
        );

        my $MailSubject = $self->{_base}->la->val('_default_', 'mailSubject', 'LATMOS::Accounts');

        foreach my $manager (sort keys %expired) {

            my $omanager = $self->{_base}->get_object('user', $manager) or next;
            my $mail = $omanager->get_attributes('mail') or next;

            my $data = {
                manager => $omanager,
                users => [],
            };

            foreach my $ouser (@{ $expired{$manager}{users}}) {
                if (my $val = $self->{_base}->get_global_value("expiredWarning.user." . $ouser->id)) {
                    if ($val eq $ouser->get_attributes(_DATEFLAG)) {
                        # Warning has been already sent
                        next;
                    }
                }
                $self->{_base}->log(
                    LA_NOTICE,
                    "%s Warning, user %s is expired (%s), manager %s",
                    $test ? 'Test: ' : '',
                    $ouser->id,
                    $ouser->get_attributes('expireText'),
                    $manager,
                );
                push(@{ $data->{users} }, $ouser);
                $self->{_base}->set_global_value('expiredWarning.user.' . $ouser->id, $ouser->get_attributes(_DATEFLAG));
            }
            if (! @{ $data->{users} }) {
                next;
            }
            $self->{_base}->commit;


            my %mail = (
                Subject => "$MailSubject: expired account",
                'X-LATMOS-Reason' => 'Account destruction',
            );

            # to is for debuging
            $mail{to} = $self->{syncm}->ini->val($self->{name}, 'to', $mail);
            $mail{cc} = $self->{syncm}->ini->val($self->{name}, 'cc');

            if ($test) {
                $self->{_base}->log(LA_NOTICE, "Test: sending mail to %s for expired account %s",
                    $omanager->id,
                    join(', ', sort map { $_->id } @{ $data->{users} }),
                );
            } else {
                if ($lamail->process(\%mail, $data)) {
                    $self->{_base}->log(LA_NOTICE,
                        "Expired account reminder mail sent to %s (%s) (cc: %s) for %s",
                        $mail{to},
                        $omanager->id,
                        ($mail{cc} || ''),
                        join(', ', sort map { $_->id } @{ $data->{users}}),
                    );

                }
            }
        }
    }

    if (my $sumto = $self->{syncm}->ini->val($self->{name}, 'summary')) {
        my $MailSubject = $self->{_base}->la->val('_default_', 'mailSubject', 'LATMOS::Accounts');

        my @summary;
        foreach my $manager (sort keys %expired) {
            foreach (@{$expired{$manager}{users}}) {

                if (my $val = $self->{_base}->get_global_value("expiredWarning.usersummary." . $_->id)) {
                    if ($val eq $_->get_attributes(_DATEFLAG)) {
                        # Warning has been already sent
                        next;
                    }
                }

                push(@summary, sprintf("%s - %s (%s, %s)\n",
                        $_->id,
                        ($expired{$manager}{manager}
                            ? $expired{$manager}{manager}->get_attributes('displayName')
                            : $manager),
                        $_->get_attributes('displayName'),
                        $_->get_attributes('expireText'),
                    )
                );

                $self->{_base}->set_global_value('expiredWarning.usersummary.' . $_->id, $_->get_attributes(_DATEFLAG));
            }
        }

        $self->{_base}->commit;

        if (@summary) {
            if ($test) {
                $self->{_base}->log(LA_NOTICE, "Test: no sending expired summary to $sumto for users");
                $self->{_base}->log(LA_DEBUG, join('', @summary));
            } else {
                my %mail = (
                    Subject => "$MailSubject: expired account (deactivation planned)",
                    'X-LATMOS-Reason' => 'Account expiration',
                    To => $sumto,
                );
                my $summail = LATMOS::Accounts::Mail->new(
                    $self->{_la}, \join('', @summary), {}
                );
                if ($summail->process(\%mail)) {
                    la_log(LA_NOTICE, "Expiration summary mail sent to %s",
                        $sumto,
                    );
                }
            }
        }
    }
}

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

    my $test = $self->{syncm}->ini->val($self->{name}, 'test');

    my $warnDelay     = $self->{syncm}->ini->val($self->{name}, 'warndelay', 0);
    my $unexportDelay = $self->{syncm}->ini->val($self->{name}, 'unexportdelay');
    defined($unexportDelay) or do {
        $self->{_base}->log(LA_DEBUG, "Don't unexporting user because no unexportdelay given");
        return;
    };

    my $expiredDate = DateTime->now()->subtract(days => $warnDelay + $unexportDelay);

    my $modifDelay = $self->{syncm}->ini->val($self->{name}, 'modifdelay', 60);
    my $waitAfterModif = DateTime->now->subtract( minutes => $modifDelay  )->iso8601;

    foreach my $user ($self->{_base}->search_objects('user',
            'exported=1',
            'expire<' . $expiredDate->ymd('-'),
            'date<' . $waitAfterModif,
            'oalias=NULL'
        )) {
        my $ouser = $self->{_base}->get_object('user', $user) or next;
        if ($ouser->get_attributes('currentEmployment') || $ouser->get_attributes('nextEmployment')) {
            # This user has expire account but a futur employement is coming
            next;
        }

        $self->{_base}->log(LA_NOTICE, "%sUser $user unexported because is expired (%s)",
            $test ? 'Test: ' : '', $ouser->get_attributes('expireText'));

        if (!$test) {
            $ouser->_set_c_fields(
                unexported => 1
            );
            $self->{_base}->del_global_value("expiredWarning.user.$user");
            $self->{_base}->del_global_value("expiredWarning.usersummary.$user");
            $ouser->ReportChange('Update', "Automatic unexport due to expiration");
            $self->{_base}->commit;
        }
    }
}

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