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

package LATMOS::Accounts::Bases::Sql::objects;

use 5.010000;
use strict;
use warnings;

use base qw(LATMOS::Accounts::Bases::Objects);

our $VERSION = (q$Rev$ =~ /^Rev: (\d+) /)[0];

=head1 NAME

LATMOS::Ad - Perl extension for blah blah blah

=head1 SYNOPSIS

  use LATMOS::Accounts::Bases;
  my $base = LATMOS::Accounts::Bases->new('unix');
  ...

=head1 DESCRIPTION

Account base access over standard unix file format.

=head1 FUNCTIONS

=cut

=head2 new(%options)

Create a new LATMOS::Ad object for windows AD $domain.

domain / server: either the Ad domain or directly the server

ldap_args is an optionnal list of arguments to pass to L<Net::LDAP>.

=cut

sub list {
    my ($class, $base) = @_;

    my $sth = $base->db->prepare_cached(
        sprintf(
            q{select %s as k from %s order by %s},
            $base->db->quote_identifier($class->key_field),
            $base->db->quote_identifier($class->object_table),
            $base->db->quote_identifier($class->key_field),
        )
    );
    $sth->execute;
    my @keys;
    while(my $res = $sth->fetchrow_hashref) {
        push(@keys, $res->{k});
    }
    @keys
}

sub list_from_rev {
    my ($class, $base, $rev) = @_;
    my $sth = $base->db->prepare_cached(
        sprintf(
            q{select %s as k from %s where rev > ? order by %s},
            $base->db->quote_identifier($class->key_field),
            $base->db->quote_identifier($class->object_table),
            $base->db->quote_identifier($class->key_field),
        )
    );
    $sth->execute($rev);
    my @keys;
    while(my $res = $sth->fetchrow_hashref) {
        push(@keys, $res->{k});
    }
    @keys
}

sub has_extended_attributes { 0 }

sub _initial_fields {
    my ($self, $for) = @_;
    $self->_inline_fields($for)
}

sub _inline_fields {
    my ($self, $for) = @_;
    {}
}

sub _canonical_fields {
    my ($class, $base, $for) = @_;
    $for ||= 'rw';
    my @attr;
    if ($class->has_extended_attributes) {
        my $sth = $base->db->prepare_cached(
            sprintf(
                q{select canonical from %s order by canonical},
                $base->db->quote_identifier($class->object_table . '_attributes_list'),
            )
        );
        $sth->execute;
        while (my $res = $sth->fetchrow_hashref) {
            push(@attr, $res->{canonical});
        }
    }
    @attr, keys %{ $class->_inline_fields($for) || {} }
}

sub _get_field_name_db {
    my ($class, $c_field, $base) = @_;
    $class->has_extended_attributes or return;
    $class->object_table or return;
    my $sth = $base->db->prepare_cached(
        sprintf(
            q{select ikey from %s where canonical = ?},
            $base->db->quote_identifier($class->object_table . '_attributes_list'),
        )
    );
    $sth->execute($c_field);
    
    my $res = $sth->fetchrow_hashref;
    $sth->finish;
    $res->{ikey}
}

sub _get_field_name {
    my ($class, $c_field, $base, $for) = @_;
    $for ||= 'rw';
    my $inline = $class->_inline_fields($for) || {};
    return $inline->{$c_field}
        ? $inline->{$c_field}
        : $class->_get_field_name_db($c_field, $base);
}

sub new {
    my ($class, $base, $id) = @_;
    bless({ _id => $id, _base => $base }, $class);
}

sub _create {
    my ($class, $base, $id, %data) = @_;

    # splitting inline from extended
    my $inl = $class->_initial_fields('w') || {};
    my %inline = map { $inl->{$_} => 1 }  keys %{ $inl || {}};
    my (%first, %second);
    foreach (keys %data) {
        if ($inline{$_}) {
            $first{$_} = $data{$_};
        } else {
            $second{$_} = $data{$_};
        }
    }
    $first{$class->key_field} = $id;

    my $sth = $base->db->prepare(
        sprintf(
            q{insert into %s (%s) values (%s)},
            $base->db->quote_identifier($class->object_table),
            join(', ', map { $base->db->quote_identifier($_) } sort keys %first),
            join(',', qw(?) x scalar(keys %first)),
        )
    );
    $sth->execute(map { $first{$_} } sort keys %first) or return;

    $class->new($base, $id)->set_fields(%second);

    1;
}

