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

(-)a/C4/Context.pm (-23 / +24 lines)
Lines 32-38 BEGIN { Link Here
32
			    eval {C4::Context->dbh();};
32
			    eval {C4::Context->dbh();};
33
			    if ($@){
33
			    if ($@){
34
				$debug_level = 1;
34
				$debug_level = 1;
35
			    } 
35
			    }
36
			    else {
36
			    else {
37
				$debug_level =  C4::Context->preference("DebugLevel");
37
				$debug_level =  C4::Context->preference("DebugLevel");
38
			    }
38
			    }
Lines 50-56 BEGIN { Link Here
50
		# a little example table with various version info";
50
		# a little example table with various version info";
51
					print "
51
					print "
52
						<h1>Koha error</h1>
52
						<h1>Koha error</h1>
53
						<p>The following fatal error has occurred:</p> 
53
						<p>The following fatal error has occurred:</p>
54
                        <pre><code>$msg</code></pre>
54
                        <pre><code>$msg</code></pre>
55
						<table>
55
						<table>
56
						<tr><th>Apache</th><td>  $versions{apacheVersion}</td></tr>
56
						<tr><th>Apache</th><td>  $versions{apacheVersion}</td></tr>
Lines 64-74 BEGIN { Link Here
64
				} elsif ($debug_level eq "1"){
64
				} elsif ($debug_level eq "1"){
65
					print "
65
					print "
66
						<h1>Koha error</h1>
66
						<h1>Koha error</h1>
67
						<p>The following fatal error has occurred:</p> 
67
						<p>The following fatal error has occurred:</p>
68
                        <pre><code>$msg</code></pre>";
68
                        <pre><code>$msg</code></pre>";
69
				} else {
69
				} else {
70
					print "<p>production mode - trapped fatal error</p>";
70
					print "<p>production mode - trapped fatal error</p>";
71
				}       
71
				}
72
                print "</body></html>";
72
                print "</body></html>";
73
			}
73
			}
74
		#CGI::Carp::set_message(\&handle_errors);
74
		#CGI::Carp::set_message(\&handle_errors);
Lines 161-167 environment variable to the pathname of a configuration file to use. Link Here
161
# 1. Path supplied via use C4::Context '/path/to/koha-conf.xml'
161
# 1. Path supplied via use C4::Context '/path/to/koha-conf.xml'
162
# 2. Path supplied in KOHA_CONF environment variable.
162
# 2. Path supplied in KOHA_CONF environment variable.
163
# 3. Path supplied in INSTALLED_CONFIG_FNAME, as long
163
# 3. Path supplied in INSTALLED_CONFIG_FNAME, as long
164
#    as value has changed from its default of 
164
#    as value has changed from its default of
165
#    '__KOHA_CONF_DIR__/koha-conf.xml', as happens
165
#    '__KOHA_CONF_DIR__/koha-conf.xml', as happens
166
#    when Koha is installed in 'standard' or 'single'
166
#    when Koha is installed in 'standard' or 'single'
167
#    mode.
167
#    mode.
Lines 171-184 environment variable to the pathname of a configuration file to use. Link Here
171
171
172
use constant CONFIG_FNAME => "/etc/koha/koha-conf.xml";
172
use constant CONFIG_FNAME => "/etc/koha/koha-conf.xml";
173
                # Default config file, if none is specified
173
                # Default config file, if none is specified
174
                
174
175
my $INSTALLED_CONFIG_FNAME = '__KOHA_CONF_DIR__/koha-conf.xml';
175
my $INSTALLED_CONFIG_FNAME = '__KOHA_CONF_DIR__/koha-conf.xml';
176
                # path to config file set by installer
176
                # path to config file set by installer
177
                # __KOHA_CONF_DIR__ is set by rewrite-confg.PL
177
                # __KOHA_CONF_DIR__ is set by rewrite-confg.PL
178
                # when Koha is installed in 'standard' or 'single'
178
                # when Koha is installed in 'standard' or 'single'
179
                # mode.  If Koha was installed in 'dev' mode, 
179
                # mode.  If Koha was installed in 'dev' mode,
180
                # __KOHA_CONF_DIR__ is *not* rewritten; instead
180
                # __KOHA_CONF_DIR__ is *not* rewritten; instead
181
                # developers should set the KOHA_CONF environment variable 
181
                # developers should set the KOHA_CONF environment variable
