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

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