sub _delete {
    my ($class, $base, $id) = @_;

    my $sthd = $base->db->prepare_cached(
        sprintf(
            q{delete from %s where %s = ?},
            $base->db->quote_identifier($class->object_table),
            $base->db->quote_identifier($class->key_field),
        )
    );
    $sthd->execute($id);
}

sub db {
    return $_[0]->base->db;
}

sub quote_object_table {
    my ($self) = @_;
    my $table = $self->object_table or return;
    $self->db->quote_identifier($table);
}
sub quote_key_field { 
    my ($self) = @_;
    my $key_field = $self->key_field or return;
    $self->db->quote_identifier($key_field);
}

sub get_field {
    my ($self, $field) = @_;
    my $inl = $self->_inline_fields('r') || {};
    my %inline = map { $inl->{$_} => 1 }  keys %{ $inl || {}};
    if ($inline{$field}) {
    my $sth = $self->db->prepare_cached(
        sprintf(
            q{select %s from %s where %s = ?},
            $self->db->quote_identifier($field),
            $self->quote_object_table,
            $self->quote_key_field,
        )
    );
    $sth->execute($self->id);
    my $res = $sth->fetchrow_hashref;
    $sth->finish;
    return $res->{$field};
    } elsif ($self->has_extended_attributes) { # else, then we mandatory have extend attr
        my $sth = $self->db->prepare_cached(
            sprintf(
                q{select value from %s where id = ? and attr = ?},
                $self->db->quote_identifier($self->object_table. '_attributes'),
            )
        );
        $sth->execute($self->id, $field);
        my $res = $sth->fetchrow_hashref;
        $sth->finish;
        return $res->{value};
    }
}

sub set_fields {
    my ($self, %data) = @_;
    my @fields;
    my @vals;
    my %ext;
    my $inl = $self->_inline_fields('w') || {};
    my %inline = map { $inl->{$_} => 1 }  keys %{ $inl || {}};
    foreach my $field (keys %data) {
        my $oldval = $self->get_field($field);
        next if (($data{$field} || '') eq ($oldval || ''));
        if ($inline{$field}) {
        # TODO check fields exists !
        push(@fields, sprintf("%s = ?", $self->db->quote_identifier($field)));
        push(@vals, $data{$field});
        } else {
            $ext{$field} = $data{$field};
        }
    }
    if (@fields) {
        my $sth = $self->db->prepare_cached(
            sprintf(
                q{update %s set %s where %s = ?},
                $self->quote_object_table,
                join(', ', @fields),
                $self->quote_key_field,
            )
        );
        $sth->execute(@vals, $self->id);
    }
    
    if ($self->has_extended_attributes) {
        my $sthd = $self->db->prepare_cached(
            sprintf(
                q{delete from %s where id = ? and attr = ?},
                $self->db->quote_identifier($self->object_table. '_attributes'),
            ),
        );
        my $sthx = $self->db->prepare_cached(
            sprintf(
                q{insert into %s (id, attr, value) values (?,?,?)},
                $self->db->quote_identifier($self->object_table. '_attributes'),
            )
        );
        my $sthu = $self->db->prepare_cached(
            sprintf(
                q{update %s set value = ? where id = ? and attr = ?},
                $self->db->quote_identifier($self->object_table. '_attributes'),
            )
        );

        foreach (keys %ext) {
            if ($ext{$_}) {
                $sthu->execute($ext{$_}, $self->id, $_) ||
                $sthx->execute($self->id, $_, $ext{$_}) or return;
            } else {
                $sthd->execute($self->id, $_) or return;
            }
        }
    }

    1;
}

1;

__END__

=head1 SEE ALSO

=head1 AUTHOR

Olivier Thauvin, E<lt>olivier.thauvin@latmos.ipsl.frE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2008, 2009 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