package LIMS::RDBO; # base class for all LIMS::DB::* classes which need to initialise db connection # (sub init_db {LIMS::DB->new }) use strict; use warnings; use LIMS::DB; use Data::Dumper; use LIMS::Local::Config; use Rose::DB::Object 0.8081; # in app's local lib, patched to correct broken 'warn' #1128 use base qw(Rose::DB::Object); BEGIN { # dump RDBO queries to stdout; default OFF - requires specific env flag: my $want_debug = ( grep $ENV{$_}, qw(RDBO_DEBUG RDBO_DEBUG_ON) ); $Rose::DB::Object::Debug = $Rose::DB::Object::Manager::Debug = $want_debug; # idea from http://www.mail-archive.com/cgiapp@lists.erlbaum.net/msg02886.html : # $SIG{__WARN__} = sub { LIMS::Local::QueryLog->log->warn(shift) }; # this works, but dumps all warns to file, not just RDBO ones !! # $SIG{__WARN__} = sub { &_warn_handler(@_); } # use LIMS::Local::QueryLog; # moved to LIMS so it can pass authen->username } use Rose::DB::Object::Helpers qw( insert_or_update_on_duplicate_key column_value_pairs insert_or_update load_speculative load_or_insert dirty_columns as_tree clone ); sub init_db { LIMS::DB->new_or_cached; } # sub init_db { my $o = LIMS::DB->new_or_cached; warn Dumper $o; return $o } sub lims_config { LIMS::Local::Config->instance; } =begin my $i; sub init_db { # warn Dumper [$i, $i % 500 ]; my $db = LIMS::DB->new_or_cached; # not sure this is safe for transactions - see README # to drop & re-connect every 500 cycles: unless ( ++$i % 500 ) { warn $i; $db->disconnect(); # forces automatic reconnection with new dbh } # warn $db->dbh; # dumps memory address - should have changed since #499 # use DBI::Profile; # $db->dbh->{Profile} = DBI::Profile->new(); # $db->dbh->{Profile} = 2; my $CachedKids = $db->dbh->{CachedKids}; # warn Dumper $CachedKids; # %$CachedKids = () if $CachedKids; # to reset return $db; } =cut 1;