182
182
183
$context = undef;        # Initially, no context is set
183
$context = undef;        # Initially, no context is set
184
@context_stack = ();        # Initially, no saved contexts
184
@context_stack = ();        # Initially, no saved contexts
Lines 198-210 sub KOHAVERSION { Link Here
198
    if(-d $cgidir . "/cgi-bin"){
198
    if(-d $cgidir . "/cgi-bin"){
199
        my $cgidir .= "/cgi-bin";
199
        my $cgidir .= "/cgi-bin";
200
    }
200
    }
201
    
201
202
    do $cgidir."/kohaversion.pl" || die "NO $cgidir/kohaversion.pl";
202
    do $cgidir."/kohaversion.pl" || die "NO $cgidir/kohaversion.pl";
203
    return kohaversion();
203
    return kohaversion();
204
}
204
}
205
=head2 read_config_file
205
=head2 read_config_file
206
206
207
Reads the specified Koha config file. 
207
Reads the specified Koha config file.
208
208
209
Returns an object containing the configuration variables. The object's
209
Returns an object containing the configuration variables. The object's
210
structure is a bit complex to the uninitiated ... take a look at the
210
structure is a bit complex to the uninitiated ... take a look at the
Lines 234-248 sub read_config_file { # Pass argument naming config file to read Link Here
234
234
235
# db_scheme2dbi
235
# db_scheme2dbi
236
# Translates the full text name of a database into de appropiate dbi name
236
# Translates the full text name of a database into de appropiate dbi name
237
# 
237
#
238
sub db_scheme2dbi {
238
sub db_scheme2dbi {
239
    my $name = shift;
239
    my $name = shift;
240
    # for instance, we support only mysql, so don't care checking
240
    # for instance, we support only mysql, so don't care checking
241
    return "mysql";
241
    return "mysql";
242
    for ($name) {
242
    for ($name) {
243
# FIXME - Should have other databases. 
243
# FIXME - Should have other databases.
244
        if (/mysql/) { return("mysql"); }
244
        if (/mysql/) { return("mysql"); }
245
        if (/Postgres|Pg|PostgresSQL/) { return("Pg"); }
245
        if (/Postgres|Pg|PostgresSQL|pgsql/) { return("Pg"); }
246
        if (/oracle/) { return("Oracle"); }
246
        if (/oracle/) { return("Oracle"); }
247
    }
247
    }
248
    return undef;         # Just in case
248
    return undef;         # Just in case
Lines 253-259 sub import { Link Here
253
    # the first time the module is called
253
    # the first time the module is called
254
    # (a config file can be optionaly passed)
254
    # (a config file can be optionaly passed)
255
255
256
    # default context allready exists? 
256
    # default context allready exists?
257
    return if $context;
257
    return if $context;
258
258
259
    # no ? so load it!
259
    # no ? so load it!
Lines 289-295 sub new { Link Here
289
    my $self = {};
289
    my $self = {};
290
290
291
    # check that the specified config file exists and is not empty
291
    # check that the specified config file exists and is not empty
292
    undef $conf_fname unless 
292
    undef $conf_fname unless
293
        (defined $conf_fname && -s $conf_fname);
293
        (defined $conf_fname && -s $conf_fname);
294
    # Figure out a good config file to load if none was specified.
294
    # Figure out a good config file to load if none was specified.
295
    if (!defined($conf_fname))
295
    if (!defined($conf_fname))
Lines 312-318 sub new { Link Here
312
        # Load the desired config file.
312
        # Load the desired config file.
313
    $self = read_config_file($conf_fname);
313
    $self = read_config_file($conf_fname);
314
    $self->{"config_file"} = $conf_fname;
314
    $self->{"config_file"} = $conf_fname;
315
    
315
316
    warn "read_config_file($conf_fname) returned undef" if !defined($self->{"config"});
316
    warn "read_config_file($conf_fname) returned undef" if !defined($self->{"config"});
317
    return undef if !defined($self->{"config"});
317
    return undef if !defined($self->{"config"});
318
318
Lines 557-566 sub AUTOLOAD Link Here
557
  $Zconn = C4::Context->Zconn
557
  $Zconn = C4::Context->Zconn
558
558
559
Returns a connection to the Zebra database for the current
559
Returns a connection to the Zebra database for the current
560
context. If no connection has yet been made, this method 
560
context. If no connection has yet been made, this method
561
creates one and connects.
561
creates one and connects.
562
562
563
C<$self> 
563
C<$self>
564
564
565
C<$server> one of the servers defined in the koha-conf.xml file
565
C<$server> one of the servers defined in the koha-conf.xml file
566
566
Lines 621-627 sub _new_Zconn { Link Here
621
    my $servername = $context->{"config"}->{$server};
621
    my $servername = $context->{"config"}->{$server};
622
    my $user = $context->{"serverinfo"}->{$server}->{"user"};
622
    my $user = $context->{"serverinfo"}->{$server}->{"user"};
623
    my $password = $context->{"serverinfo"}->{$server}->{"password"};
623
    my $password = $context->{"serverinfo"}->{$server}->{"password"};
624
 $auth = 1 if($user && $password);   
624
 $auth = 1 if($user && $password);
625
    retry:
625
    retry:
626
    eval {
626
    eval {
627
        # set options
627
        # set options
Lines 676-682 sub _new_dbh Link Here
676
{
676
{
677
677
678
    ## $context
678
    ## $context
679
    ## correct name for db_schme        
679
    ## correct name for db_scheme
680
    my $db_driver;
680
    my $db_driver;
681
    if ($context->config("db_scheme")){
681
    if ($context->config("db_scheme")){
682
        $db_driver=db_scheme2dbi($context->config("db_scheme"));
682
        $db_driver=db_scheme2dbi($context->config("db_scheme"));
Lines 693-699 sub _new_dbh Link Here
693
    my $dbh= DBI->connect("DBI:$db_driver:dbname=$db_name;host=$db_host;port=$db_port",
693
    my $dbh= DBI->connect("DBI:$db_driver:dbname=$db_name;host=$db_host;port=$db_port",
694
    $db_user, $db_passwd, {'RaiseError' => $ENV{DEBUG}?1:0 }) or die $DBI::errstr;
694
    $db_user, $db_passwd, {'RaiseError' => $ENV{DEBUG}?1:0 }) or die $DBI::errstr;
695
	my $tz = $ENV{TZ};
695
	my $tz = $ENV{TZ};
696
    if ( $db_driver eq 'mysql' ) { 
696
    if ( $db_driver eq 'mysql' ) {
697
        # Koha 3.0 is utf-8, so force utf8 communication between mySQL and koha, whatever the mysql default config.
697
        # Koha 3.0 is utf-8, so force utf8 communication between mySQL and koha, whatever the mysql default config.
698
        # this is better than modifying my.cnf (and forcing all communications to be in utf8)
698
        # this is better than modifying my.cnf (and forcing all communications to be in utf8)
699
        $dbh->{'mysql_enable_utf8'}=1; #enable
699
        $dbh->{'mysql_enable_utf8'}=1; #enable
Lines 702-708 sub _new_dbh Link Here
702
    }
702
    }
703
    elsif ( $db_driver eq 'Pg' ) {
703
    elsif ( $db_driver eq 'Pg' ) {
704
	    $dbh->do( "set client_encoding = 'UTF8';" );
704
	    $dbh->do( "set client_encoding = 'UTF8';" );
705
        ($tz) and $dbh->do(qq(SET TIME ZONE = "$tz"));
705
	    ($tz) and $dbh->do(qq(SET TIME ZONE = "$tz"));
706
    }
706
    }
707
    return $dbh;
707
    return $dbh;
708
}
708
}
Lines 932-938 sub userenv { Link Here
932
932
933
=head2 set_userenv
933
=head2 set_userenv
934
934
935
  C4::Context->set_userenv($usernum, $userid, $usercnum, $userfirstname, 
935
  C4::Context->set_userenv($usernum, $userid, $usercnum, $userfirstname,
936
                  $usersurname, $userbranch, $userflags, $emailaddress);
936
                  $usersurname, $userbranch, $userflags, $emailaddress);
937
937
938
Establish a hash of user environment variables.
938
Establish a hash of user environment variables.
Lines 1040-1045 sub get_versions { Link Here
1040
    {
1040
    {
1041
        no warnings qw(exec); # suppress warnings if unable to find a program in $PATH
1041
        no warnings qw(exec); # suppress warnings if unable to find a program in $PATH
1042
        $versions{mysqlVersion}  = `mysql -V`;
1042
        $versions{mysqlVersion}  = `mysql -V`;
1043
        $versions{psqlVersion}   = `psql -V`;
1043
        $versions{apacheVersion} = `httpd -v`;
1044
        $versions{apacheVersion} = `httpd -v`;
1044
        $versions{apacheVersion} = `httpd2 -v`            unless  $versions{apacheVersion} ;
1045
        $versions{apacheVersion} = `httpd2 -v`            unless  $versions{apacheVersion} ;
1045
        $versions{apacheVersion} = `apache2 -v`           unless  $versions{apacheVersion} ;
1046
        $versions{apacheVersion} = `apache2 -v`           unless  $versions{apacheVersion} ;
(-)a/C4/Koha.pm (-11 / +10 lines)
Lines 129-138 Returns a string with the name of the itemtype. Link Here
129
129
130
sub GetSupportName{
130
sub GetSupportName{
131
	my ($codestring)=@_;
131
	my ($codestring)=@_;
132
	return if (! $codestring); 
132
	return if (! $codestring);
133
	my $resultstring;
133
	my $resultstring;
134
	my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
134
	my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
135
	if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {  
135
	if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {
136
		my $query = qq|
136
		my $query = qq|
137
			SELECT description
137
			SELECT description
138
			FROM   itemtypes
138
			FROM   itemtypes
Lines 184-190 build a HTML select with the following code : Link Here
184
184
185
sub GetSupportList{
185
sub GetSupportList{
186
	my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
186
	my $advanced_search_types = C4::Context->preference("AdvancedSearchTypes");
187
	if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {  
187
	if (!$advanced_search_types or $advanced_search_types eq 'itemtypes') {
188
		my $query = qq|
188
		my $query = qq|
189
			SELECT *
189
			SELECT *
190
			FROM   itemtypes
190
			FROM   itemtypes
Lines 591-597 sub getImageSets { Link Here
591
        push @imagesets, { imagesetname => $imagesubdir,
591
        push @imagesets, { imagesetname => $imagesubdir,
592
                           imagesetactive => $imagesetactive,
592
                           imagesetactive => $imagesetactive,
593
                           images       => \@imagelist };
593
                           images       => \@imagelist };
594
        
594
595
    }
595
    }
596
    return \@imagesets;
596
    return \@imagesets;
597
}
597
}
Lines 1094-1103 sub GetKohaAuthorisedValues { Link Here
1094
  my %values;
1094
  my %values;
1095
  my $dbh = C4::Context->dbh;
1095
  my $dbh = C4::Context->dbh;
1096
  my $avcode = GetAuthValCode($kohafield,$fwcode);
1096
  my $avcode = GetAuthValCode($kohafield,$fwcode);
1097
  if ($avcode) {  
1097
  if ($avcode) {
1098
	my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1098
	my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1099
   	$sth->execute($avcode);
1099
   	$sth->execute($avcode);
1100
	while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) { 
1100
	while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1101
		$values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1101
		$values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1102
   	}
1102
   	}
1103
   	return \%values;
1103
   	return \%values;
Lines 1115-1121 $subfield can be undefined Link Here
1115
1115
1116
Returns hashref of Code => description
1116
Returns hashref of Code => description
1117
1117
1118
Returns undef if no authorised value category is defined for the given field and subfield 
1118
Returns undef if no authorised value category is defined for the given field and subfield
1119
1119
1120
=cut
1120
=cut
1121
1121
Lines 1125-1134 sub GetKohaAuthorisedValuesFromField { Link Here
1125
  my %values;
1125
  my %values;
1126
  my $dbh = C4::Context->dbh;
1126
  my $dbh = C4::Context->dbh;
1127
  my $avcode = GetAuthValCodeFromField($field, $subfield, $fwcode);
1127
  my $avcode = GetAuthValCodeFromField($field, $subfield, $fwcode);
1128
  if ($avcode) {  
1128
  if ($avcode) {
1129
	my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1129
	my $sth = $dbh->prepare("select authorised_value, lib, lib_opac from authorised_values where category=? ");
1130
   	$sth->execute($avcode);
1130
   	$sth->execute($avcode);
1131
	while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) { 
1131
	while ( my ($val, $lib, $lib_opac) = $sth->fetchrow_array ) {
1132
		$values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1132
		$values{$val} = ($opac && $lib_opac) ? $lib_opac : $lib;
1133
   	}
1133
   	}
1134
   	return \%values;
1134
   	return \%values;
Lines 1317-1323 sub _normalize_match_point { Link Here
1317
sub _isbn_cleanup {
1317
sub _isbn_cleanup {
1318
    my $isbn = Business::ISBN->new( $_[0] );
1318
    my $isbn = Business::ISBN->new( $_[0] );
1319
    if ( $isbn ) {
1319
    if ( $isbn ) {
1320
        $isbn = $isbn->as_isbn10 if $isbn->type eq 'ISBN13';
1320
        $isbn = $isbn->as_isbn10 if $isbn->tHOW COLUMNS FROMype eq 'ISBN13';
1321
        if (defined $isbn) {
1321
        if (defined $isbn) {
1322
            return $isbn->as_string([]);
1322
            return $isbn->as_string([]);
1323
        }
1323
        }
1324
- 

Return to bug 7365