View | Details | Raw Unified | Return to bug 14375
Collapse All | Expand All

(-)a/C4/Context.pm (-86 / +20 lines)
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
- 

Return to bug 14375