# Suite 330, Boston, MA 02111-1307 USA
use strict;
+use warnings;
use vars qw($VERSION $AUTOLOAD $context @context_stack);
BEGIN {
use XML::Simple;
use C4::Boolean;
use C4::Debug;
+use POSIX ();
=head1 NAME
=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);
- }
+ 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();
}
return defined($it)? C4::Boolean::true_p($it): undef;
}
-=head3 clear_syspref_cache
+=item clear_syspref_cache
C4::Context->clear_syspref_cache();
sub _new_dbh
{
-### $context
- ##correct name for db_schme
+ ## $context
+ ## correct name for db_schme
my $db_driver;
if ($context->config("db_scheme")){
- $db_driver=db_scheme2dbi($context->config("db_scheme"));
+ $db_driver=db_scheme2dbi($context->config("db_scheme"));
}else{
- $db_driver="mysql";
+ $db_driver="mysql";
}
my $db_name = $context->config("database");
my $sth = $dbh->prepare("select word from stopwords");
$sth->execute;
while (my $stopword = $sth->fetchrow_array) {
- my $retval = {};
$stopwordlist->{$stopword} = uc($stopword);
}
$stopwordlist->{A} = "A" unless $stopwordlist;
C4::Context->userenv;
-Builds a hash for user environment variables.
+Retrieves a hash for user environment variables.
This hash shall be cached for future use: if you call
C<C4::Context-E<gt>userenv> twice, you will get the same hash without real DB access
-set_userenv is called in Auth.pm
-
=cut
#'
-sub userenv
-{
+sub userenv {
my $var = $context->{"activeuser"};
- return $context->{"userenv"}->{$var} if (defined $context->{"userenv"}->{$var});
+ return $context->{"userenv"}->{$var} if (defined $var and defined $context->{"userenv"}->{$var});
# insecure=1 management
if ($context->{"dbh"} && $context->preference('insecure')) {
my %insecure;
$insecure{emailaddress} = 'test@mode.insecure.com';
return \%insecure;
} else {
- return 0;
+ return;
}
}
C4::Context->set_userenv($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $userflags, $emailaddress);
-Informs a hash for user environment variables.
-
-This hash shall be cached for future use: if you call
-C<C4::Context-E<gt>userenv> twice, you will get the same hash without real DB access
+Establish a hash of user environment variables.
set_userenv is called in Auth.pm
=cut
#'
-sub set_userenv{
+sub set_userenv {
my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $branchname, $userflags, $emailaddress, $branchprinter)= @_;
my $var=$context->{"activeuser"};
my $cell = {
"cardnumber" => $usercnum,
"firstname" => $userfirstname,
"surname" => $usersurname,
-#possibly a law problem
+ #possibly a law problem
"branch" => $userbranch,
"branchname" => $branchname,
"flags" => $userflags,
- "emailaddress" => $emailaddress,
- "branchprinter" => $branchprinter
+ "emailaddress" => $emailaddress,
+ "branchprinter" => $branchprinter
};
$context->{userenv}->{$var} = $cell;
return $cell;
=item _new_userenv
- C4::Context->_new_userenv($session);
+ C4::Context->_new_userenv($session); # FIXME: This calling style is wrong for what looks like an _internal function
Builds a hash for user environment variables.
#'
sub _new_userenv
{
- shift;
+ shift; # Useless except it compensates for bad calling style
my ($sessionID)= @_;
$context->{"activeuser"}=$sessionID;
}
my %versions;
$versions{kohaVersion} = KOHAVERSION();
$versions{kohaDbVersion} = C4::Context->preference('version');
- $versions{osVersion} = `uname -a`;
+ $versions{osVersion} = join(" ", POSIX::uname());
$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} ;
+ {
+ no warnings qw(exec); # suppress warnings if unable to find a program in $PATH
+ $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;
}