# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id$
use strict;
+
+BEGIN {
+ if ($ENV{'HTTP_USER_AGENT'}) {
+ require CGI::Carp;
+ import CGI::Carp qw(fatalsToBrowser);
+ sub handle_errors {
+ my $msg = shift;
+ my $debug_level = C4::Context->preference("DebugLevel");
+
+ if ($debug_level eq "2"){
+ # debug 2 , print extra info too.
+ my %versions = get_versions();
+
+ # a little example table with various version info";
+ print "
+ <h1>debug level $debug_level </h1>
+ <p>Got an error: $msg</p>
+ <table>
+ <tr><th>Apache<td> $versions{apacheVersion}</tr>
+ <tr><th>Koha<td> $versions{kohaVersion}</tr>
+ <tr><th>MySQL<td> $versions{mysqlVersion}</tr>
+ <tr><th>OS<td> $versions{osVersion}</tr>
+ <tr><th>Perl<td> $versions{perlVersion}</tr>
+ </table>";
+
+ } elsif ($debug_level eq "1"){
+ print "<h1>debug level $debug_level </h1>";
+ print "<p>Got an error: $msg</p>";
+ } else {
+ print "production mode - trapped fatal";
+ }
+ }
+ CGI::Carp->set_message(\&handle_errors);
+ } # else there is no browser to send fatals to!
+}
+
use DBI;
use ZOOM;
use XML::Simple;
use C4::Boolean;
-use vars qw($VERSION $AUTOLOAD),
- qw($context),
- qw(@context_stack);
+use vars qw($VERSION $AUTOLOAD $context @context_stack);
-$VERSION = do { my @v = '$Revision$' =~ /\d+/g;
- shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
+$VERSION = '3.00.00.032';
=head1 NAME
$context = undef; # Initially, no context is set
@context_stack = (); # Initially, no saved contexts
+
+=item KOHAVERSION
+ returns the kohaversion stored in kohaversion.pl file
+=cut
+
+sub KOHAVERSION {
+ my $cgidir = C4::Context->intranetdir ."/cgi-bin";
+
+ # 2 cases here : on CVS install, $cgidir does not need a /cgi-bin
+ # on a standard install, /cgi-bin need to be added.
+ # test one, then the other
+ # FIXME - is this all really necessary?
+ unless (opendir(DIR, "$cgidir/cataloguing/value_builder")) {
+ $cgidir = C4::Context->intranetdir;
+ closedir(DIR);
+ }
+
+ do $cgidir."/kohaversion.pl" || die "NO $cgidir/kohaversion.pl";
+ return kohaversion();
+}
=item read_config_file
=over 4
=cut
-sub read_config_file {
- my $fname = shift; # Config file to read
- my $retval = {}; # Return value: ref-to-hash holding the configuration
- my $koha = XMLin($fname, keyattr => ['id'],forcearray => ['listen', 'server', 'serverinfo']);
- return $koha;
+sub read_config_file { # Pass argument naming config file to read
+ my $koha = XMLin(shift, keyattr => ['id'], forcearray => ['listen', 'server', 'serverinfo']);
+ return $koha; # Return value: ref-to-hash holding the configuration
}
# db_scheme2dbi
# Return the value of the requested config variable
return $context->{"server"}->{$var};
}
-sub zebraoptions
+sub ModZebrations
{
my $self = shift;
my $var = shift; # The config variable to return
my $self = shift;
my $var = shift; # The system preference to return
my $retval; # Return value
- my $dbh = C4::Context->dbh; # Database handle
- if ($dbh){
- my $sth; # Database query handle
-
+ my $dbh = C4::Context->dbh or return 0;
# Look up systempreferences.variable==$var
$retval = $dbh->selectrow_array(<<EOT);
SELECT value
LIMIT 1
EOT
return $retval;
- } else {
- return 0
- }
}
sub boolean_preference ($) {
my $syntax=shift;
if ( defined($context->{"Zconn"}->{$server}) ) {
return $context->{"Zconn"}->{$server};
-
# No connection object or it died. Create one.
}else {
$context->{"Zconn"}->{$server} = &_new_Zconn($server,$async,$auth,$piggyback,$syntax);
$syntax = "usmarc" unless $syntax;
my $host = $context->{'listen'}->{$server}->{'content'};
- my $user = $context->{"serverinfo"}->{$server}->{"user"};
my $servername = $context->{"config"}->{$server};
+ my $user = $context->{"serverinfo"}->{$server}->{"user"};
my $password = $context->{"serverinfo"}->{$server}->{"password"};
- warn "server:$server servername :$servername host:$host";
+ $auth = 1 if($user && $password);
retry:
eval {
# set options
my $o = new ZOOM::Options();
+ $o->option(user=>$user) if $auth;
+ $o->option(password=>$password) if $auth;
$o->option(async => 1) if $async;
$o->option(count => $piggyback) if $piggyback;
$o->option(cqlfile=> $context->{"server"}->{$server}->{"cql2rpn"});
$o->option(cclfile=> $context->{"serverinfo"}->{$server}->{"ccl2rpn"});
$o->option(preferredRecordSyntax => $syntax);
$o->option(elementSetName => "F"); # F for 'full' as opposed to B for 'brief'
- $o->option(user=>$user) if $auth;
- $o->option(password=>$password) if $auth;
$o->option(databaseName => ($servername?$servername:"biblios"));
# create a new connection object
# returns it.
sub _new_dbh
{
+
+### $context
##correct name for db_schme
my $db_driver;
if ($context->config("db_scheme")){
my $db_name = $context->config("database");
my $db_host = $context->config("hostname");
+ my $db_port = $context->config("port");
+ $db_port = "" unless defined $db_port;
my $db_user = $context->config("user");
my $db_passwd = $context->config("pass");
- my $dbh= DBI->connect("DBI:$db_driver:$db_name:$db_host",
- $db_user, $db_passwd);
- # Koha 3.0 is utf-8, so force utf8 communication between mySQL and koha, whatever the mysql default config.
- # this is better than modifying my.cnf (and forcing all communications to be in utf8)
- $dbh->do("set NAMES 'utf8'") if ($dbh);
+ my $dbh= DBI->connect("DBI:$db_driver:dbname=$db_name;host=$db_host;port=$db_port",
+ $db_user, $db_passwd);
+ if ( $db_driver eq 'mysql' ) {
+ # Koha 3.0 is utf-8, so force utf8 communication between mySQL and koha, whatever the mysql default config.
+ # this is better than modifying my.cnf (and forcing all communications to be in utf8)
+ $dbh->do("set NAMES 'utf8'") if ($dbh);
+ $dbh->{'mysql_enable_utf8'}=1; #enable
+ }
+ elsif ( $db_driver eq 'Pg' ) {
+ $dbh->do( "set client_encoding = 'UTF8';" );
+ }
return $dbh;
}
#'
sub set_userenv{
- my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $branchname, $userflags, $emailaddress)= @_;
+ my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $branchname, $userflags, $emailaddress, $branchprinter)= @_;
my $var=$context->{"activeuser"};
my $cell = {
"number" => $usernum,
"branchname" => $branchname,
"flags" => $userflags,
"emailaddress" => $emailaddress,
+ "branchprinter" => $branchprinter
};
$context->{userenv}->{$var} = $cell;
return $cell;
}
+=item get_versions
+
+ C4::Context->get_versions
+
+Gets various version info, for core Koha packages, Currently called from carp handle_errors() sub, to send to browser if 'DebugLevel' syspref is set to '2'.
+
+=cut
+
+#'
+
+# A little example sub to show more debugging info for CGI::Carp
+sub get_versions {
+ my %versions;
+ $versions{kohaVersion} = C4::Context->config("kohaversion");
+ $versions{osVersion} = `uname -a`;
+ $versions{perlVersion} = $];
+ $versions{mysqlVersion} = `mysql -V`;
+ $versions{apacheVersion} = `httpd -v`;
+ $versions{apacheVersion} = `httpd2 -v` unless $versions{apacheVersion} ;
+ $versions{apacheVersion} = `apache2 -v` unless $versions{apacheVersion} ;
+ $versions{apacheVersion} = `/usr/sbin/apache2 -v` unless $versions{apacheVersion} ;
+ return %versions;
+}
+
1;
__END__
=cut
-# $Log$
+# Revision 1.57 2007/05/22 09:13:55 tipaul
+# Bugfixes & improvements (various and minor) :
+# - updating templates to have tmpl_process3.pl running without any errors
+# - adding a drupal-like css for prog templates (with 3 small images)
+# - fixing some bugs in circulation & other scripts
+# - updating french translation
+# - fixing some typos in templates
+#
+# Revision 1.56 2007/04/23 15:21:17 tipaul
+# renaming currenttransfers to transferstoreceive
+#
+# Revision 1.55 2007/04/17 08:48:00 tipaul
+# circulation cleaning continued: bufixing
+#
+# Revision 1.54 2007/03/29 16:45:53 tipaul
+# Code cleaning of Biblio.pm (continued)
+#
+# All subs have be cleaned :
+# - removed useless
+# - merged some
+# - reordering Biblio.pm completly
+# - using only naming conventions
+#
+# Seems to have broken nothing, but it still has to be heavily tested.
+# Note that Biblio.pm is now much more efficient than previously & probably more reliable as well.
+#
+# Revision 1.53 2007/03/29 13:30:31 tipaul
+# Code cleaning :
+# == Biblio.pm cleaning (useless) ==
+# * some sub declaration dropped
+# * removed modbiblio sub
+# * removed moditem sub
+# * removed newitems. It was used only in finishrecieve. Replaced by a TransformKohaToMarc+AddItem, that is better.
+# * removed MARCkoha2marcItem
+# * removed MARCdelsubfield declaration
+# * removed MARCkoha2marcBiblio
+#
+# == Biblio.pm cleaning (naming conventions) ==
+# * MARCgettagslib renamed to GetMarcStructure
+# * MARCgetitems renamed to GetMarcItem
+# * MARCfind_frameworkcode renamed to GetFrameworkCode
+# * MARCmarc2koha renamed to TransformMarcToKoha
+# * MARChtml2marc renamed to TransformHtmlToMarc
+# * MARChtml2xml renamed to TranformeHtmlToXml
+# * zebraop renamed to ModZebra
+#
+# == MARC=OFF ==
+# * removing MARC=OFF related scripts (in cataloguing directory)
+# * removed checkitems (function related to MARC=off feature, that is completly broken in head. If someone want to reintroduce it, hard work coming...)
+# * removed getitemsbybiblioitem (used only by MARC=OFF scripts, that is removed as well)
+#
# Revision 1.52 2007/03/16 01:25:08 kados
# Using my precrash CVS copy I did the following:
#
# In this commit, I created a "fake" user when insecure=ON. It has a fake branch. You may find better to have the 1st branch in branch table instead of a fake one.
#
# Revision 1.43.2.8 2006/12/19 16:48:16 alaurin
-# reident programs, and adding branchcode value in reserves2
+# reident programs, and adding branchcode value in reserves
#
# Revision 1.43.2.7 2006/12/06 21:55:38 hdl
-# Adding zebraoptions for servers to get serverinfos in Context.pm
+# Adding ModZebrations for servers to get serverinfos in Context.pm
# Using this function in rebuild_zebra.pl
#
# Revision 1.43.2.6 2006/11/24 21:18:31 kados
projects / koha_fer / blobdiff