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

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

use 5.010000;
use strict;
use warnings;

use base qw(LATMOS::Accounts::Bases);
use LATMOS::Accounts::Log;
use DBI;

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 new {
    my ($class, %options) = @_;
    
    my $base = {
        db_conn => $options{db_conn},
    };

    bless($base, $class);
}

sub DESTROY {
    my ($self) = @_;
    $self->{_db} && $self->{_db}->rollback;
}

sub db {
    my ($self) = @_;

    if ($self->{_db} && $self->{_db}->ping) {
        return $self->{_db};
    } else {
        $self->{_db} = DBI->connect_cached(
            'dbi:Pg:' . $self->{db_conn},
            undef, undef,
            {
                RaiseError => 1,
                AutoCommit => 0,
                PrintWarn => 1,
                PrintError => 1,
            }
        ) or do {
            $self->log(LA_ERR, "Cannot connect to database");   
            return;
        };
        $self->{_db}->do(q{set DATESTYLE to 'DMY'});
        $self->log(LA_DEBUG, 'New connection to DB');
        return $self->{_db};
    }
}

=head2 load

Read file and load data into memory

=cut

sub load {
    my ($self) = @_;
    return $self->db ? 1 : 0;    
}

sub commit {
    my ($self) = @_;
    if ($ENV{LA_NO_COMMIT}) {
        $self->log(LA_DEBUG, 'DB::COMMIT (ignore due to LA_NO_COMMIT)');
        return 1;
    } else {
        $self->log(LA_DEBUG, 'DB::COMMIT');
    }
    $self->db->commit;
}

sub rollback {
    my ($self) = @_;
    if ($ENV{LA_NO_COMMIT}) {
        $self->log(LA_DEBUG, 'DB::ROLLBACK (ignore due to LA_NO_COMMIT)');
        return 1
    } else {
        $self->log(LA_DEBUG, 'DB::ROLLBACK');
    }
    $self->db->rollback;
}

sub list_supported_objects {
    my ($self, @otype) = @_;
    $self->SUPER::list_supported_objects(qw(site), @otype);
}

sub current_rev {
    my ($self) = @_;
    my $sth = $self->db->prepare_cached(
        q{select max(rev) from revisions}
    );
    $sth->execute;
    my $res = $sth->fetchrow_hashref;
    $sth->finish;
    return ($res->{max});
} 

sub get_global_value {
    my ($self, $varname) = @_;

    my $sth = $self->db->prepare_cached(q{
        select val from settings where varname = ?
        });
    $sth->execute($varname);
    my $res = $sth->fetchrow_hashref;
    $sth->finish;
    $res->{val}
}

sub set_global_value {
    my ($self, $varname, $value) = @_;
    my $sth = $self->db->prepare(q{
        update settings set val = ? where varname = ?
        });
    $sth->execute($value, $varname) == 0 and do {
        my $sth2 = $self->db->prepare(q{
            insert into settings (val, varname) values (?,?)
            });
        $sth2->execute($value, $varname);
    };
}

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