source: trunk/LATMOS-Accounts/lib/LATMOS/Accounts/SynchAccess/base.pm @ 2416

Last change on this file since 2416 was 2416, checked in by nanardon, 4 years ago

Make la-rename continue even if rename failed in one base (or object is not found)

  • Property svn:keywords set to Id Rev
File size: 3.7 KB
Line 
1package LATMOS::Accounts::SynchAccess::base;
2
3use strict;
4use warnings;
5use vars qw($AUTOLOAD);
6use Carp;
7use LATMOS::Accounts::Log;
8
9our $VERSION = (q$Rev: 1405 $ =~ /^Rev: (\d+) /)[0];
10
11=head1 NAME
12
13LATMOS::Accounts::SynchAccess::base - Fake base object for sync access
14
15=head1 DESCRIPTION
16
17This module fake a base object to send same actions tu multiple base. This is
18used for actions basic synchronisation process cannot handle.
19
20This module contain common functions between Base and Object managment.
21
22=head1 FUNCTIONS
23
24=cut
25
26sub AUTOLOAD {
27    my ($self, @args) = @_;
28    my ($constname, $sub) = $AUTOLOAD =~ m/(.*)::([^:]+)/;
29    if ($sub =~ /^(wexported)/) {
30        $self->_no_trap($sub, @args);
31    } elsif ($sub =~ /^(check_password)$/) {
32        $self->_run_first($sub, @args);
33    } else {
34        $self->_trap_false($sub, @args);
35    }
36}
37
38=head2 new( \@bases, %config )
39
40Create a new SynchAccess instance over given bases
41
42C<%config>:
43
44=over 4
45
46=item cb
47
48Callback, see L<SetCB>
49
50=back
51
52=cut
53
54sub new {
55    my ($class, $bases, %config) = @_;
56    bless {
57        bases => [ @{ $bases } ],
58        %config
59    }, $class;
60}
61
62=head2 bases
63
64Return lists of bases in ths instance.
65
66=cut
67
68sub bases {
69    my ($self) = @_;
70    @{ $self->{bases} || []}
71}
72
73=head2 SetCB ( $callback )
74
75Set a callback to receive the object being call, return the previous one.
76
77=cut
78
79sub SetCB {
80    my ( $self, $cb ) = @_;
81
82    my $oldCB = $self->{cb};
83    $self->{cb} = $cb;
84    return $oldCB;
85}
86
87=head2 CB ( @Args )
88
89Run callback if set
90
91=cut
92
93sub CB {
94    my ( $self, @Args ) = @_;
95
96    if ($self->{cb}) {
97        return $self->{cb}->( @Args );
98    } else {
99        return 1;
100    }
101}
102
103sub _return_all {
104    my ($self, $sub, @args) = @_;
105    my @allres;
106    foreach my $ba ($self->bases) {
107        my @res = $_->$sub(@args);
108        $self->CB($ba, @res);
109        push(@allres, @res);
110    }
111    @allres;
112}
113
114sub _run_first {
115    my ($self, $sub, @args) = @_;
116    my ($fbase) = $self->bases;
117    $fbase->$sub(@args);
118}
119
120sub _no_trap {
121    my ($self, $sub, @args) = @_;
122    foreach ($self->bases) {
123        $_->$sub(@args);
124    }
125}
126
127sub _trap_false {
128    my ($self, $sub, @args) = @_;
129    my $failure = 0;
130    foreach ($self->bases) {
131        my $res = $_->$sub(@args);
132        $self->CB($_, $res);
133        $res or do {
134                    la_log(LA_ERR, "SyncA: Erreur call $sub() for %s", $_);
135                $failure = 1;
136        };
137    }
138    $failure ? 0 : 1;
139}
140
141sub _trap_true {
142    my ($self, $sub, @args) = @_;
143    my $failure = 0;
144    foreach ($self->bases) {
145        my $res = $_->$sub(@args) and $failure = 1;
146        $self->CB($_, $res);
147    }
148    $failure ? 0 : 1;
149}
150
151=head2 rename_object
152
153=cut
154
155sub rename_object {
156    my ($self, $otype, $uid, $newuid) = @_;
157    foreach ($self->bases) {
158        if ($_->is_supported_object($otype)) {
159            $_->get_object($otype, $uid) or do {
160                $_->log(LA_ERR,
161                    "Cannot get object $otype/$uid",
162                );
163                next;
164            };
165
166            my $res = $_->rename_object($otype, $uid, $newuid);
167            $self->CB($_, $res);
168            $res or do {
169                la_log(LA_WARN,
170                    "Cannot get object $otype/$uid in %s/%s",
171                    $_->type,
172                    $_->label
173                );
174                $_->rollback;
175            };
176        }
177    }
178    return 1;
179}
180
181sub DESTROY {}
182
1831;
184
185__END__
186
187=head1 SEE ALSO
188
189L<LATMOS::Accounts>, L<LATMOS::Accounts::Bases>
190
191=head1 AUTHOR
192
193Olivier Thauvin, E<lt>olivier.thauvin@latmos.ipsl.frE<gt>
194
195=head1 COPYRIGHT AND LICENSE
196
197Copyright (C) 2012 CNRS SA/CETP/LATMOS
198
199This library is free software; you can redistribute it and/or modify
200it under the same terms as Perl itself, either Perl version 5.10.0 or,
201at your option, any later version of Perl 5 you may have available.
202
203=cut
Note: See TracBrowser for help on using the repository browser.