Bug 5010: Fix OPACBaseURL to include protocol
[srvgit] / C4 / Context.pm
index 74b5c24..452b764 100644 (file)
@@ -3,18 +3,18 @@ package C4::Context;
 #
 # This file is part of Koha.
 #
-# Koha is free software; you can redistribute it and/or modify it under the
-# terms of the GNU General Public License as published by the Free Software
-# Foundation; either version 2 of the License, or (at your option) any later
-# version.
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
 #
-# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
-# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
 #
-# You should have received a copy of the GNU General Public License along
-# with Koha; if not, write to the Free Software Foundation, Inc.,
-# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
 
 use strict;
 use warnings;
@@ -97,11 +97,13 @@ BEGIN {
     $VERSION = '3.07.00.049';
 }
 
-use DBI;
+use DBIx::Connector;
+use Encode;
 use ZOOM;
 use XML::Simple;
 use C4::Boolean;
 use C4::Debug;
+use Koha;
 use POSIX ();
 use DateTime::TimeZone;
 use Module::Load::Conditional qw(can_load);
@@ -203,36 +205,6 @@ $context = undef;        # Initially, no context is set
 @context_stack = ();        # Initially, no saved contexts
 
 
-=head2 KOHAVERSION
-
-returns the kohaversion stored in kohaversion.pl file
-
-=cut
-
-sub KOHAVERSION {
-    my $cgidir = C4::Context->intranetdir;
-
-    # Apparently the GIT code does not run out of a CGI-BIN subdirectory
-    # but distribution code does?  (Stan, 1jan08)
-    if(-d $cgidir . "/cgi-bin"){
-        my $cgidir .= "/cgi-bin";
-    }
-    
-    do $cgidir."/kohaversion.pl" || die "NO $cgidir/kohaversion.pl";
-    return kohaversion();
-}
-
-=head2 final_linear_version
-
-Returns the version number of the final update to run in updatedatabase.pl.
-This number is equal to the version in kohaversion.pl
-
-=cut
-
-sub final_linear_version {
-    return KOHAVERSION;
-}
-
 =head2 read_config_file
 
 Reads the specified Koha config file. 
@@ -637,6 +609,11 @@ sub set_preference {
 
     $value = 0 if ( $type && $type eq 'YesNo' && $value eq '' );
 
+    # force explicit protocol on OPACBaseURL
+    if ($var eq 'opacbaseurl' && substr($value,0,4) !~ /http/) {
+        $value = 'http://' . $value;
+    }
+
     my $sth = $dbh->prepare( "
       INSERT INTO systempreferences
         ( variable, value )
@@ -782,8 +759,13 @@ sub _new_dbh
     my $db_user   = $context->config("user");
     my $db_passwd = $context->config("pass");
     # MJR added or die here, as we can't work without dbh
-    my $dbh = DBI->connect("DBI:$db_driver:dbname=$db_name;host=$db_host;port=$db_port",
-    $db_user, $db_passwd, {'RaiseError' => $ENV{DEBUG}?1:0 }) or die $DBI::errstr;
+    my $dbh = DBIx::Connector->connect(
+        "dbi:$db_driver:dbname=$db_name;host=$db_host;port=$db_port",
+        $db_user, $db_passwd,
+        {
+            'RaiseError' => $ENV{DEBUG} ? 1 : 0
+        }
+    );
 
     # Check for the existence of a systempreference table; if we don't have this, we don't
     # have a valid database and should not set RaiseError in order to allow the installer
@@ -1085,9 +1067,10 @@ sub userenv {
 
 =head2 set_userenv
 
-  C4::Context->set_userenv($usernum, $userid, $usercnum, $userfirstname, 
-                  $usersurname, $userbranch, $userflags, $emailaddress, $branchprinter,
-                  $persona);
+  C4::Context->set_userenv($usernum, $userid, $usercnum,
+                           $userfirstname, $usersurname,
+                           $userbranch, $branchname, $userflags,
+                           $emailaddress, $branchprinter, $persona);
 
 Establish a hash of user environment variables.
 
@@ -1097,6 +1080,7 @@ set_userenv is called in Auth.pm
 
 #'
 sub set_userenv {
+    shift @_;
     my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $branchname, $userflags, $emailaddress, $branchprinter, $persona, $shibboleth)=
     map { Encode::is_utf8( $_ ) ? $_ : Encode::decode('UTF-8', $_) } # CGI::Session doesn't handle utf-8, so we decode it here
     @_;
@@ -1191,7 +1175,7 @@ Gets various version info, for core Koha packages, Currently called from carp ha
 # A little example sub to show more debugging info for CGI::Carp
 sub get_versions {
     my %versions;
-    $versions{kohaVersion}  = KOHAVERSION();
+    $versions{kohaVersion}  = Koha::version();
     $versions{kohaDbVersion} = C4::Context->preference('version');
     $versions{osVersion} = join(" ", POSIX::uname());
     $versions{perlVersion} = $];