--- quos.cgi 2004/10/28 15:37:43 1.8
+++ quos.cgi 2004/11/02 15:30:55 1.9
@@ -30,6 +30,7 @@
use CGI;
use String::Divert;
use IO::File;
+use Data::Dumper;
# internal handling of fatal errors
BEGIN {
@@ -139,6 +140,122 @@
# 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
##
@@ -205,9 +322,6 @@
$html >> "query";
-my $nr_cols = ($cgi->param('nr_cols') || $cfg->{-cols});
-my $nr_rows = ($cgi->param('nr_rows') || $cfg->{-rows});
-
# render outer form canvas
$html .= $cgi->start_form;
$html .= "<table>\n";
@@ -226,13 +340,18 @@
$html .= " "; $html->fold("query-form-define");
$html .= " </td>\n";
$html .= " </tr>\n";
+$html .= " <tr>\n";
+$html .= " <td class=\"status\">\n";
+$html .= " "; $html->fold("query-form-status");
+$html .= " </td>\n";
+$html .= " </tr>\n";
$html .= "</table>\n";
$html .= $cgi->end_form;
# render expression part
$html >> "query-form-expr";
$html .= "<table>\n";
-for (my $i = 0; $i < $nr_cols; $i++) {
+for (my $i = 0; $i < $nr_rows; $i++) {
$html .= "<tr>\n";
for (my $j = $nr_cols - 1; $j >= 0; $j--) {
$html .= " <td>\n";
@@ -240,9 +359,9 @@
$html .= " " . $cgi->popup_menu(
-id => $id,
-name => $id,
- -values => [' ', '(', ')', '!', '&', '|'],
+ -values => [' ', '!', '&', '|'],
-default => ' ',
- -class => 'default',
+ -class => ($err->{-form}->{$id} ? 'error' : 'default'),
-onChange => "return colorize(this.form.$id, ' ');",
-onBlur => "return colorize(this.form.$id, ' ');",
) . "\n";
@@ -255,7 +374,7 @@
-name => $id,
-values => ['', 'name', 'description', 'foo'], # FIXME
-default => '', # FIXME
- -class => 'default',
+ -class => ($err->{-form}->{$id} ? 'error' : 'default'),
-onChange => "return colorize(this.form.$id, '');",
-onBlur => "return colorize(this.form.$id, '');",
) . "\n";
@@ -267,7 +386,7 @@
-name => $id,
-values => ['', '==', '!=', '<', '<=', '>', '>=', '=~', '!~'],
-default => '',
- -class => 'default',
+ -class => ($err->{-form}->{$id} ? 'error' : 'default'),
-onChange => "return colorize(this.form.$id, '');",
-onBlur => "return colorize(this.form.$id, '');",
). "\n";
@@ -278,7 +397,7 @@
-id => $id,
-name => $id,
-default => '',
- -class => '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, '');",
@@ -384,6 +503,15 @@
$html .= "</table>\n";
$html << 1;
+# render status part
+if ($err->{-msg} ne '') {
+ $html >> "query-form-status";
+ my $msg = $err->{-msg};
+ $msg =~ s/\n/<br>/sg;
+ $html .= "<span class=\"msg\">$msg</span>\n";
+ $html << 1;
+}
+
$html << 1;
##
@@ -399,13 +527,14 @@
##
$html >> "result";
-$html .= "FIXME<br>";
-foreach my $key ($cgi->param) {
- $html .= "<strong>$key</strong> -> ";
- my @values = $cgi->param($key);
- $html .= join(", ", @values) . "<br>\n";
-}
-$html << 1;
+#foreach my $key ($cgi->param) {
+# $html .= "<strong>$key</strong> -> ";
+# my @values = $cgi->param($key);
+# $html .= join(", ", @values) . "<br>\n";
+#}
+#$html << 1;
+$html .= "\$expr:\n" . Data::Dumper->Dump([$expr]). "<p>";
+$html .= "\$cstyle:\n". $cstyle . "<br>";
##
## Generate HTTP Reponse
|
