#!/usr/bin/perl
#
# Name:
# test-complex-popup-radio.cgi.
#
# Purpose:
# Test DBIx::HTML::PopupRadio.
#
# Author:
# Ron Savage <ron@savage.net.au>
# http://savage.net.au/index.html
use strict;
use warnings;
use CGI;
use CGI::Carp qw/fatalsToBrowser/;
use DBI;
use DBIx::HTML::PopupRadio;
use Error qw/ :try /;
# -----------------------------------------------
delete @ENV{'BASH_ENV', 'CDPATH', 'ENV', 'IFS', 'SHELL'}; # For security.
my(%popup_data) =
(
one =>
{ comment => 'Demonstrate returning an id when the user selects a name',
default => '', # Default menu item number.
menu => '', # Menu in HTML returned from menu object.
name => 'campus_1', # CGI name of menu.
object => '', # Menu object returned from DBIx::HTML::PopupRadio.
order => 1, # Sort order of menus down the page.
previous => '', # Previous user selection for this menu.
prompt => '', # Prompt at top of menu.
sql => 'select campus_id, campus_name from campus',
},
two =>
{ comment => 'Demonstrate returning a name when the user selects a name',
default => '',
menu => '',
name => 'campus_2',
object => '',
order => 2,
previous => '',
prompt => '', # See how we can select the column twice.
sql => 'select campus_name, campus_name from campus',
},
three =>
{ comment => 'Demonstrate a different SQL statement',
default => '',
menu => '',
name => 'campus_3',
object => '',
order => 3,
previous => '',
prompt => '',
sql => 'select campus_id, campus_name from campus order by campus_name',
},
four =>
{ comment => 'Demonstrate a prompt at the top of the menu (but not a default)',
default => '',
menu => '',
name => 'campus_4',
object => '',
order => 4,
previous => '',
prompt => 'Please select a campus from the list',
sql => 'select campus_id, campus_name from campus order by campus_name',
},
five =>
{ comment => 'Demonstrate a default menu selection (but not a prompt)',
default => 'Geelong',
menu => '',
name => 'campus_5',
object => '',
order => 5,
previous => '',
prompt => '',
sql => 'select campus_id, campus_name from campus',
},
);
my(%radio_data) =
(
one =>
{ comment => 'Demonstrate default = scc107m, linebreak = 0',
default => 'scc107m',
linebreak => 0,
menu => '', # Menu in HTML returned from menu object.
name => 'radio_1', # CGI name of menu.
object => '', # Menu object returned from DBIx::HTML::PopupRadio.
order => 1, # Sort order of menus down the page.
previous => '', # Previous user selection for this menu.
sql => 'select unit_id, unit_code from unit order by unit_code',
},
two =>
{ comment => 'Demonstrate default = scc109m, linebreak = 1',
default => 'scc109m',
linebreak => 1,
menu => '',
name => 'radio_2',
object => '',
order => 2,
previous => '',
sql => 'select unit_id, unit_code from unit order by unit_id',
},
);
my($caption) = 'Test DBIx::HTML::PopupRadio';
my($q) = CGI -> new();
$popup_data{$_}{'previous'} = $q -> param($popup_data{$_}{'name'}) || '' for keys %popup_data;
$radio_data{$_}{'previous'} = $q -> param($radio_data{$_}{'name'}) || '' for keys %radio_data;
my(@html);
try
{
my($dbh) = DBI -> connect
(
'DBI:mysql:test:127.0.0.1',
'root',
'pass',
{
AutoCommit => 1,
HandleError => sub {Error::Simple -> record($_[0]); 0},
PrintError => 0,
RaiseError => 1,
ShowErrorStatement => 1,
}
);
for my $key (sort{$popup_data{$a}{'order'} <=> $popup_data{$b}{'order'} } keys %popup_data)
{
$popup_data{$key}{'object'} = DBIx::HTML::PopupRadio -> new(dbh => $dbh, name => $popup_data{$key}{'name'}, sql => $popup_data{$key}{'sql'});
$popup_data{$key}{'object'} -> set(default => $popup_data{$key}{'default'});
$popup_data{$key}{'menu'} = $popup_data{$key}{'object'} -> popup_menu(prompt => $popup_data{$key}{'prompt'});
push(@html, $q -> th('Comment') . $q -> td($popup_data{$key}{'comment'}) );
push(@html, $q -> th("Previous $popup_data{$key}{'name'}") . $q -> td($popup_data{$key}{'previous'} . ' => ' . $popup_data{$key}{'object'} -> param($popup_data{$key}{'previous'}) ) );
push(@html, $q -> th('Default') . $q -> td($popup_data{$key}{'default'}) );
push(@html, $q -> th('Prompt') . $q -> td($popup_data{$key}{'prompt'}) );
push(@html, $q -> th('SQL') . $q -> td($popup_data{$key}{'sql'}) );
push(@html, $q -> th('Campus') . $q -> td($popup_data{$key}{'menu'}) );
push(@html, $q -> th(' ') . $q -> td(' ') );
}
for my $key (sort{$radio_data{$a}{'order'} <=> $radio_data{$b}{'order'} } keys %radio_data)
{
$radio_data{$key}{'object'} = DBIx::HTML::PopupRadio -> new(dbh => $dbh, name => $radio_data{$key}{'name'}, sql => $radio_data{$key}{'sql'});
$radio_data{$key}{'object'} -> set(linebreak => $radio_data{$key}{'linebreak'});
$radio_data{$key}{'menu'} = $radio_data{$key}{'object'} -> radio_group(default => $radio_data{$key}{'default'});
push(@html, $q -> th('Comment') . $q -> td($radio_data{$key}{'comment'}) );
push(@html, $q -> th("Previous $radio_data{$key}{'name'}") . $q -> td($radio_data{$key}{'previous'} . ' => ' . $radio_data{$key}{'object'} -> param($radio_data{$key}{'previous'}) ) );
push(@html, $q -> th('Default') . $q -> td($radio_data{$key}{'default'}) );
push(@html, $q -> th('Linebreak') . $q -> td($radio_data{$key}{'linebreak'}) );
push(@html, $q -> th('SQL') . $q -> td($radio_data{$key}{'sql'}) );
push(@html, $q -> th('Unit') . $q -> td($radio_data{$key}{'menu'}) );
push(@html, $q -> th(' ') . $q -> td(' ') );
}
push(@html, $q -> th({colspan => 2}, $q -> submit({name => $caption, class => 'submit'}) ) );
}
catch Error::Simple with
{
my($error) = 'Error::Simple: ' . $_[0] -> text();
chomp($error);
push(@html, $q -> th('Error') . $q -> td($error) );
};
print $q -> header({type => 'text/html;charset=ISO-8859-1'}),
$q -> start_html({style => {src => '/css/default.css'}, title => $caption}),
$q -> h1({align => 'center'}, $caption),
$q -> start_form({action => $q -> url(), name => 'dbix_form'}),
$q -> table
(
{align => 'center', border => 1, class => 'submit'},
$q -> Tr([@html])
),
$q -> end_form(),
$q -> end_html();