#!/usr/bin/perl -w # search_for_model.pl # Search for models (or other words) matching your # search list: # $param{'searchstring'} # Output is a table of database columns as defined by # display_field_N where N=1,2,3,... (no numbers misssing) # display_field is the database column name ordered by # N value and the headings defined by entries in the # config file of the form # := # Note that you can include html tags on the right. my $version = 'April 12, 2010/V1.00'; # April 12, 2012, V1.00 R. Groman (based on a similar # program called search_for_species.pl.) my ($count, $record, $ref, $select_clause, $status, $value); my ($access_code, $required_access_code); my ($dbh, %dbhash, $debug, $dev_switch); $| = 1; my $regular_table_weight = 10; print STDOUT ("Content-Type: text/html\n\n"); print STDOUT < HEADER unshift (@INC, "/data/www/usglobec/Scripts"); require ('read_configuration_file.pl'); require ('bob_setup.pl'); require ('bob_unsetup.pl'); use lib '/data/www/usglobec/Scripts'; use MODEL_DB; bob_setup(); my $date = scalar localtime; $error = '
' . $error; $warning = 'br' . $warning; my @required_params = ( 'searchstring' ); my @required_config_params = ( 'display_field_1', 'mode' ); my $config_file = $0; $config_file =~ s!(.*)/.*!$1!; $config_file = $config_file . '/' . 'search_for_model.config'; $status = read_configuration_file($config_file); $status = 'okay'; foreach (@required_config_params) { unless (exists $config_param{$_} and defined $config_param{$_} ) { MODEL_DB::sendmessage($error, "$_ parameter not defined", ""); $status = 'ng'; } } unless ($status eq 'okay' ) { MODEL_DB::sendmessage($error, "One or more required config parameters were not defined.", "Cannot continue."); goto END; } if (exists $config_param{'debug'} and defined $config_param{'debug'} ) { if ($config_param{'debug'} =~ m/^y/i or $config_param{'debug'} =~ m/^1/ or $config_param{'debug'} =~ m/^t/i) { $debug = 'yes'; } else { $debug = 'no'} } else { $debug = 'no'} print STDOUT ("

***debug, config_file=$config_file
\n") if $debug eq 'yes'; get_web_form_data(); foreach $key (sort keys %param) { $param{$key} =~ s/ /_/g ; $param{$key} =~ s/\n/_/g ; $param{$key} =~ s/\t/_/g ; $param{$key} =~ s/\r/_/g ; print STDOUT ("
***debug, param{$key}=$param{$key}\n") if $debug eq 'yes'; } $status = 'okay'; foreach (@required_params) { unless (exists $param{$_} and defined $param{$_} ) { MODEL_DB::sendmessage($error, "$_ form parameter not defined", ""); $status = 'ng'; } else { print STDOUT ("

***debug, param{", $_, "}=", $param{$_}, "
\n") if $debug eq 'yes'; } } if (exists $config_param{'mode'} and defined $config_param{'mode'} ) { if ($config_param{'mode'} eq 'purgatory' ) { $dev_switch = 'purgatory'; } elsif ($config_param{'mode'} eq 'live') { $dev_switch = 'live'; } elsif ($config_param{'mode'} eq 'test') { $dev_switch = 'test'; } else { MODEL_DB::sendmessage($error, "

Mode=$config_param{'mode'} not correctly specified in config file.", "
Cannot continue."); goto END; } } else { MODEL_DB::sendmessage($error, "

Mode not specied.", "
Cannot continue."); goto END; } if ($dev_switch eq 'purgatory') { $goto_model_add_update = ''; $goto_model_display = ''; $goto_model_search = ''; $dbh = MODEL_DB::connect_model_purgatory_login (); print STDOUT ("

***debug, selecting development database

\n") if $debug eq 'yes'; } elsif ($dev_switch eq 'live') { $goto_model_add_update = ''; $goto_model_display = ''; $goto_model_search = ''; $dbh = MODEL_DB::connect_model_login (); print STDOUT ("

***debug, selecting live database

