package LATMOS::Accounts::Task::Setattribute; use strict; use warnings; use base qw(LATMOS::Accounts::Task); use LATMOS::Accounts; use LATMOS::Accounts::Log; use LATMOS::Accounts::Utils; =head1 NAME LATMOS::Accounts::Task::Setattribute - Task to disable expired users =head1 DESCRIPTION Set attribute to specific value according filter =head1 CONFIGURATION =over 4 =item otype The type of object to modify =item filter The filter matching object to modify (can be multi-valued) =item attribute The attribute to set =item values The values the attribute must set to. Can be a queryformat expression. =item noeval If set, values are taken litteral w/o queryformat evaluation =back =cut sub order { 0 } 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"; my @errors = (); $self->{otype} = $self->config('otype') or do { push(@errors, "Cannot find config `otype' value"); }; @{ $self->{filter} } = $self->config('filter') or do { push(@errors, "Cannot find config `filter' value"); }; # Getting attributes to set $self->{attribute} = $self->config('attribute') or do { push(@errors, "Cannot find config `attribute' value"); }; @{ $self->{values} } = grep { $_ } $self->config('values'); if (@errors) { la_log(LA_ERR, $_) foreach (@errors); return; } $self->{_la} = $LA; $self->{_base} = $labase; 1; } sub run { my ($self) = @_; my @objects = $self->{_base}->search_objects( $self->{otype}, @{ $self->{filter} }); foreach my $obj (@objects) { my $o = $self->{_base}->get_object($self->{otype}, $obj) or next; my $value = undef; my @values = $self->config('noeval') ? @{ $self->{values} } : map { $o->queryformat($_) } @{ $self->{values} }; if (scalar(@values) > 1) { $value = \@values; } elsif (scalar(@values) == 1) { $value = $values[0]; } if ($o->_set_c_fields( $self->{attribute} => $value )) { la_log(LA_DEBUG, "Attribute %s set to '%s' for Object %s", $self->{attribute}, join(', ', @values), $o->id); $self->{_base}->commit; } } 1; } 1; __END__ =head1 SEE ALSO L, L =head1 AUTHOR Olivier Thauvin, Eolivier.thauvin@latmos.ipsl.frE =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