OSSP quos: GURU MEDITATION

#!/usr/opkg/bin/perl -w ## ## OSSP quos - Query On Steroids ## Copyright (c) 2004 Ralf S. Engelschall ## Copyright (c) 2004 The OSSP Project ## ## This file is part of OSSP quos, a Web user interface for querying ## a database which can be found at http://www.ossp.org/pkg/tool/quos/. ## ## 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 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 Ralf S. Engelschall . ## ## quos.cgi: web user interface ## require 5.008; use strict; use CGI; use String::Divert; use IO::File; use Data::Dumper; # internal handling of fatal errors BEGIN { $SIG{__DIE__} = sub { my ($msg) = @_; my $hint = ''; if ($msg =~ m|line\s+(\d+)|) { my $line = $1; my $io = new IO::File "<$0"; my @code = $io->getlines(); $io->close(); my $i = -1; $hint = join("", map { s/^/sprintf("%d: ", $line+$i++)/se; $_; } @code[$line-2..$line]); } print STDOUT "Content-Type: text/html; charset=ISO-8859-1\n" . "\n" . "\n" . " \n" . " OSSP quos: GURU MEDITATION\n" . " \n" . " \n" . " \n" . " \n" . "

\n" . "

\n" . " OSSP quos: GURU MEDITATION\n" . "

\n" . " \n" . " $msg \n" . "\n" . "

\n$hint

\n" . "

\n" . " \n" . "\n"; exit(0); }; } # create objects my $cgi = new CGI; my $html = new String::Divert; $html->overload(1); ## ## Read Config File ## my $cfg = { -cols => 4, -rows => 7, }; # FIXME ## ## Query Processing ## my $nr_cols = ($cgi->param('nr_cols') || $cfg->{-cols}); my $nr_rows = ($cgi->param('nr_rows') || $cfg->{-rows}); my $err = { -msg => '', -form => {}, }; &validate_form($cgi, $err, $nr_cols, $nr_rows); my $expr = &parse_form($cgi, $err, undef, $nr_cols-1, 0, 0, $nr_rows-1, 0); sub validate_form { my ($cgi, $err, $nr_cols, $nr_rows) = @_; for (my $y = 1; $y <= $nr_rows-1; $y++) { my $n = 0; my $fn = $cgi->param(sprintf("fn%02d", $y)); my $fo = $cgi->param(sprintf("fo%02d", $y)); if (defined($fn) and defined($fo)) { if (($fn ne '' and $fo eq '') or ($fn eq '' and $fo ne '')) { $err->{-msg} .= "form line ".($y+1).": both field name and operator required\n"; $err->{-form}->{sprintf("fn%02d", $y)}++; $err->{-form}->{sprintf("fo%02d", $y)}++; $err->{-form}->{sprintf("fv%02d", $y)}++; } if ($fn ne '' or $fo ne '') { for (my $x = $nr_cols-1; $x >= 0; $x--) { my $op = $cgi->param(sprintf("lo%02d%02d", $x, $y)); if (defined($op) and $op ne ' ') { $n++; last; } } if ($n == 0) { $err->{-msg} .= "form line ".($y+1).": no operator for sub-expression found\n"; $err->{-form}->{sprintf("fn%02d", $y)}++; $err->{-form}->{sprintf("fo%02d", $y)}++; $err->{-form}->{sprintf("fv%02d", $y)}++; } } } } } sub parse_form { my ($cgi, $err, $erase, $tlx, $tly, $brx, $bry, $depth) = @_; $erase = {} if (not defined($erase)); my $expr = undef; if ($tlx < 0) { # field operator area my $fn = $cgi->param(sprintf("fn%02d", $tly)); my $fo = $cgi->param(sprintf("fo%02d", $tly)); my $fv = $cgi->param(sprintf("fv%02d", $tly)); if (defined($fn) and defined($fo) and $fn ne '' and $fo ne '') { $expr = [ $fo, $fn, $fv ]; } } else { # logical operator area LOOP: for (my $x = $tlx; $x >= $brx; $x--) { for (my $y = $tly; $y <= $bry; $y++) { my $op = $cgi->param(sprintf("lo%02d%02d", $x, $y)); if (defined($op) and $op ne ' ' and not $erase->{$x."/".$y}) { $erase->{$x."/".$y} = 1; if ($op eq '!') { my $expr1 = &parse_form($cgi, $erase, $x, $y, $brx, $bry, $depth+1); $expr = [ $op, $expr1 ]; } else { if ($tly > $y-1) { $err->{-msg} .= "form line ".($y+1).", column ".($nr_cols-$x).": unexpected binary operator\n"; $err->{-form}->{sprintf("lo%02d%02d", $x, $y)}++; } my $expr1 = &parse_form($cgi, $err, $erase, $x-1, $tly, $brx, $y-1, $depth+1); my $expr2 = &parse_form($cgi, $err, $erase, $x, $y, $brx, $bry, $depth+1); if (not defined($expr1)) { $err->{-msg} .= "form line ".($y+1).", column ".($nr_cols-$x).": no expressions LHS found\n"; $err->{-form}->{sprintf("lo%02d%02d", $x, $y)}++; } if (not defined($expr2)) { $err->{-msg} .= "form line ".($y+1).", column ".($nr_cols-$x).": no expressions RHS found\n"; $err->{-form}->{sprintf("lo%02d%02d", $x, $y)}++; } $expr = [ $op, $expr1, $expr2 ]; } last LOOP; } } } if (not defined($expr)) { $expr = &parse_form($cgi, $err, $erase, $brx-1, $tly, $brx-1, $tly, $depth+1); } } return $expr; } my $cstyle = &expr2cstyle($expr); sub expr2cstyle { my ($expr) = @_; my $op = $expr->[0]; my $cstyle; if ($op eq '!') { my $expr1 = ref($expr->[1]) ? &expr2cstyle($expr->[1]) : $expr->[1]; $cstyle = sprintf("(%s %s)", $op, $expr1); } else { my $expr1 = ref($expr->[1]) ? &expr2cstyle($expr->[1]) : $expr->[1]; my $expr2 = ref($expr->[2]) ? &expr2cstyle($expr->[2]) : $expr->[2]; $cstyle = sprintf("(%s %s %s)", $expr1, $op, $expr2); } return $cstyle; } ## ## Generate Canvas ## # generate Javascript utility functions $html .= "\n"; # generate outer canvas $html .= "\n"; $html .= " "; $html->fold("quos"); $html .= "

