replacement for popen

Simon Marlow simonmar at microsoft.com
Tue Apr 12 08:35:04 EDT 2005


On 12 April 2005 13:22, Uwe Schmidt wrote:

> in the ghc-6.4 release the posix module is deprecated.
> I'm looking for a replacement and tried the
> System.Process functions. the following first try
> does not work for large files. it blocks if the
> file "long.file" does not fit into one os-buffer.
> then cat blocks and therefor waitForProcess blocks
> 
> ------------------------------------
> 
> module Main where
> 
> import IO
> import System
> import System.Process
> 
> main :: IO ()
> main = do
>        (inpH, outH, errH, pH) <- runInteractiveProcess "cat"
>        ["long.file"] Nothing Nothing hClose inpH
>        res  <- hGetContents outH
>        errs <- hGetContents errH
> 
>        rc <- waitForProcess pH
> 
>        putStrLn ("rc: " ++ show rc)
>        putStrLn ("stdout: " ++ res)
>        putStrLn ("stderr: " ++ errs)
>        exitWith rc
>
> ----------------------
> 
> the following version works fine, but it looks very much like a hack
> 
> ---------------------
> 
> module Main where
> 
> import IO
> import System
> import System.Process
> 
> main :: IO ()
> main = do
>        (inpH, outH, errH, pH) <- runInteractiveProcess "cat"
>        ["long.filel"] Nothing Nothing hClose inpH
>        res  <- hGetContents outH
>        errs <- hGetContents errH
> 
>        if (length $! res) == 0  -- hack !!!
> 	  then return ()
> 	  else return ()
> 
>        if (length $! errs) /= 0 -- hack !!!
> 	  then return ()
> 	  else return ()
> 
>        rc <- waitForProcess pH
> 
>        putStrLn ("rc: " ++ show rc)
>        putStrLn ("stdout: " ++ res)
>        putStrLn ("stderr: " ++ errs)
>        exitWith rc

If you really must use hGetContents, then the hack above is necessary:
you have to force the output strings before waiting for the process to
terminate.  This would be slightly cleaner:

>        res  <- hGetContents outH
>        errs <- hGetContents errH
>        forkIO (evaluate (length res))
>        forkIO (evaluate (length errs))

which avoids blocking the main thread, but ensures that all the data
gets pulled as it becomes available.

It looks like the same hack would be required with the old POpen
interface too - if not, can you show an example of something that works
with popen but not with System.Process?

Cheers,
	Simon


More information about the Libraries mailing list