slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

web: fix stack overflow caused by regexpr, and handle requests faster (#14)

Browse Source
This commit is contained in:
Simon Michael 2010-02-16 03:31:38 +00:00
parent 07325ed640
commit 2cd9aaf81f
1 changed files with 11 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
Commands/Web.hs
View File

@ -168,12 +168,11 @@ hsp msgs f = do
html =<< (io $ do html =<< (io $ do
hspenv <- hackEnvToHspEnv env hspenv <- hackEnvToHspEnv env
(_,xml) <- runHSP html4Strict pagehsp hspenv (_,xml) <- runHSP html4Strict pagehsp hspenv
return $ addDoctype $ applyFixups $ renderAsHTML xml) return $ addDoctype $ renderAsHTML xml)
response $ set_content_type _TextHtmlUTF8 response $ set_content_type _TextHtmlUTF8
where where
title = "" title = ""
addDoctype = ("<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\" \"http://www.w3.org/TR/html4/strict.dtd\">\n" ++) addDoctype = ("<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\" \"http://www.w3.org/TR/html4/strict.dtd\">\n" ++)
applyFixups = gsubRegexPR "\\[NBSP\\]" "&nbsp;"
hackEnvToHspEnv :: Hack.Env -> IO HSPEnv hackEnvToHspEnv :: Hack.Env -> IO HSPEnv
hackEnvToHspEnv env = do hackEnvToHspEnv env = do
x <- newIORef 0 x <- newIORef 0
@ -229,11 +228,11 @@ searchform env = do
a <- getParamOrNull "a" a <- getParamOrNull "a"
p <- getParamOrNull "p" p <- getParamOrNull "p"
let resetlink | null a && null p = <span></span> let resetlink | null a && null p = <span></span>
| otherwise = <span id="resetlink">[NBSP]<a href=u>reset</a></span> | otherwise = <span id="resetlink"><% nbsp %><a href=u>reset</a></span>
where u = dropWhile (=='/') $ Hack.Contrib.Request.path env where u = dropWhile (=='/') $ Hack.Contrib.Request.path env
<form action="" id="searchform"> <form action="" id="searchform">
[NBSP]account pattern:[NBSP]<input name="a" size="20" value=a <% nbsp %>account pattern:<% nbsp %><input name="a" size="20" value=a
/>[NBSP][NBSP]reporting period:[NBSP]<input name="p" size="20" value=p /> /><% nbsp %><% nbsp %>reporting period:<% nbsp %><input name="p" size="20" value=p />
<input type="submit" name="submit" value="filter" style="display:none" /> <input type="submit" name="submit" value="filter" style="display:none" />
<% resetlink %> <% resetlink %>
</form> </form>
@ -255,8 +254,8 @@ addform env = do
<table border="0"> <table border="0">
<tr> <tr>
<td> <td>
Date: <input size="15" name="date" value=date />[NBSP] Date: <input size="15" name="date" value=date /><% nbsp %>
Description: <input size="35" name="desc" value=desc />[NBSP] Description: <input size="35" name="desc" value=desc /><% nbsp %>
</td> </td>
</tr> </tr>
<% transactionfields 1 env %> <% transactionfields 1 env %>
@ -280,9 +279,9 @@ transactionfields n env = do
#endif #endif
<tr> <tr>
<td> <td>
[NBSP][NBSP] <% nbsp %><% nbsp %>
Account: <input size="35" name=acctvar value=acct />[NBSP] Account: <input size="35" name=acctvar value=acct /><% nbsp %>
Amount: <input size="15" name=amtvar value=amt />[NBSP] Amount: <input size="15" name=amtvar value=amt /><% nbsp %>
</td> </td>
</tr> </tr>
where where
@ -369,3 +368,5 @@ handleAddform l = do
ledgerpage [msg] l (showTransactions (optsToFilterSpec [] [] ti)) ledgerpage [msg] l (showTransactions (optsToFilterSpec [] [] ti))
where msg = printf "Added transaction:\n%s" (show t) where msg = printf "Added transaction:\n%s" (show t)
nbsp :: XML
nbsp = cdata "&nbsp;"