\n"; $html >> "quos"; # generate browse part $html .= "\n"; $html .= " \n"; $html .= " Browse
\n"; $html .= " "; $html->fold("browse"); $html .= " \n"; $html .= "\n"; # generate query part $html .= "\n"; $html .= " \n"; $html .= " Query
\n"; $html .= " "; $html->fold("query"); $html .= " \n"; $html .= "\n"; # generate view part $html .= "\n"; $html .= " \n"; $html .= " View
\n"; $html .= " "; $html->fold("view"); $html .= " \n"; $html .= "\n"; # generate result part $html .= "\n"; $html .= " \n"; $html .= " Result
\n"; $html .= " "; $html->fold("result"); $html .= " \n"; $html .= "\n"; ## ## Generate Browser Part ## $html >> "browse"; $html .= "FIXME"; $html << 1; ## ## Generate Query Part ## $html >> "query"; # render outer form canvas $html .= $cgi->start_form; $html .= "\n"; $html .= " \n"; $html .= " \n"; $html .= " \n"; $html .= " \n"; $html .= " \n"; $html .= " \n"; $html .= " \n"; $html .= " \n"; $html .= " \n"; $html .= " \n"; $html .= " \n"; $html .= " \n"; $html .= "

\n"; $html .= " "; $html->fold("query-form-expr"); $html .= "

\n"; $html .= " "; $html->fold("query-form-button"); $html .= "

\n"; $html .= " "; $html->fold("query-form-define"); $html .= "

\n"; $html .= " "; $html->fold("query-form-status"); $html .= "

\n"; $html .= $cgi->end_form; # render expression part $html >> "query-form-expr"; $html .= "\n"; for (my $i = 0; $i < $nr_rows; $i++) { $html .= "\n"; for (my $j = $nr_cols - 1; $j >= 0; $j--) { $html .= " \n"; } $html .= " \n"; $html .= " \n"; $html .= " \n"; $html .= "\n"; } $html .= "

\n"; my $id = sprintf("lo%02d%02d", $j, $i); $html .= " " . $cgi->popup_menu( -id => $id, -name => $id, -values => [' ', '!', '&', '|'], -default => ' ', -class => ($err->{-form}->{$id} ? 'error' : 'default'), -onChange => "return colorize(this.form.$id, ' ');", -onBlur => "return colorize(this.form.$id, ' ');", ) . "\n"; $html .= "

\n"; my $id = sprintf("fn%02d", $i); $html .= " " . $cgi->popup_menu( -id => $id, -name => $id, -values => ['', 'name', 'description', 'foo'], # FIXME -default => '', # FIXME -class => ($err->{-form}->{$id} ? 'error' : 'default'), -onChange => "return colorize(this.form.$id, '');", -onBlur => "return colorize(this.form.$id, '');", ) . "\n"; $html .= "

