/Utils.hs

 1{- 
 2Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>
 3
 4This program is free software; you can redistribute it and/or modify
 5it under the terms of the GNU General Public License as published by
 6the Free Software Foundation; either version 2 of the License, or
 7(at your option) any later version.
 8
 9This program is distributed in the hope that it will be useful,
10but WITHOUT ANY WARRANTY; without even the implied warranty of
11MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12GNU General Public License for more details.
13
14You should have received a copy of the GNU General Public License
15along with this program; if not, write to the Free Software
16Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
17-}
18
19module Utils where
20
21import Types
22import Config
23import MissingH.Maybe
24import MissingH.Path
25import Control.Concurrent
26import Control.Exception
27import System.IO
28--import Foreign.C.String
29import Data.List
30
31
32getFSPath :: GAddress -> FilePath
33getFSPath ga =
34    forceMaybeMsg ("getFSPath1 " ++ show ga) . secureAbsNormPath (baseDir ++ "/gopher") $ base
35    where base = (host ga) ++ "/" ++ (show $ port ga) ++ "/" ++
36              (path ga) ++ case (dtype ga) of
37                                           '1' -> "/.gophermap"
38                                           _ -> ""
39
40newLock :: IO Lock
41newLock = newEmptyMVar
42
43acquire :: Lock -> IO ()
44acquire l =
45    do t <- myThreadId
46       putMVar l t
47
48release :: Lock -> IO ()
49release l =
50    do t <- myThreadId
51       r <- tryTakeMVar l
52       case r of
53              Nothing -> do msg $ "Warning: released lock which was unheld."
54              Just x -> if x == t
55                            then return ()
56                            else fail $ "Thread " ++ (show t) ++
57                                        " released lock held by thread " ++
58                                        (show x)
59
60withLock :: Lock -> (IO a) -> IO a
61withLock l action = bracket_ (acquire l) (release l) action
62
63msg :: String -> IO ()
64msg l =
65    do t <- myThreadId
66       let disp = (show t) ++ ": " ++ l ++ "\n"
67       putStr disp
68       hFlush stdout
69       --withCStringLen disp (\(c, len) -> hPutBuf stdout c len >> hFlush stdout)
70
71ce :: String -> String
72ce i =
73    '\'' : 
74         (concat $ map (\c -> if c == '\'' then "''" else [c]) i)
75    ++ "'"