• Files
• Commits
• Log
• Graph
• Stats

package LIMS::DB;

# default Rose::DB default_connect_options() sets ChopBlanks => 1 which auto-trims
# trailing spaces from data retrieved from CHAR fields (but is also incorrectly
# applied to request_lab_test_results.result VARCHAR(255) field)

use strict;
use warnings;

BEGIN {
    use Rose::DB;

    # set locale for DateTime objects so it parses EU date format correctly:
    # don't need this if passing DateTime objects internally:
    # Rose::DateTime::Util->european_dates(1);

    use DateTime; DateTime->DefaultLocale('en_GB'); # set default locale for app

    use LIMS::Local::Config;
    our @ISA = qw(Rose::DB);

    # safely default to test db - requires env variable setting (lims_server.pl to change db):
    #__PACKAGE__->default_domain( $ENV{RDB_DOMAIN} || 'test' );
}

my $cfg = LIMS::Local::Config->instance;

my ($dsn, $userid, $pwd) = @{ $cfg->{dbh_params} }; # arrayref
my $db = 'lims_test'; # overridden in config/rosedb_devinit.pl

# Use a private registry for this class
__PACKAGE__->use_private_registry;

# default data source (test) using the default type and domain:
# modified for production/devel using $ENV{ROSEDB_DEVINIT} in lims_server.pl
__PACKAGE__->register_db(
    domain   => __PACKAGE__->default_domain, # not strictly necessary as ..
    type     => __PACKAGE__->default_type,   # they are default settings anyway
    driver   => 'mysql',
    host     => 'localhost',
    database => $db,
    username => $userid, # or could define in ROSEDBRC file
    password => $pwd,
);

__PACKAGE__->auto_load_fixups; # loads defs in rosedb_devinit.pl

1;

__END__

=begin # to monitor dbh construction dynamics:
sub dbi_connect {
    warn "Initializing dbh ".Carp::longmess unless $ENV{HARNESS_ACTIVE};
    shift->SUPER::dbi_connect(@_);
}
=cut

=begin
sub new_or_cached {
    warn 'new_or_cached() called';
    shift->SUPER::new_or_cached(@_);
}
=cut

=begin # defined in rosedb_init.pl using ROSEDB_DEVINIT env flag
# data source for development - switched on my env var in lims_server.pl:
__PACKAGE__->register_db(
    domain   => 'development',
#    type     => 'mysql', # probably don't need this - not used
    driver   => 'mysql',
    host     => 'localhost',
    database => $db,
    username => $userid,
    password => $pwd,
);

# data source for production - not used yet but will need flag somewhere to activate (mod_perl / fastcgi ?)
__PACKAGE__->register_db(
    domain   => 'production',
#    type     => 'mysql', # probably don't need this - not used
    driver   => 'mysql',
    host     => 'localhost',
    database => 'some_production_db',
    username => $userid,
    password => $pwd,
);
=cut

=begin # override default dbi_connect for DBI->trace:
sub dbi_connect {
    my $self = shift;

    my @dsn = ($self->dsn, $self->username, $self->password); # warn $self->dsn;
    my %attr = (
        PrintError => 0,
        RaiseError => 1,
        ChopBlanks => 0, # default RDBO setting is on, causes auto-trimming of values
    );

    # for fastcgi, this can be set in .fcgi script
    # DBI->trace(1, '/home/raj/apps/HILIS4/logs/trace.log');

    my $dbh = DBI->connect_cached(@dsn, \%attr);

#=begin # this works, but don't get bind_params (sth method):
    $dbh->{Callbacks}->{prepare} = sub {
        my ($dbh, $sql, $attr) = @_;
        #warn 'SQL:'.$sql;
        #warn Dumper $self->user_profile; # doesn't exist:
        # object is 'LIMS::DB::__RoseDBPrivate__::Rose::DB::MySQL'
        return;
    };
#=cut
    return $dbh;
}
=cut

=begin # override default dbi_connect to initialise Log4perl:
sub dbi_connect {
    my $self = shift;

    use Log::Log4perl qw(:easy); # use with Log::Log4perl->easy_init for logging to console
    use DBIx::Log4perl;

    # Log::Log4perl->init("$path_to_app/config/settings/log4perl.conf");
    Log::Log4perl->easy_init(
        {
            level   => $DEBUG,
            file    => '>' . "$path_to_app/logs/dbi.log",
        }
     );

    my @dsn = ($self->dsn, $self->username, $self->password); # warn $self->dsn;
    my %attr = (
        PrintError => 0,
        RaiseError => 1,
    );


    my $dbh = $ENV{ROSEDB_DEVINIT}              ? # only want sql output for devel/production:
        DBIx::Log4perl->connect(@dsn, \%attr)   :
                   DBI->connect(@dsn, \%attr)   ;

    return $dbh;
}
=cut