summaryrefslogtreecommitdiff
path: root/src/server
diff options
context:
space:
mode:
authorkrasimir <krasimir@chalmers.se>2010-04-22 14:01:08 +0000
committerkrasimir <krasimir@chalmers.se>2010-04-22 14:01:08 +0000
commite3a279e457c8159c07db2db652dbe151afb51f36 (patch)
treec3cf73a14297d7c40288b7403f4d778282032a6b /src/server
parentba7467a550b83c942fbeb414667697337d3ca3a9 (diff)
now the PGF service communicates with Graphviz using UTF8 for the input and binary for the output
Diffstat (limited to 'src/server')
-rw-r--r--src/server/FastCGIUtils.hs5
-rw-r--r--src/server/PGFService.hs45
-rw-r--r--src/server/gf-server.cabal3
-rw-r--r--src/server/gwt/Translate-compile2
4 files changed, 46 insertions, 9 deletions
diff --git a/src/server/FastCGIUtils.hs b/src/server/FastCGIUtils.hs
index 8d90c9fa7..43b16eea0 100644
--- a/src/server/FastCGIUtils.hs
+++ b/src/server/FastCGIUtils.hs
@@ -27,6 +27,7 @@ import Network.FastCGI
import Text.JSON
import qualified Codec.Binary.UTF8.String as UTF8 (encodeString, decodeString)
+import qualified Data.ByteString.Lazy as BS
initFastCGI :: IO ()
@@ -168,10 +169,10 @@ outputJSONP x =
setHeader "Content-Type" "text/json; charset=utf-8"
outputStrict $ UTF8.encodeString str
-outputPNG :: String -> CGI CGIResult
+outputPNG :: BS.ByteString -> CGI CGIResult
outputPNG x = do
setHeader "Content-Type" "image/png"
- outputStrict x
+ outputFPS x
outputHTML :: String -> CGI CGIResult
outputHTML x = do
diff --git a/src/server/PGFService.hs b/src/server/PGFService.hs
index 0ee7391e2..7a57bba81 100644
--- a/src/server/PGFService.hs
+++ b/src/server/PGFService.hs
@@ -9,8 +9,10 @@ import URLEncoding
import Network.FastCGI
import Text.JSON
import qualified Codec.Binary.UTF8.String as UTF8 (encodeString, decodeString)
+import qualified Data.ByteString.Lazy as BS
import Control.Concurrent
+import Control.Exception
import Control.Monad
import Data.Char
import Data.Function (on)
@@ -20,6 +22,8 @@ import Data.Maybe
import System.Directory
import System.FilePath
import System.Process
+import System.Exit
+import System.IO
logFile :: FilePath
logFile = "pgf-error.log"
@@ -206,16 +210,45 @@ doGrammar pgf macc = showJSON $ toJSObject
functions = [PGF.showCId fun | fun <- PGF.functions pgf]
doGraphvizAbstrTree pgf tree = do
- let dot = PGF.graphvizAbstractTree pgf (True,True) tree
- readProcess "dot" ["-T","png"] dot
+ pipeIt2graphviz $ PGF.graphvizAbstractTree pgf (True,True) tree
doGraphvizParseTree pgf lang tree = do
- let dot = PGF.graphvizParseTree pgf lang tree
- readProcess "dot" ["-T","png"] (UTF8.encodeString dot)
+ pipeIt2graphviz $ PGF.graphvizParseTree pgf lang tree
doGraphvizAlignment pgf tree = do
- let dot = PGF.graphvizAlignment pgf tree
- readProcess "dot" ["-T","png"] (UTF8.encodeString dot)
+ pipeIt2graphviz $ PGF.graphvizAlignment pgf tree
+
+pipeIt2graphviz :: String -> IO BS.ByteString
+pipeIt2graphviz code = do
+ (Just inh, Just outh, _, pid) <-
+ createProcess (proc "dot" ["-T","png"])
+ { std_in = CreatePipe,
+ std_out = CreatePipe,
+ std_err = Inherit }
+
+ hSetEncoding outh latin1
+ hSetEncoding inh utf8
+
+ -- fork off a thread to start consuming the output
+ output <- BS.hGetContents outh
+ outMVar <- newEmptyMVar
+ _ <- forkIO $ evaluate (BS.length output) >> putMVar outMVar ()
+
+ -- now write and flush any input
+ hPutStr inh code
+ hFlush inh
+ hClose inh -- done with stdin
+
+ -- wait on the output
+ takeMVar outMVar
+ hClose outh
+
+ -- wait on the process
+ ex <- waitForProcess pid
+
+ case ex of
+ ExitSuccess -> return output
+ ExitFailure r -> fail ("pipeIt2graphviz: (exit " ++ show r ++ ")")
doBrowse pgf id cssClass href =
case PGF.browse pgf id of
diff --git a/src/server/gf-server.cabal b/src/server/gf-server.cabal
index cdd61d933..bba60ceec 100644
--- a/src/server/gf-server.cabal
+++ b/src/server/gf-server.cabal
@@ -17,7 +17,8 @@ executable pgf-server
cgi >= 3001.1.7.0,
fastcgi >= 3001.0.2.1,
json >= 0.3.3,
- utf8-string >= 0.3.1.1
+ utf8-string >= 0.3.1.1,
+ bytestring
if !os(windows)
build-depends: unix
main-is: PGFService.hs
diff --git a/src/server/gwt/Translate-compile b/src/server/gwt/Translate-compile
index 42c02da33..a2c6faaf0 100644
--- a/src/server/gwt/Translate-compile
+++ b/src/server/gwt/Translate-compile
@@ -1,6 +1,8 @@
#!/bin/sh
APPDIR=`dirname $0`;
+export GWT_DIR="/home/angelov/gwt-linux-1.5.3"
+export GWT_CLASSPATH="$GWT_DIR/gwt-user.jar:$GWT_DIR/gwt-dev-linux.jar"
if [ -z "$GWT_CLASSPATH" ]; then
echo 'ERROR: $GWT_CLASSPATH is not set'