[1500] | 1 | package LATMOS::Accounts::Task::Employment; |
---|
| 2 | |
---|
| 3 | use strict; |
---|
| 4 | use warnings; |
---|
| 5 | use base qw(LATMOS::Accounts::Task); |
---|
| 6 | use LATMOS::Accounts; |
---|
| 7 | use LATMOS::Accounts::Log; |
---|
| 8 | use LATMOS::Accounts::Utils; |
---|
| 9 | |
---|
| 10 | =head1 NAME |
---|
| 11 | |
---|
| 12 | LATMOS::Accounts::Task::Stats - Store value to perform some statistics |
---|
| 13 | |
---|
| 14 | =head1 DESCRIPTION |
---|
| 15 | |
---|
| 16 | =cut |
---|
| 17 | |
---|
| 18 | sub init { |
---|
| 19 | my ($self) = @_; |
---|
| 20 | my $LA = LATMOS::Accounts->new($self->{config}, noacl => 1); |
---|
| 21 | my $labase = $self->{base} ? $LA->base($self->{base}) : $LA->base; |
---|
| 22 | $labase && $labase->load or die "Cannot load base"; |
---|
| 23 | |
---|
| 24 | $self->{_la} = $LA; |
---|
| 25 | $self->{_base} = $labase; |
---|
| 26 | |
---|
| 27 | 1; |
---|
| 28 | } |
---|
| 29 | |
---|
| 30 | sub needupd { 1 } |
---|
| 31 | |
---|
| 32 | sub run { |
---|
| 33 | my ($self) = @_; |
---|
| 34 | |
---|
| 35 | my %users = map { $_ => undef } $self->{_base}->search_objects('user', 'exported=true'); |
---|
| 36 | my %old = $self->{_base}->attributes_summary_by_object('user', 'appliedEmployement'); |
---|
| 37 | foreach (keys %old) { |
---|
| 38 | exists($users{$_}) or next; |
---|
| 39 | $users{$_} = $old{$_}->[0] || ''; |
---|
| 40 | } |
---|
| 41 | |
---|
| 42 | my $listempl = $self->{_base}->db->prepare_cached(q{ |
---|
| 43 | SELECT * FROM employment where firstday <= now() and (lastday is null or lastday >= now() - '1 days'::interval) |
---|
| 44 | and exported = true |
---|
| 45 | order by lastday, firstday |
---|
| 46 | }); |
---|
| 47 | $listempl->execute(); |
---|
| 48 | my %new = (); |
---|
| 49 | while (my $res = $listempl->fetchrow_hashref) { |
---|
| 50 | my $employment = $res->{name}; |
---|
| 51 | my $user = $res->{user}; |
---|
| 52 | if ($employment ne $users{$user}) { |
---|
| 53 | $self->{_base}->log(LA_NOTICE, "Updating user $user to match employment `%s'", $employment || ''); |
---|
| 54 | my $ouser = $self->{_base}->get_object('user', $user) or next; |
---|
| 55 | |
---|
| 56 | my $job = $self->{_base}->get_object('employment', $employment); |
---|
| 57 | $job->applyToUser; |
---|
| 58 | $self->{_base}->commit; |
---|
| 59 | } |
---|
| 60 | } |
---|
| 61 | |
---|
| 62 | return 1; |
---|
| 63 | } |
---|
| 64 | |
---|
| 65 | 1; |
---|
| 66 | |
---|
| 67 | __END__ |
---|
| 68 | |
---|
| 69 | =head1 SEE ALSO |
---|
| 70 | |
---|
| 71 | L<LATMOS::Accounts>, L<LATMOS::Accounts::Task> |
---|
| 72 | |
---|
| 73 | =head1 AUTHOR |
---|
| 74 | |
---|
| 75 | Olivier Thauvin, E<lt>olivier.thauvin@latmos.ipsl.frE<gt> |
---|
| 76 | |
---|
| 77 | =head1 COPYRIGHT AND LICENSE |
---|
| 78 | |
---|
| 79 | Copyright (C) 2012 CNRS SA/CETP/LATMOS |
---|
| 80 | |
---|
| 81 | This library is free software; you can redistribute it and/or modify |
---|
| 82 | it under the same terms as Perl itself, either Perl version 5.10.0 or, |
---|
| 83 | at your option, any later version of Perl 5 you may have available. |
---|
| 84 | |
---|
| 85 | =cut |
---|
| 86 | |
---|