source: LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Sql/Address.pm @ 453

Last change on this file since 453 was 453, checked in by nanardon, 15 years ago
  • manage postalAddress attribute
File size: 3.6 KB
Line 
1package LATMOS::Accounts::Bases::Sql::Address;
2
3use 5.010000;
4use strict;
5use warnings;
6
7use base qw(LATMOS::Accounts::Bases::Sql::objects);
8
9our $VERSION = (q$Rev: 594 $ =~ /^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('sql');
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 object_table { 'address' }
40
41sub key_field { 'name' }
42
43sub has_extended_attributes { 1 }
44
45sub _inline_fields {
46    my ($self, $for, $base) = @_;
47
48    my %fields = (
49        $self->SUPER::_inline_fields($for, $base),
50        user            => 'user',
51    );
52    %fields
53}
54
55sub _managed_fields {
56    my ($self, $for, $base) = @_;
57    (site => 'site'),
58    $for !~ /w/ ? (
59        sn => 'sn',
60        mail =>  'mail',
61        givenName => 'givenName',
62        postalAddress => 'postalAddress',
63    ) : ()
64}
65
66sub _delayed_fields {
67    my ($self)= @_;
68    return qw();
69}
70
71sub _create {
72    my ($class, $base, $id, %data) = @_;
73    $data{user} or return;
74    my $user = $base->get_object('user', $data{user});
75    if (!$user->get_c_field('otheraddress')) {
76        $data{isMainAddress} = 1;
77    }
78    $class->SUPER::_create($base, $id, %data);
79}
80
81sub get_field {
82    my ($self, $field) = @_;
83    if ((grep { $field eq $_ } __PACKAGE__->_address_fields())
84        && (my $fsite = $self->get_c_field('site'))) {
85        my $site = $self->base->get_object('site', $fsite);
86        if ($site) {
87            return $site->get_field($field);
88        }
89    } elsif ($field =~ /^(sn|givenName|mail)$/) {
90        my $user = $self->base->get_object('user', $self->_get_c_field('user'));
91        return $user->_get_c_field($field);
92    } elsif ($field eq 'postalAddress' ) {
93        my $bp = $self->_get_c_field('postOfficeBox');
94        return join('$', grep { $_ } (
95            $self->_get_c_field('o'),
96            $self->_get_c_field('streetAddress'),
97            ($bp ? 'BP ' . $bp : ''),
98            join(' ', grep { $_ } (
99                    $self->_get_c_field('postalCode'),
100                    $self->_get_c_field('l'),)),
101            join(' ', grep { $_ } (
102                    $self->_get_c_field('st'),
103                    $self->_get_c_field('c'),),
104            )
105        ));
106    } else {
107        return $self->SUPER::get_field($field);
108    }
109}
110
111sub set_fields {
112    my ($self, %data) = @_;
113    my %fdata;
114    foreach my $attr (keys %data) {
115        $attr =~ /^site$/ and do {
116            my $site =
117            $self->base->get_object('site',
118                $data{$attr});
119            if ($site) {
120                foreach (__PACKAGE__->_address_fields()) {
121                    $fdata{$_} = undef;
122                    $data{$_} = undef;
123                }
124            }
125            $fdata{$attr} = $data{$attr} || undef;
126            next;
127        };
128        $fdata{$attr} = $data{$attr} || undef;
129    }
130    if  (keys %fdata) {
131        $self->SUPER::set_fields(%fdata);
132    }
133}
134
1351;
136
137__END__
138
139=head1 SEE ALSO
140
141=head1 AUTHOR
142
143Olivier Thauvin, E<lt>olivier.thauvin@latmos.ipsl.frE<gt>
144
145=head1 COPYRIGHT AND LICENSE
146
147Copyright (C) 2008, 2009 CNRS SA/CETP/LATMOS
148
149This library is free software; you can redistribute it and/or modify
150it under the same terms as Perl itself, either Perl version 5.10.0 or,
151at your option, any later version of Perl 5 you may have available.
152
153
154=cut
Note: See TracBrowser for help on using the repository browser.