\n") if $debug eq 'yes'; } elsif ($dev_switch eq 'test') { $goto_model_add_update = ''; $goto_model_display = ''; $goto_model_search = ''; $dbh = MOMDEL_DB::connect_model_purgatory_login (); print STDOUT ("

***debug, selecting test/purgatory database

\n") if $debug eq 'yes'; } else { MODEL_DB::sendmessage($error, "

Use mode=$dev_switch not correctly specified in config file.", "
Cannot continue."); exit (0); } unless (defined $dbh) { MODEL_DB::sendmessage($error, "

Could not connect to $dev_switch Model database", "
Error string=$DBI::errstr, and error=$DBI::err"); exit (0); } print STDOUT <Results of Model Search from the $dev_switch database HEADER1 # Separate out search string words my @search_words = MODEL_DB::parse_search_terms($param{'searchstring'}, $debug); if ($#search_words < 0) { print STDOUT ("

No search word was entered. Please ", "\nclick you browser's 'Back' button and try again.", "
\n"); goto END; } print STDOUT ( "

Your ", "search words/phrases were:

\n"); foreach my $keyword (@search_words) { print STDOUT ("
$keyword

\n"); } print STDOUT ("

"); print STDOUT ( "Select the model from the list below for which ", "you want to display
its informatino
\n"); my $added_weight; my $key; print STDOUT ("
***debug, just before call to search for $table table
\n") if $debug eq 'yes'; if ($dev_switch eq 'live') { $table = 'models'; } else { $table = 'models_purg'; } print STDOUT ("
***debug, just before call to search for $table table
\n") if $debug eq 'yes'; ($status, $ids_ref) = &fast_search_of_table ($dbh, $table, @search_words); unless ($status =~ m/^okay/i) { print STDOUT ("
Error in performing table fast search, ", "Error=$status"); goto END } @ids = @$ids_ref; if (defined $ids[0]) { foreach $id (@ids) { if (defined $found{$id}) { $found{$id} = $found{$id} + $regular_table_weight; if ($found{$id} > 99) {$found{$id} = 99} $key = $found{$id} . ':' . $id; $found{$key} = $id; } else { $found{$id} = $regular_table_weight; $key = $regular_table_weight .':' . $id; $found{$key} = $id; } } } my $found = 'no'; print STDOUT (''); my $i = 1; $key = $display_field_ . $i; print STDOUT ("\n"); while (exists $config_param{$key} and defined $config_param{$key} ) { if (exists $config_param{$config_param{$key}} and defined $config_param{$config_param{$key}} ) { $heading = $config_param{$config_param{$key}}; } else { $heading = $config_param{$key}; } print STDOUT ('\n"); $i++; $key = $display_field_ . $i; } print STDOUT ("\n\n"); my $numb_columns = $i - 1; foreach $key (sort byweight keys %found) { unless ($key =~ m/^\d+:/) {next;} $found = 'yes'; $id = $found{$key}; unless (exists $used{$id} and defined $used{$id}) { $used{$id} = 'yes'; my $hash_ref = MODEL::get_record_by_id($dbh, $id); my $hash = %$hash_ref; for (my $j=1; $j<=$numb_columns; $j++) { $hash_key = $display_field_ . $j; if (exists $hash{$hash_key}) { unless (defined $hash{$hash_key} ) { $value = ""; } else { $value = $hash{$hash_key}; } $value = '' . $value . "\n" unless $value eq ""; } else { $value = ""; } print STDOUT ("\n"); } print STDOUT ("
', $heading, "
", $value, " "); } } print STDOUT ("
\n"); END: if (defined $dbh) {$dbh -> disconnect;} http://www.usglobec.org/images/menu/Home.png http://www.usglobec.org/search_icon.jpg print STDOUT ('
Do another search
\n", '
Add or modify a model
\n", '
Display a model (if you know its id #)
\n"); my $prog = $0; $prog =~ s/.*\/(.*)/$1/; print STDOUT ('
', "
Program $prog, Version $version
\n"); print STDOUT ( "Page generated $date for the $dev_switch database
\n"); print STDOUT ("\n\n"); bob_unsetup(); exit; #---------------------------------------------------------------------------------- sub byweight { # Assumes values passed are in the following format: # # NN: