Lines 170-180
environment variable to the pathname of a configuration file to use.
Link Here
|
170 |
# A reference-to-hash whose keys and values are the |
170 |
# A reference-to-hash whose keys and values are the |
171 |
# configuration variables and values specified in the config |
171 |
# configuration variables and values specified in the config |
172 |
# file (/etc/koha/koha-conf.xml). |
172 |
# file (/etc/koha/koha-conf.xml). |
173 |
# dbh |
173 |
# DBconn |
174 |
# A handle to the appropriate database for this context. |
174 |
# A connection to the appropriate database for this context. |
175 |
# dbh_stack |
|
|
176 |
# Used by &set_dbh and &restore_dbh to hold other database |
177 |
# handles for this context. |
178 |
# Zconn |
175 |
# Zconn |
179 |
# A connection object for the Zebra server |
176 |
# A connection object for the Zebra server |
180 |
|
177 |
|
Lines 365-371
sub new {
Link Here
|
365 |
warn "read_config_file($conf_fname) returned undef" if !defined($self->{"config"}); |
362 |
warn "read_config_file($conf_fname) returned undef" if !defined($self->{"config"}); |
366 |
return if !defined($self->{"config"}); |
363 |
return if !defined($self->{"config"}); |
367 |
|
364 |
|
368 |
$self->{"dbh"} = undef; # Database handle |
365 |
$self->{"DBconn"} = undef; # Database connexion |
369 |
$self->{"Zconn"} = undef; # Zebra Connections |
366 |
$self->{"Zconn"} = undef; # Zebra Connections |
370 |
$self->{"stopwords"} = undef; # stopwords list |
367 |
$self->{"stopwords"} = undef; # stopwords list |
371 |
$self->{"marcfromkohafield"} = undef; # the hash with relations between koha table fields and MARC field/subfield |
368 |
$self->{"marcfromkohafield"} = undef; # the hash with relations between koha table fields and MARC field/subfield |
Lines 521-528
sub preference {
Link Here
|
521 |
return $sysprefs{lc $var}; |
518 |
return $sysprefs{lc $var}; |
522 |
} |
519 |
} |
523 |
|
520 |
|
524 |
my $dbh = C4::Context->dbh or return 0; |
|
|
525 |
|
526 |
my $value; |
521 |
my $value; |
527 |
if ( defined $ENV{"OVERRIDE_SYSPREF_$var"} ) { |
522 |
if ( defined $ENV{"OVERRIDE_SYSPREF_$var"} ) { |
528 |
$value = $ENV{"OVERRIDE_SYSPREF_$var"}; |
523 |
$value = $ENV{"OVERRIDE_SYSPREF_$var"}; |
Lines 737-747
sub _new_Zconn {
Link Here
|
737 |
return $Zconn; |
732 |
return $Zconn; |
738 |
} |
733 |
} |
739 |
|
734 |
|
740 |
# _new_dbh |
735 |
# _new_DBconn |
741 |
# Internal helper function (not a method!). This creates a new |
736 |
# Internal helper function (not a method!). This creates a new |
742 |
# database connection from the data given in the current context, and |
737 |
# database connection from the data given in the current context, and |
743 |
# returns it. |
738 |
# returns it. |
744 |
sub _new_dbh |
739 |
sub _new_DBconn |
745 |
{ |
740 |
{ |
746 |
|
741 |
|
747 |
## $context |
742 |
## $context |
Lines 753-766
sub _new_dbh
Link Here
|
753 |
my $db_port = $context->config("port") || ''; |
748 |
my $db_port = $context->config("port") || ''; |
754 |
my $db_user = $context->config("user"); |
749 |
my $db_user = $context->config("user"); |
755 |
my $db_passwd = $context->config("pass"); |
750 |
my $db_passwd = $context->config("pass"); |
756 |
# MJR added or die here, as we can't work without dbh |
751 |
# MJR added or die here, as we can't work without database connection |
757 |
my $dbh = DBIx::Connector->connect( |
752 |
my $DBconn = DBIx::Connector->new( |
758 |
"dbi:$db_driver:dbname=$db_name;host=$db_host;port=$db_port", |
753 |
"dbi:$db_driver:dbname=$db_name;host=$db_host;port=$db_port", |
759 |
$db_user, $db_passwd, |
754 |
$db_user, $db_passwd, |
760 |
{ |
755 |
{ |
761 |
'RaiseError' => $ENV{DEBUG} ? 1 : 0 |
756 |
'RaiseError' => $ENV{DEBUG} ? 1 : 0 |
762 |
} |
757 |
} |
763 |
); |
758 |
); |
|
|
759 |
# Get handler from connector |
760 |
my $dbh = $DBconn->dbh; |
764 |
|
761 |
|
765 |
# Check for the existence of a systempreference table; if we don't have this, we don't |
762 |
# Check for the existence of a systempreference table; if we don't have this, we don't |
766 |
# have a valid database and should not set RaiseError in order to allow the installer |
763 |
# have a valid database and should not set RaiseError in order to allow the installer |
Lines 778-784
sub _new_dbh
Link Here
|
778 |
|
775 |
|
779 |
my $tz = $ENV{TZ}; |
776 |
my $tz = $ENV{TZ}; |
780 |
if ( $db_driver eq 'mysql' ) { |
777 |
if ( $db_driver eq 'mysql' ) { |
781 |
# Koha 3.0 is utf-8, so force utf8 communication between mySQL and koha, whatever the mysql default config. |
778 |
# Koha 3.0 is utf-8, so force utf8 communication between MySQL and koha, whatever the MySQL default config. |
782 |
# this is better than modifying my.cnf (and forcing all communications to be in utf8) |
779 |
# this is better than modifying my.cnf (and forcing all communications to be in utf8) |
783 |
$dbh->{'mysql_enable_utf8'}=1; #enable |
780 |
$dbh->{'mysql_enable_utf8'}=1; #enable |
784 |
$dbh->do("set NAMES 'utf8'"); |
781 |
$dbh->do("set NAMES 'utf8'"); |
Lines 788-794
sub _new_dbh
Link Here
|
788 |
$dbh->do( "set client_encoding = 'UTF8';" ); |
785 |
$dbh->do( "set client_encoding = 'UTF8';" ); |
789 |
($tz) and $dbh->do(qq(SET TIME ZONE = "$tz")); |
786 |
($tz) and $dbh->do(qq(SET TIME ZONE = "$tz")); |
790 |
} |
787 |
} |
791 |
return $dbh; |
788 |
return $DBconn; |
792 |
} |
789 |
} |
793 |
|
790 |
|
794 |
=head2 dbh |
791 |
=head2 dbh |
Lines 811-830
sub dbh
Link Here
|
811 |
{ |
808 |
{ |
812 |
my $self = shift; |
809 |
my $self = shift; |
813 |
my $params = shift; |
810 |
my $params = shift; |
814 |
my $sth; |
|
|
815 |
|
811 |
|
816 |
unless ( $params->{new} ) { |
812 |
if ( $context->{'DBconn'} && !$params->{'new'} ) { |
817 |
if ( defined($context->{db_driver}) && $context->{db_driver} eq 'mysql' && $context->{"dbh"} ) { |
813 |
# DBIx::Connector will manage database handler cache and reconnection |
818 |
return $context->{"dbh"}; |
814 |
# See http://search.cpan.org/perldoc?DBIx%3A%3AConnector#dbh |
819 |
} elsif ( defined($context->{"dbh"}) && $context->{"dbh"}->ping() ) { |
815 |
return $context->{'DBconn'}->dbh; |
820 |
return $context->{"dbh"}; |
|
|
821 |
} |
822 |
} |
816 |
} |
823 |
|
817 |
|
824 |
# No database handle or it died . Create one. |
818 |
# No database connection, create one. |
825 |
$context->{"dbh"} = &_new_dbh(); |
819 |
$context->{'DBconn'} = &_new_DBconn; |
826 |
|
820 |
|
827 |
return $context->{"dbh"}; |
821 |
return $context->{'DBconn'}->dbh; |
828 |
} |
822 |
} |
829 |
|
823 |
|
830 |
=head2 new_dbh |
824 |
=head2 new_dbh |
Lines 834-840
sub dbh
Link Here
|
834 |
Creates a new connection to the Koha database for the current context, |
828 |
Creates a new connection to the Koha database for the current context, |
835 |
and returns the database handle (a C<DBI::db> object). |
829 |
and returns the database handle (a C<DBI::db> object). |
836 |
|
830 |
|
837 |
The handle is not saved anywhere: this method is strictly a |
831 |
The connection is not saved anywhere: this method is strictly a |
838 |
convenience function; the point is that it knows which database to |
832 |
convenience function; the point is that it knows which database to |
839 |
connect to so that the caller doesn't have to know. |
833 |
connect to so that the caller doesn't have to know. |
840 |
|
834 |
|
Lines 844-909
connect to so that the caller doesn't have to know.
Link Here
|
844 |
sub new_dbh |
838 |
sub new_dbh |
845 |
{ |
839 |
{ |
846 |
my $self = shift; |
840 |
my $self = shift; |
847 |
|
841 |
return &_new_DBconn->dbh; |
848 |
return &_new_dbh(); |
|
|
849 |
} |
850 |
|
851 |
=head2 set_dbh |
852 |
|
853 |
$my_dbh = C4::Connect->new_dbh; |
854 |
C4::Connect->set_dbh($my_dbh); |
855 |
... |
856 |
C4::Connect->restore_dbh; |
857 |
|
858 |
C<&set_dbh> and C<&restore_dbh> work in a manner analogous to |
859 |
C<&set_context> and C<&restore_context>. |
860 |
|
861 |
C<&set_dbh> saves the current database handle on a stack, then sets |
862 |
the current database handle to C<$my_dbh>. |
863 |
|
864 |
C<$my_dbh> is assumed to be a good database handle. |
865 |
|
866 |
=cut |
867 |
|
868 |
#' |
869 |
sub set_dbh |
870 |
{ |
871 |
my $self = shift; |
872 |
my $new_dbh = shift; |
873 |
|
874 |
# Save the current database handle on the handle stack. |
875 |
# We assume that $new_dbh is all good: if the caller wants to |
876 |
# screw himself by passing an invalid handle, that's fine by |
877 |
# us. |
878 |
push @{$context->{"dbh_stack"}}, $context->{"dbh"}; |
879 |
$context->{"dbh"} = $new_dbh; |
880 |
} |
881 |
|
882 |
=head2 restore_dbh |
883 |
|
884 |
C4::Context->restore_dbh; |
885 |
|
886 |
Restores the database handle saved by an earlier call to |
887 |
C<C4::Context-E<gt>set_dbh>. |
888 |
|
889 |
=cut |
890 |
|
891 |
#' |
892 |
sub restore_dbh |
893 |
{ |
894 |
my $self = shift; |
895 |
|
896 |
if ($#{$context->{"dbh_stack"}} < 0) |
897 |
{ |
898 |
# Stack underflow |
899 |
die "DBH stack underflow"; |
900 |
} |
901 |
|
902 |
# Pop the old database handle and set it. |
903 |
$context->{"dbh"} = pop @{$context->{"dbh_stack"}}; |
904 |
|
905 |
# FIXME - If it is determined that restore_context should |
906 |
# return something, then this function should, too. |
907 |
} |
842 |
} |
908 |
|
843 |
|
909 |
=head2 queryparser |
844 |
=head2 queryparser |
910 |
- |
|
|