Record to save changes

darcs-hash:20071026044928-62b54-9cb4db09f44d8ee1c2ae288321dd84d4740d77f6.gz

diff --git a/Rakka/Storage.hs b/Rakka/Storage.hs
index fc5637d7b686dff5a6eefc900132e4641c7f5760..023806134a52a2854b5da15263133aea984b950a 100644 (file)
--- a/Rakka/Storage.hs
+++ b/Rakka/Storage.hs
@@ -13,6 +13,7 @@ module Rakka.Storage
 
 import           Control.Arrow.ArrowIO
 import           Control.Concurrent.STM
+import           Control.Exception
 import           Control.Monad
 import           Control.Monad.Trans
 import           Data.Set (Set)
@@ -21,15 +22,14 @@ import           Rakka.Storage.DefaultPage
 import           Subversion.Types
 import           System.Directory
 import           System.FilePath
+import           System.IO
 import           System.Log.Logger
+import           System.Posix.Files
+import           System.Posix.Types
+import           System.Posix.IO
+import           Subversion.FileSystem
 import           Subversion.Repository
-import           Text.HyperEstraier
-
--- FIXME
-import Data.Encoding
-import Data.Encoding.UTF8
-import qualified Data.ByteString.Lazy.Char8 as C8
--- FIXME
+import           Text.HyperEstraier hiding (WriteLock)
 
 logger = "Rakka.Storage"
 
@@ -87,6 +87,17 @@ findAllPages sto revNum
     = findAllDefaultPages -- FIXME
 
 
+findChangedPages :: Storage -> RevNum -> RevNum -> IO (Set PageName)
+findChangedPages sto 0      newRev = findAllPages sto newRev
+findChangedPages sto oldRev newRev
+    = fail "fixme: not impl"
+
+
+getCurrentRevNum :: Storage -> IO RevNum
+getCurrentRevNum sto
+    = getRepositoryFS (stoRepository sto) >>= getYoungestRev
+
+
 -- casket を R/W モードで開く。成功したらそのまま返し、失敗したら
 -- indexDir と revFile を削除してから casket を R/W モードで開く。
 openIndex :: FilePath -> FilePath -> IO Database
@@ -117,8 +128,60 @@ openIndex indexDir revFile
 
 syncIndex :: Storage -> IO ()
 syncIndex sto
-    = do Just page <- getPage sto "MainPage"
-         doc       <- stoMakeDraft sto page
-         putStrLn "*** dumping draft..."
-         dumpDraft doc >>= C8.putStr . encodeLazy UTF8
-         putStrLn "*** dumped"
\ No newline at end of file
+    = updateIndexRev sto $ \ oldRev ->
+      do debugM logger ("The index revision is currently " ++ show oldRev)
+         
+         newRev <- getCurrentRevNum sto
+         debugM logger ("The repository revision is currently " ++ show newRev)
+
+         when (newRev /= oldRev) (syncIndex' oldRev newRev)
+
+         return oldRev -- FIXME
+    where
+      syncIndex' :: RevNum -> RevNum -> IO ()
+      syncIndex' oldRev newRev
+          = do pages <- findChangedPages sto oldRev newRev
+               print pages
+
+
+updateIndexRev :: Storage -> (RevNum -> IO RevNum) -> IO ()
+updateIndexRev sto f = bracket acquireLock releaseLock update
+    where
+      acquireLock :: IO Fd
+      acquireLock
+          = do atomically $ do revLocked <- readTVar (stoIndexRevLocked sto)
+                               if revLocked then
+                                   retry
+                                 else
+                                   writeTVar (stoIndexRevLocked sto) True
+               fd <- openFd (stoIndexRevFile sto) ReadWrite (Just stdFileMode) defaultFileFlags
+               waitToSetLock fd (WriteLock, AbsoluteSeek, 0, 0)
+               return fd
+
+      releaseLock :: Fd -> IO ()
+      releaseLock fd
+          = do setLock fd (Unlock, AbsoluteSeek, 0, 0)
+               atomically $ writeTVar (stoIndexRevLocked sto) False
+
+      update :: Fd -> IO ()
+      update fd
+          = do fdSeek fd AbsoluteSeek 0
+               size <- return . fromIntegral . fileSize =<< getFdStatus fd
+               (revStr, gotSize) <- fdRead fd size
+               when (size /= gotSize) $ fail ("read " ++ show gotSize ++
+                                              " bytes but expected " ++ show size ++ " bytes")
+               
+               let rev = case revStr of
+                           "" -> 0
+                           _  -> read revStr
+
+               rev' <- f rev
+
+               let revStr' = show rev' ++ "\n"
+                   size'   = fromIntegral $ length revStr'
+
+               fdSeek fd AbsoluteSeek 0
+               setFdSize fd 0
+               wroteSize <- fdWrite fd revStr'
+               when (size' /= wroteSize) $ fail ("wrote " ++ show wroteSize ++
+                                                 " bytes but expected " ++ show size' ++ " bytes")
\ No newline at end of file