Index: ossp-pkg/quos/quos.cgi
RCS File: /v/ossp/cvs/ossp-pkg/quos/quos.cgi,v
rcsdiff -q -kk '-r1.8' '-r1.9' -u '/v/ossp/cvs/ossp-pkg/quos/quos.cgi,v' 2>/dev/null
--- 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> -&gt; ";
-    my @values = $cgi->param($key);
-    $html .= join(", ", @values) . "<br>\n";
-}
-$html << 1;
+#foreach my $key ($cgi->param) {
+#    $html .= "<strong>$key</strong> -&gt; ";
+#    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
Index: ossp-pkg/quos/quos.css
RCS File: /v/ossp/cvs/ossp-pkg/quos/quos.css,v
rcsdiff -q -kk '-r1.5' '-r1.6' -u '/v/ossp/cvs/ossp-pkg/quos/quos.css,v' 2>/dev/null
--- quos.css	2004/10/28 15:40:19	1.5
+++ quos.css	2004/11/02 15:30:55	1.6
@@ -88,6 +88,11 @@
 .quos .query .expr INPUT.changed {
     background:          #ffffff;
 }
+.quos .query .expr INPUT.error {
+    border:              2px solid #cc3333;
+    background:          #cc3333;
+    color:               #ffffff;
+}
 .quos .query .expr SELECT {
     background:          inherit;
     border-top:          1px solid #c0c0c0;
@@ -101,6 +106,11 @@
 .quos .query .expr SELECT.changed {
     background:          #ffffff;
 }
+.quos .query .expr SELECT.error {
+    border:              2px solid #cc3333;
+    background:          #cc3333;
+    color:               #ffffff;
+}
 .quos .query .expr TABLE {
     border-collapse: collapse;
     border-spacing: 0px;
@@ -152,3 +162,14 @@
 .quos .query .define INPUT.nameset {
     width: 100%;
 }
+
+.quos .query .status TABLE {
+    width: 100%;
+    border-collapse: collapse;
+    border-spacing: 0px;
+}
+.quos .query .status .msg {
+    color: #cc3333;
+    font-weight: bold;
+}
+