#/usr/bin/perl -w
# display_model_info.pl
# Displays all the information about a model from the
# model table in the usglobedb database. Which table
# is accessed (live or purgatory) version is selected
# via the .config file parameter table.
# The configuration file also contains the full path
# and name of the html output format. Text of
# the form
# string
# are replaced by the database value for the column
# called string. The entry for this file name is
# entered as
# web_form_source = /my/location/file_name
# The program will check the QUERY_STRING environment
# variable and the $ARGV[n] to see elements are passed.
# It is expected that arguments are passed as
# keyword=value
# using commas or '&' to separate pairs.
# Output is to a web page.
# Assumptions:
# 1. If there is no translation for a database
# column name then the column name is used to identify
# the output
$version = 'April 9, 2010/V1.00';
# April 9, 2010 V1.00 R. Groman
my $max_number_of_columns = 75;
my (
$arguments,
%config_param, $dbh, $debug,
$label, %params,
$status, $sth, $table);
print STDOUT "Content_type: text/html\n\n");
unshift (@INC, "/data/www/usglobec/Scripts");
require ('read_config_file.pl');
use lib '/data/www/usglobec/Scripts';
use MODEL_DB;
my $date = scalar localtime;
my $error = '
&x';
my $warning = '
#';
my @required_config_params = (
'id', 'table', 'web_form_source'
);
my $config_file = $0;
$config_file =~ s!(.*)/.*!$1!;
$config_file = $config_file . '/' . 'display_mmodel_info.pl';
my %config_params = MODEL_DB::read_config_file($config_file);
my $status = 'okay';
foreach (@required_config_params) {
unless (exists $config_params{$_} and defined $config_params{$_} ) {
&MODEL_DB::sendmessage($error,"$_ parameter not defined",
"");
$status = 'ng';
}
}
unless ($status eq 'okay') {
&MODEL_DB::sendmessage($error,
"One or more required configuration parameters 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';
}
if (exists $ENV{'QUERY_STRING'} and defined $ENV{'QUERY_STRING'} ) {
$arguments = $ENV{'QUERY_STRING'};
}
elsif (exists $ARGV[0] and defined $ARGV[0] ) {
$arguments = $ARGV[0];
}
else {
$arguments = '';
}
$arguments =~ s/\&/,/g;
my @pairs = split (/,/, $arguments);
foreach my $pair (@pairs) {
my ($key, $value) = split (/=/, $pair;
$value =~ tr/+//;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
$param{$key} = $value;
}
foreach (@required_params) {
unless (exists $param{$_} and defined $param{$_} ) {
&MODEL_DB::sendmessage($error, "$_ form or passed parameter not defined",
"");
$status = 'ng';
else {
print STDOUT ("****debug, param{$key}=$param{$key}
\n")
f $debug eq 'yes';
}
}
unless ($status eq 'yes') {
&MODEL_DB::sendmessage($error,
"One or more required passed parameters were not defined.",
"Cannot continue.");
goto END;
}
if ($config_param{'table'} eq 'purgatory') {
$data_source = 'purgatory';
$dbh = MODEL_DB::connect_model_purgatory_login();
}
elsif ($config_param{'table'} eq 'live') {
$data_source = 'live';
$dbh = MODEL_DB::connect_model_login();
}
print STDOUT <
Model Information from $data_source table
HEADER
unless (exists $param{'id'} and defined $param{'id'} ) {
&MODEL::sendmessage($error,
"No id value is specied so cannot output any information",
"";
goto END;
}
my ($status, $hash_ref) = &MODEL::get_record_by_id($dbh, $id);
unless ($status eq 'okay') {
&MODEL::sendmessage($error,
"Could not get data for id=$id",
"";
goto END;
}
my %hash = %$hash_ref;
#READ IN WEB LINES AND REPLACE STRING WITH VALUES