\n"; $id = sprintf("fo%02d", $i); $html .= " " . $cgi->popup_menu( -id => $id, -name => $id, -values => ['', '==', '!=', '<', '<=', '>', '>=', '=~', '!~'], -default => '', -class => ($err->{-form}->{$id} ? 'error' : 'default'), -onChange => "return colorize(this.form.$id, '');", -onBlur => "return colorize(this.form.$id, '');", ). "\n"; $html .= "

\n"; $id = sprintf("fv%02d", $i); $html .= " " . $cgi->textfield( -id => $id, -name => $id, -default => '', -class => ($err->{-form}->{$id} ? 'error' : 'default'), -onChange => "return colorize(this.form.$id, '');", -onBlur => "return colorize(this.form.$id, '');", -onMouseOut => "return colorize(this.form.$id, '');", ); $html .= "

\n"; $html << 1; # render button part $html >> "query-form-button"; $html .= "\n"; $html .= " \n"; $html .= " \n"; $html .= " \n"; $html .= " \n"; $html .= " \n"; $html .= " \n"; $html .= "

"; $html .= " " . "← " . $cgi->popup_menu( -name => "nr_cols", -values => [ 0..9 ], -default => $nr_cols, ) . "\n"; $html .= " " . "↓ " . $cgi->popup_menu( -name => "nr_rows", -values => [1..9], -default => $nr_rows, ) . "\n"; $html .= "

\n"; $html .= " " . $cgi->submit( -name => 'act_matrix_upd', -value => 'update', -class => 'update' ) . "\n"; $html .= "

\n"; $html .= " " . $cgi->submit( -name => 'act_matrix_clear', -value => 'clear', -class => 'clear' ) . "\n"; $html .= "

\n"; $html .= " " . $cgi->submit( -name => 'act_matrix_submit', -value => 'submit', -class => 'submit' ) . "\n"; $html .= "

\n"; $html << 1; # render define part $html >> "query-form-define"; $html .= "\n"; $html .= " \n"; $html .= " \n"; $html .= " \n"; $html .= " \n"; $html .= " \n"; $html .= " \n"; $html .= " \n"; $html .= " \n"; $html .= " \n"; $html .= " \n"; $html .= "

\n"; $html .= " " . $cgi->popup_menu( -id => "namexx", -name => "namexx", -values => ['HTML: by-group', 'HTML: by-xxx', 'TXT: by-group'], # FIXME -default => 'HTML: by-group', # FIXME -class => 'nameget', ) . "\n"; $html .= "	\n"; $html .= " " . $cgi->submit( -name => 'act_matrix_clear', -value => 'load', -class => 'load' ) . "\n"; $html .= "	\n"; $html .= " " . $cgi->submit( -name => 'act_matrix_submit', -value => 'delete', -class => 'delete' ) . "\n"; $html .= "
\n"; $html .= " " . $cgi->textfield( -name => 'name_persquery', -value => '', -class => 'nameset' ) . "\n"; $html .= "	\n"; $html .= " " . $cgi->submit( -name => 'act_matrix_clear', -value => 'save', -class => 'save' ) . "\n"; $html .= "	\n"; $html .= " " . $cgi->submit( -name => 'act_matrix_hyperlink', -value => 'hyperlink', -class => 'hyperlink' ) . "\n"; $html .= "

\n"; $html << 1; # render status part if ($err->{-msg} ne '') { $html >> "query-form-status"; my $msg = $err->{-msg}; $msg =~ s/\n/
/sg; $html .= "$msg\n"; $html << 1; } $html << 1; ## ## Generate View Part ## $html >> "view"; $html .= "FIXME"; $html << 1; ## ## Generate Result Part ## $html >> "result"; #foreach my $key ($cgi->param) { # $html .= "$key -> "; # my @values = $cgi->param($key); # $html .= join(", ", @values) . "
\n"; #} #$html << 1; $html .= "\$expr:\n" . Data::Dumper->Dump([$expr]). "

"; $html .= "\$cstyle:\n". $cstyle . "
"; ## ## Generate HTTP Reponse ## # read HTML skeleton my $io = new IO::File "); $io->close(); # undivert HTML output and wrap with skeleton $html->undivert(0); $skel =~ s|\%BODY\%|$html|s; $html = $skel; # create HTTP response my $http = $cgi->header( -type => 'text/html', -expires => '+10s' ); $http .= $html; print STDOUT $http; # die gracefully ;-) exit(0); __END__ =pod =head1 NAME B - Query On Steroids =head1 DESCRIPTION ...FIXME... =head1 LOGICAL LAYOUT 1. Browse - Groups . Hyperlinks 2. Query - Groups . Field (database schema) . Operator (compare) . Value (depends on compare) 3. View - Selection predefined output format - OSSP var based formatting string - ordering - save custom view 4. Result - based on View =cut