source: LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Sql/objects.pm @ 305

Last change on this file since 305 was 305, checked in by nanardon, 15 years ago
  • add mail aliases/revaliases support
  • Property svn:keywords set to Id Rev
File size: 10.6 KB
Line 
1package LATMOS::Accounts::Bases::Sql::objects;
2
3use 5.010000;
4use strict;
5use warnings;
6
7use base qw(LATMOS::Accounts::Bases::Objects);
8use LATMOS::Accounts::Log;
9
10our $VERSION = (q$Rev$ =~ /^Rev: (\d+) /)[0];
11
12=head1 NAME
13
14LATMOS::Ad - Perl extension for blah blah blah
15
16=head1 SYNOPSIS
17
18  use LATMOS::Accounts::Bases;
19  my $base = LATMOS::Accounts::Bases->new('unix');
20  ...
21
22=head1 DESCRIPTION
23
24Account base access over standard unix file format.
25
26=head1 FUNCTIONS
27
28=cut
29
30=head2 new(%options)
31
32Create a new LATMOS::Ad object for windows AD $domain.
33
34domain / server: either the Ad domain or directly the server
35
36ldap_args is an optionnal list of arguments to pass to L<Net::LDAP>.
37
38=cut
39
40sub list {
41    my ($class, $base) = @_;
42
43    my $sth = $base->db->prepare_cached(
44        sprintf(
45            q{select %s as k from %s %s order by %s},
46            $base->db->quote_identifier($class->key_field),
47            $base->db->quote_identifier($class->object_table),
48            ($base->{wexported} ? '' : 'where exported = true'),
49            $base->db->quote_identifier($class->key_field),
50        )
51    );
52    $sth->execute;
53    my @keys;
54    while(my $res = $sth->fetchrow_hashref) {
55        push(@keys, $res->{k});
56    }
57    @keys
58}
59
60sub list_from_rev {
61    my ($class, $base, $rev) = @_;
62    my $sth = $base->db->prepare_cached(
63        sprintf(
64            q{select %s as k from %s where rev > ? %s order by %s},
65            $base->db->quote_identifier($class->key_field),
66            $base->db->quote_identifier($class->object_table),
67            ($base->{wexported} ? '' : 'and exported = true'),
68            $base->db->quote_identifier($class->key_field),
69        )
70    );
71    $sth->execute($rev);
72    my @keys;
73    while(my $res = $sth->fetchrow_hashref) {
74        push(@keys, $res->{k});
75    }
76    @keys
77}
78
79sub has_extended_attributes { 0 }
80
81sub _inline_fields {
82    my ($self, $for, $base) = @_;
83    my @res;
84    if (!$self->has_extended_attributes) {
85        my $sth = $base->db->prepare(
86            q{SELECT column_name FROM information_schema.columns
87              WHERE table_name = ?}
88        );
89        $sth->execute($self->object_table);
90        while (my $res = $sth->fetchrow_hashref) {
91            if ($for =~ 'w') {
92                next if($res->{column_name} =~ /^(rev|date|create|ikey)$/);
93                next if($res->{column_name} eq $self->key_field);
94            }
95            push(@res, $res->{column_name});
96        }
97    } else {
98        @res = $for !~ 'w' ? qw(rev date create ikey name) : ();
99        push(@res, qw(exported));
100    }
101    my %fields = map { $_ => $_ } @res;
102    \%fields
103}
104
105sub _canonical_fields {
106    my ($class, $base, $for) = @_;
107    $for ||= 'rw';
108    my @attr;
109    if ($class->has_extended_attributes) {
110        my $sth = $base->db->prepare_cached(
111            sprintf(
112                q{select canonical from %s order by canonical},
113                $base->db->quote_identifier($class->object_table . '_attributes_list'),
114            )
115        );
116        $sth->execute;
117        while (my $res = $sth->fetchrow_hashref) {
118            push(@attr, $res->{canonical});
119        }
120    }
121    my %inl = %{ $class->_inline_fields($for, $base) || {} };
122    $inl{$_} = 1 foreach(@attr);
123    return sort keys %inl;
124   
125}
126
127sub _get_field_name_db {
128    my ($class, $c_field, $base) = @_;
129    $class->has_extended_attributes or return;
130    $class->object_table or return;
131    my $sth = $base->db->prepare_cached(
132        sprintf(
133            q{select ikey from %s where canonical = ?},
134            $base->db->quote_identifier($class->object_table . '_attributes_list'),
135        )
136    );
137    $sth->execute($c_field);
138   
139    my $res = $sth->fetchrow_hashref;
140    $sth->finish;
141    return $c_field if($res->{ikey});
142}
143
144sub _get_field_name {
145    my ($class, $c_field, $base, $for) = @_;
146    $c_field or return;
147    $for ||= 'rw';
148    my $inline = $class->_inline_fields($for, $base) || {};
149    return $inline->{$c_field}
150        ? $inline->{$c_field}
151        : $class->_get_field_name_db($c_field, $base);
152}
153
154sub new {
155    my ($class, $base, $id) = @_;
156    my $sth = $base->db->prepare_cached(
157        sprintf(q{select 1 from %s where %s = ? %s},
158            $base->db->quote_identifier($class->object_table),
159            $base->db->quote_identifier($class->key_field),
160            ($base->{wexported} ? '' : 'and exported = true'),
161        ),
162    );
163    my $count = $sth->execute($id);
164    $sth->finish;
165    $count == 1 or return;
166    bless({ _id => $id, _base => $base }, $class);
167}
168
169sub _get_ikey {
170    my ($class, $base, $id) = @_;
171    $base ||= $class->base;
172    $id ||= $class->id;
173    my $sth = $base->db->prepare_cached(
174        sprintf(
175            q{select ikey from %s where %s = ?},
176            $base->db->quote_identifier($class->object_table),
177            $base->db->quote_identifier($class->key_field),
178        )
179    );
180    $sth->execute($id);
181    my $res = $sth->fetchrow_hashref;
182    $sth->finish;
183    $res->{ikey}
184}
185
186sub _create {
187    my ($class, $base, $id, %data) = @_;
188
189    # splitting inline from extended
190    my $inl = $class->_initials_fields('w', $base) || {};
191    my (%first, %second);
192    foreach (keys %data) {
193        if ($inl->{$_}) {
194            $first{$inl->{$_}} = $data{$_};
195        } else {
196            $second{$_} = $data{$_};
197        }
198    }
199    $first{$class->key_field} = $id;
200
201    my $sth = $base->db->prepare(
202        sprintf(
203            q{insert into %s (%s) values (%s)},
204            $base->db->quote_identifier($class->object_table),
205            join(', ', map { $base->db->quote_identifier($_) } sort keys %first),
206            join(',', qw(?) x scalar(keys %first)),
207        )
208    );
209    $sth->execute(map { $first{$_} } sort keys %first) or return;
210
211    $class->new($base, $id)->set_fields(%second);
212
213    1;
214}
215
216sub _delete {
217    my ($class, $base, $id) = @_;
218
219    my $sthd = $base->db->prepare_cached(
220        sprintf(
221            q{delete from %s where %s = ?},
222            $base->db->quote_identifier($class->object_table),
223            $base->db->quote_identifier($class->key_field),
224        )
225    );
226    $sthd->execute($id);
227}
228
229sub db {
230    return $_[0]->base->db;
231}
232
233sub quote_object_table {
234    my ($self) = @_;
235    my $table = $self->object_table or return;
236    $self->db->quote_identifier($table);
237}
238sub quote_key_field { 
239    my ($self) = @_;
240    my $key_field = $self->key_field or return;
241    $self->db->quote_identifier($key_field);
242}
243
244sub get_field {
245    my ($self, $field) = @_;
246    my $inl = $self->_inline_fields('r', $self->base) || {};
247    my %inline = map { $inl->{$_} => 1 }  keys %{ $inl || {}};
248    if ($inline{lc($field)}) {
249    my $sth = $self->db->prepare_cached(
250        sprintf(
251            q{select %s from %s where %s = ?},
252            $self->db->quote_identifier(lc($field)),
253            $self->quote_object_table,
254            $self->quote_key_field,
255        )
256    );
257    $sth->execute($self->id);
258    my $res = $sth->fetchrow_hashref;
259    $sth->finish;
260    return $res->{$field};
261    } elsif ($self->has_extended_attributes) { # else, then we mandatory have extend attr
262        my $sth = $self->db->prepare_cached(
263            sprintf(
264                q{
265                select value from %s
266                join %s on okey = ikey
267                where %s = ? and attr = ?
268                },
269                $self->db->quote_identifier($self->object_table. '_attributes'),
270                $self->db->quote_identifier($self->object_table),
271                $self->db->quote_identifier($self->key_field),
272            )
273        );
274        $sth->execute($self->id, $field);
275        my $res = $sth->fetchrow_hashref;
276        $sth->finish;
277        return $res->{value};
278    }
279}
280
281sub set_fields {
282    my ($self, %data) = @_;
283    my @fields;
284    my @vals;
285    my %ext;
286    my $inl = $self->_inline_fields('w', $self->base) || {};
287    my %inline = map { $inl->{$_} => 1 }  keys %{ $inl || {}};
288    foreach my $field (keys %data) {
289        $data{$field} = $data{$field} ? 1 : 0 if($field eq 'exported');
290        my $oldval = $self->get_field($field);
291        next if (($data{$field} || '') eq ($oldval || ''));
292        if ($inline{$field}) {
293        # TODO check fields exists !
294        push(@fields, sprintf("%s = ?", $self->db->quote_identifier($field)));
295        push(@vals, $data{$field});
296        } else {
297            $ext{$field} = $data{$field};
298        }
299    }
300    if (@fields) {
301        my $sth = $self->db->prepare_cached(
302            sprintf(
303                q{update %s set %s where %s = ?},
304                $self->quote_object_table,
305                join(', ', @fields),
306                $self->quote_key_field,
307            )
308        );
309        $sth->execute(@vals, $self->id) or return;
310    }
311   
312    if ($self->has_extended_attributes) {
313        my $sthd = $self->db->prepare_cached(
314            sprintf(
315                q{delete from %s where okey = ? and attr = ?},
316                $self->db->quote_identifier($self->object_table. '_attributes'),
317            ),
318        );
319        my $sthx = $self->db->prepare_cached(
320            sprintf(
321                q{insert into %s (okey, attr, value) values (?,?,?)},
322                $self->db->quote_identifier($self->object_table. '_attributes'),
323            )
324        );
325        my $sthu = $self->db->prepare_cached(
326            sprintf(
327                q{update %s set value = ? where okey = ? and attr = ?},
328                $self->db->quote_identifier($self->object_table. '_attributes'),
329            )
330        );
331
332        my $okey = $self->_get_ikey($self->base, $self->id);
333        foreach (keys %ext) {
334            if ($ext{$_}) {
335                $sthu->execute($ext{$_}, $okey, $_) != 0 ||
336                $sthx->execute($okey, $_, $ext{$_}) or return;
337            } else {
338                $sthd->execute($okey, $_) or return;
339            }
340        }
341    }
342
343    1;
344}
345
346sub attributes_summary {
347    my ($class, $base, $attribute) = @_;
348    $class->has_extended_attributes && $class->object_table or
349        return $class->SUPER::attributes_summary($base, $attribute);
350    my $sth = $base->db->prepare_cached(
351        sprintf(
352            q{select value from %s where attr = ? group by value},
353            $base->db->quote_identifier($class->object_table .
354                '_attributes'),
355        )
356    );
357    $sth->execute($attribute);
358
359    my @values;
360    while (my $res = $sth->fetchrow_hashref) {
361        push(@values, $res->{value});
362    }
363    @values
364}
365
3661;
367
368__END__
369
370=head1 SEE ALSO
371
372=head1 AUTHOR
373
374Olivier Thauvin, E<lt>olivier.thauvin@latmos.ipsl.frE<gt>
375
376=head1 COPYRIGHT AND LICENSE
377
378Copyright (C) 2008, 2009 CNRS SA/CETP/LATMOS
379
380This library is free software; you can redistribute it and/or modify
381it under the same terms as Perl itself, either Perl version 5.10.0 or,
382at your option, any later version of Perl 5 you may have available.
383
384
385=cut
Note: See TracBrowser for help on using the repository browser.