head 1.2;
access;
symbols;
locks; strict;
comment @# @;
1.2
date 2003.05.29.18.52.55; author rse; state Exp;
branches;
next 1.1;
1.1
date 2003.05.29.11.03.04; author rse; state Exp;
branches;
next ;
desc
@@
1.2
log
@fully work-off person select and detail areas after code restructuring
@
text
@#!/usr/opkg/bin/perl
##
## OSSP sdb -- Skill Database
## Copyright (c) 2003 The OSSP Project
## Copyright (c) 2003 Cable & Wireless Deutschland
## Copyright (c) 2003 Ralf S. Engelschall
##
## 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 .
##
## 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 => "\n\n\@@HEAD\@@\n\n\n\@@BODY\@@\n"
};
# 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 "{TEMPLATE} = '';
$my->{TEMPLATE} .= $_ while (<$io>);
$io->close();
}
# optionally activate CSS
if (-f "sdb.css") {
$head .= "";
}
# 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| \n|sg;
$err =~ s|\n+$||s;
$head .= "".$my->{PROG_NAME}.": ERROR";
$body .= "
ERROR" .
"The following error occured:
" .
"
$err
\n";
# debugging
$body .= "
";
my @@names = $cgi->param;
foreach my $name (@@names) {
my $value = $cgi->param($name);
$body .= "$name=\"$value\"\n";
}
$body .= "
";
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 .= "\n";
$html .= "
\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 .= "
\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];
d681 8
a688 1
$html << q{select-list};
d690 8
a697 2
# generate the selection list attached buttons
$html >> "select-buttons";
d699 62
a760 20
-name => 'person.select.ADD',
-value => 'Add Person →',
-class => 'ADD'
) . " ";
if (@@{$pe_values} > 0) {
$html .= $cgi->submit(
-name => 'person.select.VIEW',
-value => 'View Person →',
-class => 'VIEW'
) . " ";
$html .= $cgi->submit(
-name => 'person.select.EDIT',
-value => "Edit Person →",
-class => "EDIT"
) . " ";
$html .= $cgi->submit(
-name => 'person.select.DELETE',
-value => '← Delete Person',
-class => 'DELETE'
) . " ";
a761 3
$html << q{select-buttons};
$html << q{area1};
d764 1
a764 2
$html >> q{area1};
$html << q{area1};
d767 16
a782 23
# generate area: BEGIN PERSON DETAIL BOX
if ($ui->{person}->{detail}->{-is} eq 'visible') {
$html .= "";
# determine content variant
my $action = $ui->{person}->{detail}->{-with};
$html .= "
".uc(substr($action,0,1)).substr($action,1)." Person
";
$html .= "";
# 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";
}
d785 1
a785 21
$pe = { id => '', name => '', email => '', phone => '' };
}
# display person details
$html .= "
\n";
$html .= "";
$html .= "";
}
# END PERSON DETAIL BOX
if ($edit eq 'rate' or $do eq 'view-skill') {
if ($edit eq 'rate') {
$html .= "
Edit Skills
";
d835 6
a840 12
else {
$html .= "
View Skills
";
}
my $pe_id = $cgi->param('person.id');
if ($pe_id eq '') {
die "no person selected";
}
my $rv = $db->selectall_arrayref(
"SELECT sk_id,sk_name" .
" FROM sdb_skill " .
" ORDER BY sk_name;"
d842 13
a854 55
my $deg = $db->selectall_hashref(
"SELECT sk_id,as_degree" .
" FROM sdb_skill,sdb_provide" .
" WHERE as_pe_id = '$pe_id' AND as_sk_id = sk_id;",
'sk_id'
);
$html .= "
\n";
$html .= "
";
$html .= "
\n";
my $i = 0;
my $n = 0;
my $med = sprintf("%d", ($#{$rv}+1)/2);
$html .= $cgi->hidden(-name => 'rate.pe_id', -default => $pe_id);
foreach my $sk (@@{$rv}) {
if ($n == $med) {
$html .= "