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

(-)a/C4/Context.pm (-86 / +22 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 719-729 sub _new_Zconn { Link Here
719
    return $Zconn;
716
    return $Zconn;
720
}
717
}
721
718
722
# _new_dbh
719
# _new_DBconn
723
# Internal helper function (not a method!). This creates a new
720
# Internal helper function (not a method!). This creates a new
724
# database connection from the data given in the current context, and
721
# database connection from the data given in the current context, and
725
# returns it.
722
# returns it.
726
sub _new_dbh
723
sub _new_DBconn
727
{
724
{
728
725
729
    ## $context
726
    ## $context
Lines 735-748 sub _new_dbh Link Here
735
    my $db_port   = $context->config("port") || '';
732
    my $db_port   = $context->config("port") || '';
736
    my $db_user   = $context->config("user");
733
    my $db_user   = $context->config("user");
737
    my $db_passwd = $context->config("pass");
734
    my $db_passwd = $context->config("pass");
738
    # MJR added or die here, as we can't work without dbh
735
    # MJR added or die here, as we can't work without database connection
739
    my $dbh = DBIx::Connector->connect(
736
    my $DBconn = DBIx::Connector->new(
740
        "dbi:$db_driver:dbname=$db_name;host=$db_host;port=$db_port",
737
        "dbi:$db_driver:dbname=$db_name;host=$db_host;port=$db_port",
741
        $db_user, $db_passwd,
738
        $db_user, $db_passwd,
742
        {
739
        {
743
            'RaiseError' => $ENV{DEBUG} ? 1 : 0
740
            'RaiseError' => $ENV{DEBUG} ? 1 : 0,
741
            'mysql_enable_utf8' => 1,
744
        }
742
        }
745
    );
743
    );
744
    # Get handler from connector
745
    my $dbh = $DBconn->dbh;
746
746
747
    # Check for the existence of a systempreference table; if we don't have this, we don't
747
    # Check for the existence of a systempreference table; if we don't have this, we don't
748
    # have a valid database and should not set RaiseError in order to allow the installer
748
    # have a valid database and should not set RaiseError in order to allow the installer
Lines 760-768 sub _new_dbh Link Here
760
760
761
	my $tz = $ENV{TZ};
761
	my $tz = $ENV{TZ};
762
    if ( $db_driver eq 'mysql' ) { 
762
    if ( $db_driver eq 'mysql' ) { 
763
        # Koha 3.0 is utf-8, so force utf8 communication between mySQL and koha, whatever the mysql default config.
763
        # Koha 3.0 is utf-8, so force utf8 communication between MySQL and koha, whatever the MySQL default config.
764
        # this is better than modifying my.cnf (and forcing all communications to be in utf8)
764
        # this is better than modifying my.cnf (and forcing all communications to be in utf8)
765
        $dbh->{'mysql_enable_utf8'}=1; #enable
766
        $dbh->do("set NAMES 'utf8'");
765
        $dbh->do("set NAMES 'utf8'");
767
        ($tz) and $dbh->do(qq(SET time_zone = "$tz"));
766
        ($tz) and $dbh->do(qq(SET time_zone = "$tz"));
768
    }
767
    }
Lines 770-776 sub _new_dbh Link Here
770
	    $dbh->do( "set client_encoding = 'UTF8';" );
769
	    $dbh->do( "set client_encoding = 'UTF8';" );
771
        ($tz) and $dbh->do(qq(SET TIME ZONE = "$tz"));
770
        ($tz) and $dbh->do(qq(SET TIME ZONE = "$tz"));
772
    }
771
    }
773
    return $dbh;
772
    return $DBconn;
774
}
773
}
775
774
776
=head2 dbh
775
=head2 dbh
Lines 793-812 sub dbh Link Here
793
{
792
{
794
    my $self = shift;
793
    my $self = shift;
795
    my $params = shift;
794
    my $params = shift;
796
    my $sth;
797
795
798
    unless ( $params->{new} ) {
796
    if ( $context->{'DBconn'} && !$params->{'new'} ) {
799
        if ( defined($context->{db_driver}) && $context->{db_driver} eq 'mysql' && $context->{"dbh"} ) {
797
        # DBIx::Connector will manage database handler cache and reconnection
800
            return $context->{"dbh"};
798
        # See http://search.cpan.org/perldoc?DBIx%3A%3AConnector#dbh
801
        } elsif ( defined($context->{"dbh"}) && $context->{"dbh"}->ping() ) {
799
        return $context->{'DBconn'}->dbh;
802
            return $context->{"dbh"};
803
        }
804
    }
800
    }
805
801
806
    # No database handle or it died . Create one.
802
    # No database connection, create one.
807
    $context->{"dbh"} = &_new_dbh();
803
    $context->{'DBconn'} = &_new_DBconn;
808
804
809
    return $context->{"dbh"};
805
    return $context->{'DBconn'}->dbh;
810
}
806
}
811
807
812
=head2 new_dbh
808
=head2 new_dbh
Lines 816-822 sub dbh Link Here
816
Creates a new connection to the Koha database for the current context,
812
Creates a new connection to the Koha database for the current context,
817
and returns the database handle (a C<DBI::db> object).
813
and returns the database handle (a C<DBI::db> object).
818
814
819
The handle is not saved anywhere: this method is strictly a
815
The connection is not saved anywhere: this method is strictly a
820
convenience function; the point is that it knows which database to
816
convenience function; the point is that it knows which database to
821
connect to so that the caller doesn't have to know.
817
connect to so that the caller doesn't have to know.
822
818
Lines 826-891 connect to so that the caller doesn't have to know. Link Here
826
sub new_dbh
822
sub new_dbh
827
{
823
{
828
    my $self = shift;
824
    my $self = shift;
829
825
    return &_new_DBconn->dbh;
830
    return &_new_dbh();
831
}
832
833
=head2 set_dbh
834
835
  $my_dbh = C4::Connect->new_dbh;
836
  C4::Connect->set_dbh($my_dbh);
837
  ...
838
  C4::Connect->restore_dbh;
839
840
C<&set_dbh> and C<&restore_dbh> work in a manner analogous to
841
C<&set_context> and C<&restore_context>.
842
843
C<&set_dbh> saves the current database handle on a stack, then sets
844
the current database handle to C<$my_dbh>.
845
846
C<$my_dbh> is assumed to be a good database handle.
847
848
=cut
849
850
#'
851
sub set_dbh
852
{
853
    my $self = shift;
854
    my $new_dbh = shift;
855
856
    # Save the current database handle on the handle stack.
857
    # We assume that $new_dbh is all good: if the caller wants to
858
    # screw himself by passing an invalid handle, that's fine by
859
    # us.
860
    push @{$context->{"dbh_stack"}}, $context->{"dbh"};
861
    $context->{"dbh"} = $new_dbh;
862
}
863
864
=head2 restore_dbh
865
866
  C4::Context->restore_dbh;
867
868
Restores the database handle saved by an earlier call to
869
C<C4::Context-E<gt>set_dbh>.
870
871
=cut
872
873
#'
874
sub restore_dbh
875
{
876
    my $self = shift;
877
878
    if ($#{$context->{"dbh_stack"}} < 0)
879
    {
880
        # Stack underflow
881
        die "DBH stack underflow";
882
    }
883
884
    # Pop the old database handle and set it.
885
    $context->{"dbh"} = pop @{$context->{"dbh_stack"}};
886
887
    # FIXME - If it is determined that restore_context should
888
    # return something, then this function should, too.
889
}
826
}
890
827
891
=head2 queryparser
828
=head2 queryparser
892
- 

Return to bug 14375