Commit 61ba92b6 authored by Keith Jolley's avatar Keith Jolley

Explicitly enable warnings pragma on selected modules.

Warnings were always used within the IDE, but are now enabled to track
down 'uninitialized variable' warnings during runtime.
Various warnings fixed.
parent 19cb7e89
......@@ -20,6 +20,7 @@
#along with BIGSdb. If not, see <http://www.gnu.org/licenses/>.
package BIGSdb::main;
use strict;
use warnings;
use version; our $VERSION = qv('1.3.2');
###########Local configuration################################
......
......@@ -18,6 +18,7 @@
#along with BIGSdb. If not, see <http://www.gnu.org/licenses/>.
package BIGSdb::AlleleInfoPage;
use strict;
use warnings;
use base qw(BIGSdb::Page);
use Log::Log4perl qw(get_logger);
use Error qw(:try);
......@@ -46,10 +47,8 @@ sub print_content {
return;
}
my $sql = $self->{'db'}->prepare("SELECT * FROM sequences WHERE locus=? AND allele_id=?");
eval { $sql->execute( $locus, $allele_id ); };
if ($@) {
$logger->error("Can't execute $@");
}
eval { $sql->execute( $locus, $allele_id ) };
$logger->($@) if $@;
my $seq_ref = $sql->fetchrow_hashref;
if ( !$seq_ref->{'allele_id'} ) {
print "<div class=\"box\" id=\"statusbad\"><p>This sequence does not exist.</p></div>\n";
......@@ -59,13 +58,10 @@ sub print_content {
my $seq = BIGSdb::Utils::split_line( $seq_ref->{'sequence'} );
my $sender_info = $self->{'datastore'}->get_user_info( $seq_ref->{'sender'} );
$sender_info->{'affiliation'} =~ s/\&/\&amp;/g;
my $sender_email = "<a href=\"mailto:$sender_info->{'email'}\">$sender_info->{'email'}</a>" if !$self->{'system'}->{'privacy'};
my $sender_email = !$self->{'system'}->{'privacy'} ? "<a href=\"mailto:$sender_info->{'email'}\">$sender_info->{'email'}</a>" : '';
my $curator_info = $self->{'datastore'}->get_user_info( $seq_ref->{'curator'} );
my $desc_exists = $self->{'datastore'}->run_simple_query("SELECT COUNT(*) FROM locus_descriptions WHERE locus=?",$locus)->[0];
my $desc_link;
if ($desc_exists){
$desc_link = "<a href=\"$self->{'system'}->{'script_name'}?db=$self->{'instance'}&amp;page=locusInfo&amp;locus=$locus\" class=\"info_tooltip\">&nbsp;i&nbsp;</a>";
}
my $desc_link = $desc_exists ? "<a href=\"$self->{'system'}->{'script_name'}?db=$self->{'instance'}&amp;page=locusInfo&amp;locus=$locus\" class=\"info_tooltip\">&nbsp;i&nbsp;</a>" : '';
print << "HTML";
<div class="box" id="resultstable">
<table class="resultstable">
......@@ -106,26 +102,22 @@ HTML
}
my $qry = "SELECT databank, databank_id FROM accession WHERE locus=? and allele_id=? ORDER BY databank,databank_id";
$sql = $self->{'db'}->prepare($qry);
eval { $sql->execute( $locus, $allele_id ); };
if ($@) {
$logger->error("Can't execute $@");
}
eval { $sql->execute( $locus, $allele_id ) };
$logger->error($@) if $@;
while ( my $accession = $sql->fetchrow_hashref ) {
print "<tr class=\"td$td\"><th>$accession->{'databank'} #</th><td style=\"text-align:left\" colspan=\"3\">";
if ( $accession->{'databank'} eq 'Genbank' ) {
print "<a href=\"http://www.ncbi.nlm.nih.gov/nuccore/$accession->{'databank_id'}\">";
print "<a href=\"http://www.ncbi.nlm.nih.gov/nuccore/$accession->{'databank_id'}\">$accession->{'databank_id'}</a>";
} else {
print "$accession->{'databank_id'}";
}
print "$accession->{'databank_id'}";
print "</a>" if $accession->{'databank'} eq 'Genbank';
print "</td></tr>\n";
$td = $td == 1 ? 2 : 1;
}
$qry = "SELECT pubmed_id FROM sequence_refs WHERE locus=? and allele_id=? ORDER BY pubmed_id";
$sql = $self->{'db'}->prepare($qry);
eval { $sql->execute( $locus, $allele_id ); };
if ($@) {
$logger->error("Can't execute $@");
}
eval { $sql->execute( $locus, $allele_id ) };
$logger->error($@) if $@;
while ( my ($pmid) = $sql->fetchrow_array ) {
print $self->_get_reference( $pmid, $td );
$td = $td == 1 ? 2 : 1;
......
#Written by Keith Jolley
#(c) 2010, University of Oxford
#(c) 2010-2011, University of Oxford
#E-mail: keith.jolley@zoo.ox.ac.uk
#
#This file is part of Bacterial Isolate Genome Sequence Database (BIGSdb).
......@@ -18,6 +18,7 @@
#along with BIGSdb. If not, see <http://www.gnu.org/licenses/>.
package BIGSdb::Application;
use strict;
use warnings;
use Time::HiRes qw(gettimeofday);
use Error qw(:try);
use Log::Log4perl qw(get_logger);
......@@ -46,16 +47,23 @@ sub new {
$self->_initiate( $config_dir, $dbase_config_dir );
$self->{'dataConnector'}->initiate( $self->{'system'}, $self->{'config'} );
my $logger_benchmark = get_logger('BIGSdb.Application_Benchmark');
my $q = $self->{'cgi'};
if ( !$self->{'error'} ) {
$self->db_connect();
if ( $self->{'db'} ) {
$self->_setup_datastore();
$self->_setup_prefstore();
if ( !$self->{'system'}->{'authentication'} ) {
my $logger = get_logger('BIGSdb.Application_Authentication');
$logger->logdie(
"No authentication attribute set - set to either 'apache' or 'builtin' in the system tag of the XML database description."
);
}
$self->_initiate_authdb if $self->{'system'}->{'authentication'} eq 'builtin';
$self->_initiate_jobmanager( $config_dir, $plugin_dir, $dbase_config_dir )
if ( $self->{'cgi'}->param('page') eq 'plugin'
|| $self->{'cgi'}->param('page') eq 'job' )
if ( $q->param('page') eq 'plugin'
|| $q->param('page') eq 'job' )
&& $self->{'config'}->{'jobs_db'};
$self->_initiate_plugins($plugin_dir);
}
......@@ -75,7 +83,7 @@ sub DESTROY {
my $end = gettimeofday();
my $elapsed = $end - $self->{'start_time'};
$elapsed =~ s/(^\d{1,}\.\d{4}).*$/$1/;
$logger->info("Total Time to process $self->{'page'} page: $elapsed seconds");
$logger->info("Total Time to process $self->{'page'} page: $elapsed seconds") if $self->{'page'};
}
sub _initiate {
......@@ -110,22 +118,24 @@ sub _initiate {
$self->{'error'} = 'invalidScriptPath';
}
}
$self->{'error'} = 'noAuthenticationSet' if !$self->{'system'}->{'authentication'};
$self->{'system'}->{'read_access'} = 'public' if !$self->{'system'}->{'read_access'}; #everyone can view by default
$self->{'error'} = 'noAuthenticationSet' if !$self->{'system'}->{'authentication'};
$self->{'system'}->{'script_name'} = $self->{'script_name'};
$ENV{'PATH'} = '/bin:/usr/bin'; #so we don't foul taint check
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)}; # Make %ENV safer
$self->{'page'} = $q->param('page') || 'index';
$self->{'system'}->{'host'} = 'localhost' if !$self->{'system'}->{'host'};
$self->{'system'}->{'port'} = 5432 if !$self->{'system'}->{'port'};
$self->{'system'}->{'user'} = 'apache' if !$self->{'system'}->{'user'};
$self->{'system'}->{'password'} = 'remote'
if !$self->{'system'}->{'password'};
$ENV{'PATH'} = '/bin:/usr/bin'; #so we don't foul taint check
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)}; # Make %ENV safer
$q->param( 'page', 'index' ) if !defined $q->param('page');
$self->{'page'} = $q->param('page');
$self->{'system'}->{'read_access'} ||= 'public'; #everyone can view by default
$self->{'system'}->{'host'} ||= 'localhost';
$self->{'system'}->{'port'} ||= 5432;
$self->{'system'}->{'user'} ||= 'apache';
$self->{'system'}->{'password'} ||= 'remote';
$self->{'system'}->{'privacy'} ||= 'yes';
$self->{'system'}->{'privacy'} = $self->{'system'}->{'privacy'} eq 'no' ? 0 : 1;
$self->{'system'}->{'locus_superscript_prefix'} ||= 'no';
if ( $self->{'system'}->{'dbtype'} eq 'isolates' ) {
$self->{'system'}->{'view'} = 'isolates' if !$self->{'system'}->{'view'};
$self->{'system'}->{'labelfield'} = 'isolate' if !$self->{'system'}->{'labelfield'};
$self->{'system'}->{'view'} ||= 'isolates';
$self->{'system'}->{'labelfield'} ||= 'isolate';
if ( !$self->{'xmlHandler'}->is_field( $self->{'system'}->{'labelfield'} ) ) {
$logger->error(
"The defined labelfield '$self->{'system'}->{'labelfield'}' does not exist in the database. Please set the labelfield attribute in the system tag of the database XML file."
......@@ -223,13 +233,14 @@ sub _read_config_file {
my $config = Config::Tiny->new();
$config = Config::Tiny->read("$config_dir/bigsdb.conf");
foreach (
qw ( prefs_db auth_db jobs_db max_load emboss_path tmp_dir secure_tmp_dir blast_path blast+_path blast_threads
muscle_path mogrify_path ipcress_path reference refdb chartdirector disable_updates disable_update_message
qw ( prefs_db auth_db jobs_db max_load emboss_path tmp_dir secure_tmp_dir blast_path blast+_path blast_threads
muscle_path mogrify_path ipcress_path reference refdb chartdirector disable_updates disable_update_message
intranet)
)
{
$self->{'config'}->{$_} = $config->{_}->{$_};
}
$self->{'config'}->{'intranet'} ||= 'no';
if ( $self->{'config'}->{'chartdirector'} ) {
eval "use perlchartdir;";
if ($@) {
......@@ -246,11 +257,11 @@ sub _read_config_file {
sub _read_host_mapping_file {
my ( $self, $config_dir ) = @_;
if (-e "$config_dir/host_mapping.conf"){
open (my $fh, '<', "$config_dir/host_mapping.conf");
while (<$fh>){
if ( -e "$config_dir/host_mapping.conf" ) {
open( my $fh, '<', "$config_dir/host_mapping.conf" );
while (<$fh>) {
next if $_ =~ /^\s+$/ || $_ =~ /^#/;
my ($host,$mapped) = split /\s+/,$_;
my ( $host, $mapped ) = split /\s+/, $_;
next if !$host || !$mapped;
$self->{'config'}->{'host_map'}->{$host} = $mapped;
}
......@@ -353,7 +364,7 @@ sub print_page {
'extractedSequence' => 'ExtractedSequencePage',
'alleleQuery' => 'AlleleQueryPage',
'locusInfo' => 'LocusInfoPage',
'job' => 'JobViewerPage'
'job' => 'JobViewerPage'
);
my $page;
my %page_attributes = (
......@@ -371,6 +382,7 @@ sub print_page {
'pluginManager' => $self->{'pluginManager'},
'mod_perl_request' => $self->{'mod_perl_request'},
'jobManager' => $self->{'jobManager'},
'curate' => 0
);
my $continue = 1;
my $auth_cookies_ref;
......@@ -389,7 +401,7 @@ sub print_page {
$page_attributes{'system'} = $self->{'system'};
}
if ( $self->{'page'} eq 'options'
&& ( $self->{'cgi'}->param('set') || $self->{'cgi'}->param('reset')) )
&& ( $self->{'cgi'}->param('set') || $self->{'cgi'}->param('reset') ) )
{
$page = BIGSdb::OptionsPage->new(%page_attributes);
$page->initiate_prefs;
......
......@@ -118,7 +118,7 @@ sub barchart {
}
my $y_offset = $max_label_length * 5;
$y_offset += 10 if $prefs->{'x-title'};
my $x_offset = 10 if $prefs->{'y-title'};
my $x_offset = $prefs->{'y-title'} ? 10: 0 ;
my ($chart,$layer);
if ( $size eq 'small' ) {
$chart = new XYChart( 780, 350 );
......
......@@ -20,6 +20,7 @@ package BIGSdb::CurateDeleteAllPage;
use strict;
use base qw(BIGSdb::CuratePage);
use Log::Log4perl qw(get_logger);
use Error qw(:try);
my $logger = get_logger('BIGSdb.Page');
sub print_content {
......@@ -62,11 +63,13 @@ sub print_content {
my $schemes = $self->{'datastore'}->run_list_query("SELECT id FROM schemes");
foreach (@$schemes) {
if ( $query =~ /temp_scheme_$_\s/ ) {
if ( $self->{'datastore'}->create_temp_scheme_table($_) == -1 ) {
try {
$self->{'datastore'}->create_temp_scheme_table($_);
} catch BIGSdb::DatabaseConnectionException with {
print
"<div class=\"box\" id=\"statusbad\"><p>Can't copy data into temporary table - please check scheme configuration (more details will be in the log file).</p></div>\n";
return;
}
"<div class=\"box\" id=\"statusbad\"><p>Can't copy data into temporary table - please check scheme configuration (more details will be in the log file).</p></div>\n";
$logger->error("Can't copy data to temporary table.");
};
}
}
}
......
......@@ -19,6 +19,7 @@
package BIGSdb::CurateIsolateACLPage;
use strict;
use base qw(BIGSdb::CuratePage);
use Error qw(:try);
use Log::Log4perl qw(get_logger);
my $logger = get_logger('BIGSdb.Page');
......@@ -32,11 +33,13 @@ sub print_content {
my $schemes = $self->{'datastore'}->run_list_query("SELECT id FROM schemes");
foreach (@$schemes) {
if ( $query =~ /temp_scheme_$_\s/ ) {
if ( $self->{'datastore'}->create_temp_scheme_table($_) == -1 ) {
try {
$self->{'datastore'}->create_temp_scheme_table($_);
} catch BIGSdb::DatabaseConnectionException with {
print
"<div class=\"box\" id=\"statusbad\"><p>Can't copy data into temporary table - please check scheme configuration (more details will be in the log file).</p></div>\n";
return;
}
"<div class=\"box\" id=\"statusbad\"><p>Can't copy data into temporary table - please check scheme configuration (more details will be in the log file).</p></div>\n";
$logger->error("Can't copy data to temporary table.");
};
}
}
my $ids = $self->{'datastore'}->run_list_query($query);
......
......@@ -18,6 +18,7 @@
#along with BIGSdb. If not, see <http://www.gnu.org/licenses/>.
package BIGSdb::Datastore;
use strict;
use warnings;
use Log::Log4perl qw(get_logger);
use Time::HiRes qw(gettimeofday);
use List::MoreUtils qw(any);
......@@ -118,8 +119,11 @@ sub get_composite_value {
my %scheme_field_list;
while ( my ( $field, $empty_value, $regex ) = $self->{'sql'}->{'composite_field_values'}->fetchrow_array() ) {
if (
$regex =~ /[^\w\d\-\.\\\/\(\)\+\* \$]/ #reject regex containing any character not in list
|| $regex =~ /\$\D/ #allow only $1, $2 etc. variables
defined $regex
&& (
$regex =~ /[^\w\d\-\.\\\/\(\)\+\* \$]/ #reject regex containing any character not in list
|| $regex =~ /\$\D/ #allow only $1, $2 etc. variables
)
)
{
$logger->warn(
......@@ -140,8 +144,8 @@ sub get_composite_value {
if ( ref $allele_ids ne 'HASH' ) {
$allele_ids = $self->get_all_allele_ids($isolate_id);
}
my $allele = $allele_ids->{$locus};
$allele = '&Delta;' if $allele =~ /^del/i;
my $allele = $allele_ids->{$locus} ;
$allele = '&Delta;' if defined $allele && $allele =~ /^del/i;
if ($regex) {
my $expression = "\$allele =~ $regex";
eval "$expression";
......@@ -457,9 +461,9 @@ sub get_scheme_field_info {
$self->{'sql'}->{'scheme_field_info'} = $self->{'db'}->prepare("SELECT * FROM scheme_fields WHERE scheme_id=? AND field=?");
$logger->info("Statement handle 'scheme_field_info' prepared.");
}
eval { $self->{'sql'}->{'scheme_field_info'}->execute( $id, $field ); };
eval { $self->{'sql'}->{'scheme_field_info'}->execute( $id, $field ) };
$logger->error($@) if $@;
return $self->{'sql'}->{'scheme_field_info'}->fetchrow_hashref();
return $self->{'sql'}->{'scheme_field_info'}->fetchrow_hashref;
}
sub get_all_scheme_field_info {
......@@ -586,7 +590,7 @@ sub create_temp_scheme_table {
if ($@) {
$logger->error("Can't put data into temp table: $@");
$self->{'db'}->rollback;
return -1;
throw BIGSdb::DatabaseConnectionException("Can't put data into temp table");
}
$" = ',';
eval { $self->{'db'}->do("CREATE INDEX i_$id ON temp_scheme_$id (@$loci)"); };
......@@ -639,24 +643,19 @@ sub get_loci {
"SELECT id,scheme_id from loci left join scheme_members on loci.id = scheme_members.locus $defined_clause order by scheme_members.scheme_id,id";
}
my $sql = $self->{'db'}->prepare($qry);
eval { $sql->execute(); };
if ($@) {
$logger->error("Can't execute $qry $@");
}
eval { $sql->execute };
$logger->error($@) if $@;
my @query_loci;
my $array_ref = $sql->fetchall_arrayref;
foreach (@$array_ref) {
next
if $options->{'query_pref'}
&& (
!$self->{'prefs'}->{'query_field_loci'}->{ $_->[0] }
|| ( !$self->{'prefs'}->{'query_field_schemes'}->{ $_->[1] }
&& $_->[1] )
);
&& ( !$self->{'prefs'}->{'query_field_loci'}->{ $_->[0] }
|| ( defined $_->[1] && !$self->{'prefs'}->{'query_field_schemes'}->{ $_->[1] } ) );
next
if $options->{'analysis_pref'}
&& ( !$self->{'prefs'}->{'analysis_loci'}->{ $_->[0] }
|| ( !$self->{'prefs'}->{'analysis_schemes'}->{ $_->[1] } && $_->[1] ) );
|| ( defined $_->[1] && !$self->{'prefs'}->{'analysis_schemes'}->{ $_->[1] } ) );
push @query_loci, $_->[0];
}
return \@query_loci;
......@@ -667,13 +666,13 @@ sub get_locus_list {
#return sorted list of loci, with labels. Includes common names.
#options passed as hashref:
#analysis_pref: only the loci for which the user has an analysis preference selected will be returned
my ($self,$options) = @_;
my ( $self, $options ) = @_;
$options = {} if ref $options ne 'HASH';
my $qry = "SELECT id,common_name FROM loci";
my @option_clauses;
push @option_clauses, "analysis" if ($options->{'analysis_pref'});
if (@option_clauses){
$"=' AND ';
push @option_clauses, "analysis" if ( $options->{'analysis_pref'} );
if (@option_clauses) {
$" = ' AND ';
$qry .= " WHERE @option_clauses";
}
my $loci = $self->run_list_query_hashref($qry);
......@@ -708,9 +707,9 @@ sub get_locus_info {
$self->{'sql'}->{'locus_info'} = $self->{'db'}->prepare("SELECT * FROM loci WHERE id=?");
$logger->info("Statement handle 'locus_info' prepared.");
}
eval { $self->{'sql'}->{'locus_info'}->execute($locus); };
eval { $self->{'sql'}->{'locus_info'}->execute($locus) };
$logger->error($@) if $@;
return $self->{'sql'}->{'locus_info'}->fetchrow_hashref();
return $self->{'sql'}->{'locus_info'}->fetchrow_hashref;
}
sub get_locus {
......@@ -801,13 +800,13 @@ sub get_sequence_flag {
my ( $self, $seqbin_id, $locus, $start, $end ) = @_;
if ( !$self->{'sql'}->{'sequence_flag'} ) {
$self->{'sql'}->{'sequence_flag'} =
$self->{'db'}->prepare(
"SELECT sequence_flags.flag FROM sequence_flags WHERE seqbin_id=? AND locus=? AND start_pos=? AND end_pos=?");
$self->{'db'}
->prepare("SELECT sequence_flags.flag FROM sequence_flags WHERE seqbin_id=? AND locus=? AND start_pos=? AND end_pos=?");
}
eval { $self->{'sql'}->{'sequence_flag'}->execute($seqbin_id,$locus,$start,$end);};
eval { $self->{'sql'}->{'sequence_flag'}->execute( $seqbin_id, $locus, $start, $end ); };
$logger->error($@) if $@;
my @flags;
while (my ($flag) = $self->{'sql'}->{'sequence_flag'}->fetchrow_array){
while ( my ($flag) = $self->{'sql'}->{'sequence_flag'}->fetchrow_array ) {
push @flags, $flag;
}
return \@flags;
......@@ -1104,13 +1103,13 @@ sub create_temp_ref_table {
my $sql2 = $dbr->prepare($qry2);
my $qry3 = "SELECT id,surname,initials FROM authors";
my $sql3 = $dbr->prepare($qry3);
eval { $sql3->execute;};
if (@$){
eval { $sql3->execute; };
if (@$) {
$logger->error($@);
}
my $all_authors = $sql3->fetchall_hashref('id');
my ( $qry4, $isolates );
if ($qry_ref) {
my $isolate_qry = $$qry_ref;
$isolate_qry =~ s/\*/id/;
......@@ -1119,23 +1118,20 @@ sub create_temp_ref_table {
$qry4 = "SELECT COUNT(*) FROM refs WHERE refs.pubmed_id=?";
}
my $sql4 = $self->{'db'}->prepare($qry4);
foreach my $pmid (@$list) {
eval { $sql1->execute($pmid); };
if ($@) {
$logger->error("Can't execute $qry1, value:$pmid $@");
}
my @refdata = $sql1->fetchrow_array;
eval {
$sql2->execute($pmid);
};
eval { $sql2->execute($pmid); };
if ($@) {
$logger->error("Can't execute $qry2, value:$pmid $@");
}
my @authors;
my $author_arrayref = $sql2->fetchall_arrayref;
foreach (@$author_arrayref){
$all_authors->{$_->[0]}->{'surname'} =~ s/'/\\'/g;
foreach (@$author_arrayref) {
$all_authors->{ $_->[0] }->{'surname'} =~ s/'/\\'/g;
push @authors, "$all_authors->{$_->[0]}->{'surname'} $all_authors->{$_->[0]}->{'initials'}";
}
$" = ', ';
......@@ -1243,8 +1239,14 @@ sub get_table_field_attributes {
#Returns array ref of attributes for a specific table provided by table-specific helper functions.
my ( $self, $table ) = @_;
my $function = "_get_$table\_table_attributes";
return $self->$function();
my $function = "_get_$table\_table_attributes";
my $attributes = $self->$function();
foreach my $att (@$attributes) {
foreach (qw(tooltip optlist required default hide public_hide main_display)) {
$att->{$_} = '' if !defined( $att->{$_} );
}
}
return $attributes;
}
sub _get_isolate_aliases_table_attributes {
......@@ -2352,12 +2354,7 @@ sub _get_sequence_flags_table_attributes {
comments => 'start position of locus within sequence'
},
{ name => 'end_pos', type => 'int', required => 'yes', primary_key => 'yes', comments => 'end position of locus within sequence' },
{
name => 'flag',
type => 'text',
required => 'yes',
optlist => "@flags"
},
{ name => 'flag', type => 'text', required => 'yes', optlist => "@flags" },
{ name => 'complete', type => 'bool', required => 'yes', comments => 'true if complete locus represented', default => 'true' },
{ name => 'curator', type => 'int', required => 'yes', dropdown_query => 'yes' },
{ name => 'datestamp', type => 'date', required => 'yes' },
......@@ -2661,9 +2658,7 @@ sub get_primary_keys {
my @keys;
my $attributes = $self->get_table_field_attributes($table);
foreach (@$attributes) {
if ( $_->{'primary_key'} eq 'yes' ) {
push @keys, $_->{'name'};
}
push @keys, $_->{'name'} if $_->{'primary_key'};
}
return @keys;
}
......
......@@ -21,6 +21,7 @@ use strict;
use base qw(BIGSdb::Page);
use Log::Log4perl qw(get_logger);
my $logger = get_logger('BIGSdb.Page');
use Error qw(:try);
sub initiate {
my ($self) = @_;
......@@ -192,10 +193,13 @@ sub _print_scheme_field {
"<tr class=\"td1\"><th style=\"text-align:right\">Description</th><td style=\"text-align:left\">$info->{'description'}</td></tr>\n";
}
print "</table><p />\n";
if ( $self->{'datastore'}->create_temp_scheme_table($scheme_id) == -1 ) {
print "<p>Can't copy data into temporary table - please check scheme configuration (more details will be in the log file).</p>\n";
return;
}
try {
$self->{'datastore'}->create_temp_scheme_table($scheme_id);
} catch BIGSdb::DatabaseConnectionException with {
print
"<p class=\"statusbad\">Can't copy data into temporary table - please check scheme configuration (more details will be in the log file).</p>\n";
$logger->error("Can't copy data to temporary table.");
};
print
"<p>The field has a list of allowable values retrieved from an external database (values present in this database are <span class=\"highlightvalue\">highlighted</span>):</p>";
my $cols = $info->{'type'} eq 'integer' ? 10 : 6;
......
This diff is collapsed.
......@@ -358,9 +358,9 @@ sub login_from_cookie {
throw BIGSdb::AuthenticationException("No valid session") if $self->{'logged_out'};
my %Cookies = $self->_get_cookies( $passString, $userCookieName );
foreach ( keys %Cookies ) {
$logger->debug("cookie $_ = $Cookies{$_}");
$logger->debug("cookie $_ = $Cookies{$_}") if defined $Cookies{$_};
}
my $savedPasswordHash = $self->_get_password_hash( $Cookies{$userCookieName} );
my $savedPasswordHash = $self->_get_password_hash( $Cookies{$userCookieName} ) || '';
my $saved_IP_address = $self->_get_IP_address( $Cookies{$userCookieName} );
my $cookieString = Digest::MD5::md5_hex( $self->{'ip_addr'} . $savedPasswordHash . $uniqueString );
##############################################################
......@@ -381,6 +381,7 @@ sub login_from_cookie {
# good cookie, allow access
return $Cookies{$userCookieName};
}
$Cookies{$passString} ||= '';
$logger->debug("Cookie not validated. cookie:$Cookies{$passString} string:$cookieString");
throw BIGSdb::AuthenticationException("No valid session");
}
......@@ -391,7 +392,7 @@ sub _MD5_login {
$self->{'$sessionID'} = Digest::MD5::md5_hex( $self->{'ip_addr'} . $randomNumber . $uniqueString );
my $current_time = time();
$self->_create_session( $self->{'$sessionID'}, $current_time );
if ( $self->{'vars'}->{Submit} eq 'Log in' ) {
if ( $self->{'vars'}->{'Submit'} ) {
my $log_buffer;
foreach my $key ( keys %{ $self->{'vars'} } ) {
$log_buffer .= ' | ' . $key . "=" . $self->{'vars'}->{$key} if $key ne 'password_field' && $key ne 'Submit';
......
This diff is collapsed.
......@@ -18,6 +18,7 @@
#along with BIGSdb. If not, see <http://www.gnu.org/licenses/>.
package BIGSdb::Plugin;
use strict;
use warnings;
use base qw(BIGSdb::Page);
use Error qw(:try);
use Log::Log4perl qw(get_logger);
......@@ -27,7 +28,9 @@ use constant MAX_TREE_NODES => 1000;
sub initiate {
my ($self) = @_;
if ( $self->{'cgi'}->param('format') eq 'text' ) {
my $q = $self->{'cgi'};
$q->param('format', 'html') if !defined $q->param('format');
if ( $q->param('format') eq 'text' ) {
$self->{'type'} = 'text';
} else {
$self->{$_} = 1 foreach qw(jQuery jQuery.tablesort jQuery.jstree);
......@@ -175,6 +178,7 @@ sub create_temp_tables {
} else {
print "Can not connect to remote database. The query can not be performed.\n";
}
$logger->error("Can't connect to remote database.");
$continue = 0;
};
return $continue;
......@@ -663,10 +667,10 @@ sub _print_tree {
}
sub _print_all_none_buttons {
my ( $self, $js1, $js2, $class, $prefix ) = @_;
my ( $self, $js1, $js2, $class ) = @_;
if ( ref $js1 && ref $js2 ) {
print "<input type=\"button\" value=\"". $prefix ."None\" class=\"$class\" onclick='@$js2' />\n";
print "<input type=\"button\" value=\"". $prefix ."All\" class=\"$class\" onclick='@$js1' />\n";
print "<input type=\"button\" value=\"None\" class=\"$class\" onclick='@$js2' />\n";
print "<input type=\"button\" value=\"All\" class=\"$class\" onclick='@$js1' />\n";
}
}
......
#FieldBreakdown.pm - FieldBreakdown plugin for BIGSdb
#Written by Keith Jolley
#Copyright (c) 2010, University of Oxford
#Copyright (c) 2010-2011, University of Oxford
#E-mail: keith.jolley@zoo.ox.ac.uk
#
#This file is part of Bacterial Isolate Genome Sequence Database (BIGSdb).
......@@ -19,6 +19,7 @@
#along with BIGSdb. If not, see <http://www.gnu.org/licenses/>.
package BIGSdb::Plugins::FieldBreakdown;
use strict;
use warnings;
use base qw(BIGSdb::Plugin);
use Log::Log4perl qw(get_logger);
my $logger = get_logger('BIGSdb.Plugins');
......@@ -35,7 +36,7 @@ sub get_attributes {
buttontext => 'Fields',
menutext => 'Single field',