ossp-pkg/sdb/sdb.cgi
1.2
#!/usr/opkg/bin/perl
##
## OSSP sdb -- Skill Database
## Copyright (c) 2003 The OSSP Project <http://www.ossp.org/>
## Copyright (c) 2003 Cable & Wireless Deutschland <http://www.cw.com/de/>
## Copyright (c) 2003 Ralf S. Engelschall <rse@engelschall.com>
##
## This file is part of OSSP sdb, a small skill database Web UI
## which can be found at http://www.ossp.org/pkg/tool/sdb/
##
## This program is free software; you can redistribute it and/or
## modify it under the terms of the GNU General Public License
## as published by the Free Software Foundation; either version
## 2.0 of the License, or (at your option) any later version.
##
## This program is distributed in the hope that it will be useful,
## but WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
## General Public License for more details.
##
## You should have received a copy of the GNU General Public License
## along with this program; if not, write to the Free Software
## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
## USA, or contact The OSSP Project <ossp@ossp.org>.
##
## sdb.cgi: skill database CGI (language: Perl)
##
# requirements
require 5.006;
use POSIX;
use IO;
use CGI qw(:standard -nosticky -no_undef_params -oldstyle_urls -no_debug);
use DBI;
use DBD::SQLite;
use String::Divert;
use Data::Dumper;
# program configuration
my $my = {
PROG_NAME => 'sdb',
PROG_VERS => '0.0.1',
PROG_DATE => '09-May-2003',
PROG_DESC => 'Skill Database',
TEMPLATE => "<html>\n<head>\n\@HEAD\@\n</head>\n<body>\n\@BODY\@\n</body></html>"
};
# switch to unbuffered output
$|++;
## _________________________________________________________________________
##
## Helper Functions
## _________________________________________________________________________
##
# (un)escape URL chars
sub url_escape {
my ($text) = @_;
$text =~ s|([ \t&+?:/=\n\r])|sprintf("%%%02x", ord($1))|sge;
return $text;
}
sub url_unescape {
my ($text) = @_;
$text =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack('C', hex($1))/eg;
return $text;
}
# (un)escape SQL chars
sub sql_escape {
my ($text) = @_;
$text =~ s|(.)|POSIX::isprint($1) ? $1 : "."|sge;
$text =~ s|([''])|$1$1|sg;
$text = "'" . $text . "'";
return $text;
}
sub sql_unescape {
my ($text) = @_;
if ($text =~ m|^'(.*)'$|) {
$text = $1;
$text =~ s/''/'/sg;
}
return $text;
}
## _________________________________________________________________________
##
## Initialize Environment
## _________________________________________________________________________
##
# remove and remember GET query strings
my $qs = '';
if ($ENV{QUERY_STRING} ne '') {
$qs = $ENV{QUERY_STRING};
delete $ENV{QUERY_STRING};
}
# open CGI environment
my $cgi = new CGI;
$cgi->autoEscape(undef);
# re-insert GET query strings into CGI environment
if ($qs ne '') {
foreach my $kv (split(/\&/, $qs)) {
if ($kv =~ m|^([^=]+)(?:=([^=]+))?$|s) {
my ($key, $val) = ($1, $2);
$val ||= 1;
$key = &url_unescape($key);
$val = &url_unescape($val);
$cgi->param($key, $val);
}
}
}
# remember self-referencing URL
$my->{URL} = $cgi->url(-full => 1);
# generate an HTTP response
sub http_response {
my ($head, $body) = @_;
# fill in template page
my $response = $my->{TEMPLATE};
if ($response =~ m|\n([^\n]*)\@HEAD\@|s) {
my $prefix = " " x length($1);
$head =~ s|\n(.)|\n$prefix$1|sg;
}
if ($response =~ m|\@HEAD\@[ \t]*\n|s) {
$head =~ s|\n$||s;
}
$response =~ s|\@HEAD\@|$head|sg;
if ($response =~ m|\n([^\n]*)\@BODY\@|s) {
my $prefix = " " x length($1);
$body =~ s|\n(.)|\n$prefix$1|sg;
}
if ($response =~ m|\@BODY\@[ \t]*\n|s) {
$body =~ s|\n$||s;
}
$response =~ s|\@BODY\@|$body|sg;
# prepend with HTTP header
$response = $cgi->header(
-type => 'text/html',
-expires => 'now',
'-Content-length' => length($response)
) . $response;
return $response;
}
# start output generation
my $head = '';
my $body = '';
# optionally read HTML page template
if (-f "sdb.html") {
my $io = new IO::File "<sdb.html" || die;
$my->{TEMPLATE} = '';
$my->{TEMPLATE} .= $_ while (<$io>);
$io->close();
}
# optionally activate CSS
if (-f "sdb.css") {
$head .= "<link rel=\"stylesheet\" href=\"sdb.css\" type=\"text/css\"/>";
}
# activate a general error handler
$SIG{__DIE__} = sub {
my ($err) = @_;
$err =~ s|at\s+\S+\s+line\s+(\d+)|(sdb.cgi:$1)|s;
$err =~ s|\n|<br>\n|sg;
$err =~ s|\n+$||s;
$head .= "<title>".$my->{PROG_NAME}.": ERROR</title>";
$body .= "<h2>ERROR</h1>" .
"The following error occured:<p>" .
"<pre class=error>$err</pre>\n";
# debugging
$body .= "<pre>";
my @names = $cgi->param;
foreach my $name (@names) {
my $value = $cgi->param($name);
$body .= "$name=\"$value\"\n";
}
$body .= "</pre>";
print STDOUT &http_response($head, $body);
exit(0);
};
# open DB environment
my $db;
($db = DBI->connect("dbi:SQLite:dbname=sdb.db", "", ""))
|| die "unable to connect to SQLite database \"sdb.db\"";
$db->{AutoCommit} = 1;
$db->{RaiseError} = 1;
## _________________________________________________________________________
##
## Stage 0: Determine Parameters
## _________________________________________________________________________
##
# list of UI display pages
my @ui_pages = qw(main person);
# initialize UI display parameters
my $ui = {};
foreach my $page (@ui_pages) {
my $found = 0;
foreach my $sub (
"ui_${page}_init",
"ui_init"
) {
if (defined(&$sub)) {
&$sub($my, $cgi, $db, $ui, $page);
$found = 1;
last;
}
}
die "no initialization handler found for page \"$page\""
if (not $found);
}
# determine UI display parameters
my @names = $cgi->param;
foreach my $name (@names) {
if ($name =~ m|^([^.]+)(?:\.([^.]+)(?:\.([^.]+))?)?$|s) {
my ($page, $area, $elem) = ($1, $2, $3);
if (defined($page)) {
$ui->{$page} = { -is => 'disable', -with => 'default' }
if (not defined($ui->{$page}));
}
if (defined($area)) {
$ui->{$page}->{$area} = { -is => 'disable', -with => 'default' }
if (not defined($ui->{$page}->{$area}));
}
if (defined($elem)) {
if ($name =~ m|\+$|s) {
my @values = $cgi->param($name);
$ui->{$page}->{$area}->{$elem} = [ @values ];
}
else {
my $value = $cgi->param($name);
$ui->{$page}->{$area}->{$elem} = $value;
}
}
elsif (defined($area)) {
my $value = $cgi->param($name);
$value = "visible" if ($value eq "1");
$ui->{$page}->{$area}->{-is} = $value;
}
elsif (defined($page)) {
my $value = $cgi->param($name);
$value = "visible" if ($value eq "1");
$ui->{$page}->{-is} = $value;
}
$cgi->param($name, undef);
}
}
## _________________________________________________________________________
##
## Stage 1: Process Last Action
## _________________________________________________________________________
##
# determine default UI display
my $page = undef;
foreach my $p (keys(%{$ui})) {
if ($ui->{$p}->{-is} eq 'visible') {
$page = $p;
last;
}
}
if (not defined($page)) {
$ui->{main}->{-is} = 'visible';
$ui->{main}->{all}->{-is} = 'visible';
}
# determine which button was pressed and
# perform an associated action (if defined)
foreach my $page (keys(%{$ui})) {
foreach my $area (keys(%{$ui->{$page}})) {
foreach my $elem (keys(%{$ui->{$page}->{$area}})) {
if ($elem =~ m|^[A-Z][A-Z0-9_-]*$|) {
if ($ui->{$page}->{$area}->{$elem}) {
my $found = 0;
foreach my $sub (
"ui_${page}_${area}_${elem}_action",
"ui_${page}_${area}_action",
"ui_${page}_action",
"ui_action"
) {
if (defined(&$sub)) {
&$sub($my, $cgi, $db, $ui, $page, $area, $elem);
$found = 1;
last;
}
}
die "no action handler found for element \"$page.$area.$elem\""
if (not $found);
}
delete $ui->{$page}->{$area}->{$elem};
}
}
}
}
## _________________________________________________________________________
##
## Stage 2: Output New Display
## _________________________________________________________________________
##
# start output generation
my $html = new String::Divert;
$html->overload(1);
# generate outmost class
$html .= "<!-- SDB BEGIN -->\n";
$html .= "<div class=\"sdb\">\n";
$html .= " "; $html *= q{outmost};
$html .= "</div>\n";
$html .= "<!-- SDB END -->\n";
$html >> q{outmost};
# generate outmost self-referencing form
$html .= $cgi->startform(
-method => "POST",
-action => $my->{URL},
);
$html .= " "; $html *= q{form};
$html .= $cgi->endform() . "\n";
$html >> q{form};
# generate top-level header & footer
$html .= "<h1>Skill Database</h1>\n";
$html .= ""; $html *= q{page};
$html .= "<p/>\n" .
"<span class=\"footer\">\n" .
" $my->{PROG_NAME} $my->{PROG_VERS} ($my->{PROG_DATE})\n" .
"</span>\n";
$html >> q{page};
# generate page contents
foreach my $page (@ui_pages) {
next if (not defined($ui->{$page}));
if ($ui->{$page}->{-is} =~ m/^(visible|hidden)$/) {
my $found = 0;
foreach my $sub (
"ui_${page}_render",
"ui_render"
) {
if (defined(&$sub)) {
$html .= &$sub($my, $cgi, $db, $ui, $page);
$found = 1;
last;
}
}
die "no rendering handler found for page \"$page\""
if (not $found);
}
}
# insert HTML into output HTTP response body
$html->undivert(0);
$body .= $html->string();
# optional debugging
$body .= "<p/>\n";
$body .= "<pre>\n";
my @names = $cgi->param;
foreach my $name (sort(@names)) {
my $value = $cgi->param($name);
$body .= " $name=\"$value\"\n";
}
$body .= "</pre>\n";
# generate output
print STDOUT &http_response($head, $body);
exit(0);
## _________________________________________________________________________
##
## Page: main
## _________________________________________________________________________
##
sub ui_main_init {
my ($my, $cgi, $db, $ui, $page) = @_;
$ui->{main} = { -is => 'disable', -with => 'default' };
$ui->{main}->{all} = { -is => 'disable', -with => 'default' };
}
sub ui_main_action {
my ($my, $cgi, $db, $ui, $page, $area, $elem) = @_;
die "invalid action \"$page.$area.$elem\"";
}
sub ui_main_render {
my ($my, $cgi, $db, $ui, $page) = @_;
# start generating HTML
my $html = new String::Divert;
$html->overload(1);
# generate outer class
$html .= "<span class=\"main\">\n";
$html .= " "; $html *= q{body};
$html .= "</span>\n";
$html >> q{body};
# generate header
$html .= "<h2>Main Menu</h2>\n";
# generate main menu
$html .=
"<ul>\n" .
" <li><a href=\"$my->{URL}?person\">Browse Persons</a> →\n" .
" <li><a href=\"$my->{URL}?team\">Browse Teams</a> →\n" .
" <li><a href=\"$my->{URL}?skill\">Browse Skills</a> →\n" .
" <li><a href=\"$my->{URL}?query\">Perform Skill Query</a> →\n" .
"</ul>\n";
# return unfolded HTML
$html->undivert(0);
return $html->string();
}
## _________________________________________________________________________
##
## Page: person
## _________________________________________________________________________
##
sub ui_person_init {
my ($my, $cgi, $db, $ui, $page) = @_;
# initialize person page
$ui->{person} = { -is => 'disable', -with => 'default' };
$ui->{person}->{select} = { -is => 'disable', -with => 'default' };
$ui->{person}->{detail} = { -is => 'disable', -with => 'default' };
$ui->{person}->{skill} = { -is => 'disable', -with => 'default' };
}
sub ui_person_action {
my ($my, $cgi, $db, $ui, $page, $area, $elem) = @_;
# recreate action string
my $action = "$page.$area.$elem";
# actions on select box
if ($ui->{person}->{select}->{ADD}) {
# just open detail area for addition
$ui->{person}->{detail}->{id} = undef;
$ui->{person}->{detail}->{-is} = 'visible';
$ui->{person}->{detail}->{-with} = 'add';
}
elsif ($ui->{person}->{select}->{VIEW}) {
# just open detail area for viewing
$ui->{person}->{detail}->{-is} = 'visible';
$ui->{person}->{detail}->{-with} = 'view';
}
elsif ($ui->{person}->{select}->{EDIT}) {
# just open detail area for editing
$ui->{person}->{detail}->{-is} = 'visible';
$ui->{person}->{detail}->{-with} = 'edit';
}
elsif ($ui->{person}->{select}->{DELETE}) {
# delete person from database
my $pe_id = $ui->{person}->{select}->{id};
if ($pe_id eq '') {
die "no person selected";
}
my @rv = $db->selectrow_array("SELECT pe_id FROM sdb_person WHERE pe_id = '$pe_id';");
if (@rv == 0) {
die "invalid person \"$pe_id\" selected";
}
$db->do(sprintf(
"DELETE FROM sdb_person WHERE pe_id = %s;",
&sql_escape($pe_id)
));
$ui->{person}->{select}->{id} = '';
$ui->{person}->{detail}->{-is} = 'remove';
$ui->{person}->{skills}->{-is} = 'remove';
}
# actions on detail box
if ($ui->{person}->{detail}->{'SKILL-VIEW'}) {
# just open skill area for viewing
$ui->{person}->{skill}->{-is} = 'visible';
$ui->{person}->{skill}->{-with} = 'view';
}
elsif ($ui->{person}->{detail}->{'SKILL-EDIT'}) {
# just open skill area for editing
$ui->{person}->{skill}->{-is} = 'visible';
$ui->{person}->{skill}->{-with} = 'edit';
}
elsif ( $ui->{person}->{detail}->{CLOSE}
or $ui->{person}->{detail}->{CANCEL}) {
# just close detail area
$ui->{person}->{detail}->{-is} = 'remove';
}
elsif ($ui->{person}->{detail}->{SAVE}) {
# save person details to database
my $pe = {};
$pe->{id} = $ui->{person}->{select}->{id};
foreach my $a (qw(name email phone)) {
$pe->{$a} = $ui->{person}->{detail}->{$a};
}
my $te_ids = $ui->{person}->{detail}->{"membership+"};
if ($pe->{id} eq '') {
# add new entry
my @rv = $db->selectrow_array(sprintf(
"SELECT pe_id FROM sdb_person WHERE pe_name = %s;",
&sql_escape($pe->{name})
));
if (@rv > 0) {
die "person \"$pe->{name}\" already existing -- delete first, please";
}
$db->do(sprintf(
"INSERT INTO sdb_person (pe_name, pe_email, pe_phone) VALUES (%s, %s, %s);",
&sql_escape($pe->{name}),
&sql_escape($pe->{email}),
&sql_escape($pe->{phone})
));
foreach my $te_id (@{$te_ids}) {
$db->do(sprintf(
"INSERT INTO sdb_member (ms_pe_id, ms_te_id) VALUES (%s, %s);",
&sql_escape($pe->{id}), &sql_escape($te_id)
));
}
}
else {
# modify existing entry
my @rv = $db->selectrow_array(sprintf(
"SELECT pe_id FROM sdb_person WHERE pe_id = %s;",
&sql_escape($pe->{id})
));
if (@rv == 0) {
die "person with id \"$pe->{id}\" not exists";
}
$db->do(sprintf(
"UPDATE sdb_person" .
" SET pe_name = %s, pe_email = %s, pe_phone = %s" .
" WHERE pe_id = %s;",
&sql_escape($pe->{name}),
&sql_escape($pe->{email}),
&sql_escape($pe->{phone}),
&sql_escape($pe->{id})
));
$db->do(sprintf(
"DELETE FROM sdb_member WHERE ms_pe_id = %s;",
&sql_escape($pe->{id})
));
foreach my $te_id (@{$te_ids}) {
$db->do(sprintf(
"INSERT INTO sdb_member (ms_pe_id, ms_te_id) " .
" VALUES (%s, %s);",
&sql_escape($pe->{id}),
&sql_escape($te_id)
));
}
}
}
}
sub ui_person_render {
my ($my, $cgi, $db, $ui, $page) = @_;
# start output generation
my $html = new String::Divert;
$html->overload(1);
# filter output according to visibility
$html->storage(($ui->{person}->{-is} eq 'visible' ? 'all' : 'fold'));
# generate outer page CSS class
$html .= "<span class=\"person\">\n";
$html .= " " . $cgi->hidden(-name => "person", -default => 1)."\n";
$html .= " "; $html *= q{person};
$html .= "</span>\n";
$html >> q{person};
# generate header
$html .= "<h2>Persons</h2>\n";
$html .= "<a href=\"$my->{URL}\">← Back to Main Menu</a>";
# generate page canvas
# +-------+-------+
# | area1 | area2 |
# +-------+-------+
# | area3 |
# +---------------+
$html .= "<p>\n";
$html .= "<table width=100%>\n";
$html .= " <tr>\n";
$html .= " <td valign=top class=\"box\" width=\"50%\">\n";
$html .= " "; $html *= q{area1};
$html .= " </td>\n";
$html .= " <td>\n";
$html .= " \n";
$html .= " </td>\n";
$html .= " <td valign=top class=\"box\" width=\"50%\">\n";
$html .= " "; $html *= q{area2};
$html .= " </td>\n";
$html .= " </tr>\n";
$html .= " <tr>\n";
$html .= " <td colspan=3>\n";
$html .= " \n";
$html .= " </td>\n";
$html .= " </tr>\n";
$html .= " <tr>\n";
$html .= " <td colspan=3 valign=top class=\"box\" width=\"100%\">\n";
$html .= " "; $html *= q{area3};
$html .= " </td>\n";
$html .= " </tr>\n";
$html .= "</table>\n";
## _____________________________________________________________________
##
## generate area: Person Selection
## _____________________________________________________________________
##
# force selection box to be always visible if whole area is visible
$ui->{person}->{select}->{-is} = 'visible'
if ($ui->{person}->{-is} eq 'visible');
# generate CSS class
$html >> q{area1};
$html .= "<span class=\"select\">\n";
$html .= " "; $html *= q{select};
$html .= "</span>\n";
$html >> q{select};
# generate inner header
$html .= "<h3>Select Person and Action</h3>\n";
# generate inner canvas
$html .= "<table width=100%>\n";
$html .= " <tr>\n";
$html .= " <td width=100%>\n";
$html .= " "; $html *= q{select-list};
$html .= " </td>\n";
$html .= " <td valign=top height=100%>\n";
$html .= " "; $html *= q{select-buttons};
$html .= " </td>\n";
$html .= " </tr>\n";
$html .= "</table>\n";
# generate the selection list widget
$html >> q{select-list};
my $rv = $db->selectall_arrayref(
"SELECT pe_id,pe_name FROM sdb_person ORDER BY pe_name;"
);
my $pe_values = [];
my $pe_labels = {};
foreach my $r (@{$rv}) {
push(@{$pe_values}, $r->[0]);
$pe_labels->{$r->[0]} = $r->[1];
}
my $pe_default = $ui->{person}->{select}->{id} || $pe_values->[0];
if ($ui->{person}->{select}->{-is} eq 'visible') {
if (@{$pe_values} > 0) {
$html .= $cgi->scrolling_list(
-override => 1,
-name => 'person.select.id',
-values => $pe_values,
-labels => $pe_labels,
-default => $pe_default,
-size => 20,
-class => 'id',
) . "\n";
}
}
else {
$html .= $cgi->hidden(
-name => 'person.select.id',
-default => $pe_default
);
}
$html << q{select-list};
# generate the selection list attached buttons
$html >> "select-buttons";
$html .= $cgi->submit(
-name => 'person.select.ADD',
-value => 'Add Person →',
-class => 'ADD'
) . "<br>";
if (@{$pe_values} > 0) {
$html .= $cgi->submit(
-name => 'person.select.VIEW',
-value => 'View Person →',
-class => 'VIEW'
) . "<br/>";
$html .= $cgi->submit(
-name => 'person.select.EDIT',
-value => "Edit Person →",
-class => "EDIT"
) . "<br/>";
$html .= $cgi->submit(
-name => 'person.select.DELETE',
-value => '← Delete Person',
-class => 'DELETE'
) . "<br/>";
}
$html << q{select-buttons};
# undivert from select area
$html << q{area1};
## _____________________________________________________________________
##
## generate area: Person Detail
## _____________________________________________________________________
##
# generate CSS class
$html >> q{area2};
$html .= "<span class=\"detail\">\n";
$html .= " "; $html *= q{detail};
$html .= "</span>\n";
$html >> q{detail};
# generate inner header
my $action = $ui->{person}->{detail}->{-with};
$html .= "<h3>".uc(substr($action,0,1)).substr($action,1)." Person</h3>\n";
$html .= "<span class=\"$action\">\n";
$html .= " "; $html *= q{detail-sub};
$html .= "</span>\n";
$html >> q{detail-sub};
# generate inner canvas
$html .= "<table>\n";
$html .= " "; $html *= q{detail-standard};
$html .= " "; $html *= q{detail-membership};
$html .= " "; $html *= q{detail-buttons};
$html .= "</table>\n";
# fetch person details
my $pe = undef;
if ($action eq 'view' or $action eq 'edit') {
my $id = $ui->{person}->{select}->{id};
if ($id eq '') {
die "no person selected";
}
$pe = $db->selectrow_hashref(sprintf(
"SELECT pe_id AS id, pe_name AS name, pe_email AS email, pe_phone AS phone" .
" FROM sdb_person WHERE pe_id = %s;",
&sql_escape($id)
));
if (not defined($pe)) {
die "person with id \"$id\" not found";
}
}
else {
$pe = { id => '', name => '', email => '', phone => '' };
}
# display person details (standard)
$html >> q{detail-standard};
my $label = {
'name' => 'Person Name',
'email' => 'Email Address',
'phone' => 'Phone Number'
};
my $i = 0;
foreach my $a (qw(name email phone)) {
$html .= "<tr class=\"row-$i\">\n";
$html .= " <td class=\"label\">\n";
$html .= " ".$label->{$a}.":";
$html .= " </td>\n";
$html .= " <td class=\"content\">\n";
if ($action eq 'view') {
$html .= $pe->{$a};
}
else {
if ($ui->{person}->{detail}->{-is} eq 'visible') {
$html .= $cgi->textfield(
-override => 1,
-name => "person.detail.$a",
-default => $pe->{$a},
-size => 40,
-maxlength => 80
);
}
else {
$html .= $cgi->hidden(
-name => "person.detail.$a",
-default => $pe->{$a}
);
}
}
$html .= " </td>\n";
$html .= "</tr>\n";
$i = ($i + 1) % 2;
}
$html << q{detail-standard};
# display person details (membership)
$html >> q{detail-membership};
$html .= "<tr class=\"$row-$i\">\n";
$html .= " <td valign=top class=\"label\">\n";
$html .= " Team Membership:\n";
$html .= " </td>\n";
$html .= " <td class=\"content\">\n";
$html .= " "; $html *= q{detail-membership-sub};
$html .= " </td>\n";
$html .= "</tr>\n";
$html >> q{detail-membership-sub};
if ($action eq 'view') {
my $te_all = $db->selectcol_arrayref(sprintf(
"SELECT te_name FROM sdb_team,sdb_member" .
" WHERE te_id = ms_te_id AND ms_pe_id = %s" .
" ORDER BY te_name;",
&sql_escape($pe->{id})
));
if (@{$te_all} == 0) {
$html .= "-none-";
}
else {
for (my $i = 0; $i < @{$te_all}; $i++) {
my $te_name = $te_all->[$i];
$html .= ", " if ($i != 0);
$html .= $te_name;
}
}
}
else {
my $te_values = [];
my $te_labels = {};
my $te_all = $db->selectall_arrayref(
"SELECT te_id, te_name FROM sdb_team ORDER BY te_name;"
);
foreach my $r (@{$te_all}) {
push(@{$te_values}, $r->[0]);
$te_labels->{$r->[0]} = $r->[1];
}
my $te_defaults = [];
if ($action eq 'edit') {
$te_defaults = $db->selectcol_arrayref(sprintf(
"SELECT ms_te_id FROM sdb_member WHERE ms_pe_id = %s;",
&sql_escape($pe->{id})
));
};
if (@{$te_values} == 0) {
$html .= "-none-";
}
else {
$html .= $cgi->scrolling_list(
-override => 1,
-name => 'person.detail.membership+',
-values => $te_values,
-labels => $te_labels,
-default => $te_defaults,
-multiple => 'true',
-size => 10,
-class => 'membership',
);
}
}
$html << q{detail-membership};
# generate attached buttons
$html >> q{detail-buttons};
$html .= "<tr>\n";
$html .= " <td>\n";
$html .= " ";
$html .= " </td>\n";
$html .= " <td>\n";
$html .= " "; $html *= q{detail-buttons-sub1};
$html .= " </td>\n";
$html .= "</tr>\n";
$html >> q{detail-buttons-sub1};
$html .= "<table width=100%>\n";
$html .= " <tr>\n";
$html .= " "; $html *= q{detail-buttons-sub2};
$html .= " </tr>\n";
$html .= "</table>\n";
$html >> q{detail-buttons-sub2};
if ($action eq 'view') {
$html .= "<td>" . $cgi->submit(
-name => 'person.detail.CLOSE',
-value => '← Close',
-class => 'CLOSE'
) . "</td>";
$html .= "<td>" . $cgi->submit(
-name => 'person.detail.SKILL-VIEW',
-value => 'View Skills ↓',
-class => 'SKILL-VIEW'
) . "</td>";
}
else {
$html .= "<td>" . $cgi->submit(
-name => 'person.detail.CANCEL',
-value => '← Cancel',
-class => 'CANCEL'
) . "</td>";
$html .= "<td>" . $cgi->submit(
-name => 'person.detail.SAVE',
-value => '↑ Save',
-class => 'SAVE'
) . "</td>";
$html .= "<td>" . $cgi->submit(
-name => 'person.detail.SKILL-EDIT',
-value => 'Edit Skills ↓',
-class => 'SKILL-EDIT'
) . "</td>";
}
$html << q{detail-buttons};
# undivert from detail area
$html << q{area2};
## _____________________________________________________________________
##
## generate area: Person Rating
## _____________________________________________________________________
##
# return unfolded HTML
$html->undivert(0);
return $html->string();
}
