Mercurial > urweb

changeset 2238:7f92d70a326e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Only use string (rather than numeric, etc.) primitives in parsed SQL statements.
author Ziv Scully <ziv@mit.edu>
date Mon, 06 Jul 2015 01:31:04 -0700
parents e79ef5792c8b
children f70a91f7810d
files caching-tests/test.ur src/sql.sml
diffstat 2 files changed, 33 insertions(+), 10 deletions(-) [+]
line wrap: on
line diff
--- a/caching-tests/test.ur	Sun Jul 05 23:57:28 2015 -0700
+++ b/caching-tests/test.ur	Mon Jul 06 01:31:04 2015 -0700
@@ -14,7 +14,7 @@
 
 fun flush id =
      dml (UPDATE tab
-          SET Val = 42
+          SET Id = 29, Val = 42
           WHERE Id = {[id]} OR Id = {[id - 1]} OR Id = {[id + 1]});
     return <xml><body>
       Changed {[id]}!
--- a/src/sql.sml	Sun Jul 05 23:57:28 2015 -0700
+++ b/src/sql.sml	Mon Jul 06 01:31:04 2015 -0700
@@ -152,6 +152,18 @@
         end
       | _ => NONE
 
+(* Used by primSqlcache. *)
+fun optConst s chs =
+    case chs of
+        String s' :: chs => if String.isPrefix s s' then
+                                SOME (s, if size s = size s' then
+                                              chs
+                                          else
+                                              String (String.extract (s', size s, NONE)) :: chs)
+                            else
+                                SOME ("", String s' :: chs)
+      | _ => NONE
+
 fun ws p = wrap (follow (skip (fn ch => ch = #" "))
                         (follow p (skip (fn ch => ch = #" ")))) (#1 o #2)
 
@@ -256,6 +268,23 @@
           wrap (follow (opt (const "E")) (follow string (opt (const "::text"))))
                ((fn s => Prim.String (Prim.Normal, s)) o #1 o #2)]
 
+val primSqlcache =
+    (* Like [prim], but always uses [Prim.String]s. *)
+    let
+        fun wrapS p f = wrap p ((fn s => Prim.String (Prim.Normal, s)) o f)
+    in
+        altL [wrapS (follow (wrap (follow (keep Char.isDigit)
+                                          (follow (const ".") (keep Char.isDigit)))
+                                  (fn (x, ((), y)) => x ^ "." ^ y))
+                            (optConst "::float8"))
+                    op^,
+              wrapS (follow (keep Char.isDigit)
+                            (optConst "::int8"))
+                    op^,
+              wrapS (follow (optConst "E") (follow string (optConst "::text")))
+                    (fn (c1, (s, c2)) => c1 ^ s ^ c2)]
+end
+
 fun known' chs =
     case chs of
         Exp (EFfi ("Basis", "sql_known"), _) :: chs => SOME ((), chs)
@@ -278,7 +307,7 @@
 
 fun sqlifySqlcache chs =
     case chs of
-      (* Could have variables as well as FFIs. *)
+      (* Could have variables or constants as well as FFIs. *)
         Exp (e as (ERel _, _)) :: chs => SOME (e, chs)
       (* If it is an FFI, match the entire expression. *)
       | Exp (e as (EFfiApp ("Basis", f, [(_, _)]), _)) :: chs =>
@@ -286,13 +315,7 @@
             SOME (e, chs)
         else
             NONE
-      | Exp (ECase (e, [((PCon (_, PConFfi {mod = "Basis", con = "True", ...}, NONE), _),
-                         (EPrim (Prim.String (Prim.Normal, "TRUE")), _)),
-                        ((PCon (_, PConFfi {mod = "Basis", con = "False", ...}, NONE), _),
-                         (EPrim (Prim.String (Prim.Normal, "FALSE")), _))], _), _) :: chs =>
-        SOME (e, chs)
-
-      | _ => NONE
+      | _ => sqlify chs
 
 fun constK s = wrap (const s) (fn () => s)
 
@@ -309,7 +332,7 @@
 
 fun sqexp chs =
     log "sqexp"
-    (altL [wrap prim SqConst,
+    (altL [wrap (if !sqlcacheMode then primSqlcache else prim) SqConst,
            wrap (const "TRUE") (fn () => SqTrue),
            wrap (const "FALSE") (fn () => SqFalse),
            wrap (const "NULL") (fn () => Null),