implemented global lock

[Rakka.git] / Rakka / Resource / PageEntity.hs

diff --git a/Rakka/Resource/PageEntity.hs b/Rakka/Resource/PageEntity.hs
index d84ddc7b6af0024b9792aafff1d1c835fb29ead6..dbef4d5b1a16615a26cd4271be67afe4084a270c 100644 (file)
--- a/Rakka/Resource/PageEntity.hs
+++ b/Rakka/Resource/PageEntity.hs
@@ -18,8 +18,10 @@ import           Rakka.Page
 import           Rakka.Resource
 import           Rakka.Storage
 import           Rakka.SystemConfig
+import           Rakka.Utils
 import           Rakka.Wiki.Engine
 import           System.FilePath
+import           Text.XML.HXT.Arrow.Namespace
 import           Text.XML.HXT.Arrow.WriteDocument
 import           Text.XML.HXT.Arrow.XmlArrow
 import           Text.XML.HXT.Arrow.XmlIOStateArrow
@@ -37,11 +39,11 @@ fallbackPageEntity env path
         = return $ Just $ ResourceDef {
             resUsesNativeThread = False
           , resIsGreedy         = True
-          , resGet              = Just $ handleGet env (toPageName path)
+          , resGet              = Just $ handleGet    env (toPageName path)
           , resHead             = Nothing
           , resPost             = Nothing
-          , resPut              = Just $ handlePut env (toPageName path)
-          , resDelete           = Nothing
+          , resPut              = Just $ handlePut    env (toPageName path)
+          , resDelete           = Just $ handleDelete env (toPageName path)
           }
     where
       toPageName :: [String] -> PageName
@@ -53,14 +55,12 @@ handleGet env name
     = runIdempotentA $ proc ()
     -> do pageM <- getPageA (envStorage env) -< (name, Nothing)
           case pageM of
-            Nothing
-                -> handlePageNotFound env -< name
+            Nothing   -> handlePageNotFound env -< name
+            Just page -> if isEntity page then
+                             handleGetEntity env -< page
+                         else
+                             handleRedirect env -< page
 
-            Just redir@(Redirection _ _ _ _ _)
-                -> handleRedirect env -< redir
-
-            Just entity@(Entity _ _ _ _ _ _ _ _ _ _ _ _ _ _ _)
-                -> handleGetEntity env -< entity
 
 {-
   HTTP/1.1 302 Found
@@ -117,8 +117,10 @@ entityToXHTML env
     -> do SiteName   siteName   <- getSysConfA (envSysConf env) -< ()
           BaseURI    baseURI    <- getSysConfA (envSysConf env) -< ()
           StyleSheet styleSheet <- getSysConfA (envSysConf env) -< ()
+          GlobalLock isGLocked  <- getSysConfA (envSysConf env) -< ()
 
-          name <- (getXPathTreesInDoc "/page/@name/text()" >>> getText) -< page
+          name     <- (getXPathTreesInDoc "/page/@name/text()" >>> getText) -< page
+          isLocked <- (getXPathTreesInDoc "/page/@isLocked/text()" >>> getText >>> parseYesOrNo) -< page
 
           let cssHref   = [uriToString id (mkObjectURI baseURI styleSheet) ""]
               scriptSrc = [uriToString id (baseURI { uriPath = uriPath baseURI </> "js" }) ""]
@@ -155,6 +157,12 @@ entityToXHTML env
                            += sattr "type" "text/javascript"
                            += attr "src" (arr id >>> mkText)
                          )
+                      += ( eelem "script"
+                           += sattr "type" "text/javascript"
+                           += txt ("Rakka.baseURI=\"" ++ uriToString id baseURI "" ++ "\";")
+                           += txt ("Rakka.isLocked=" ++ trueOrFalse isLocked ++ ";")
+                           += txt ("Rakka.isGlobalLocked=" ++ trueOrFalse isGLocked ++ ";")
+                         )
                     )
                  += ( eelem "body"
                       += ( eelem "div"
@@ -189,6 +197,8 @@ entityToXHTML env
                               )
                          )
                     )
+                 >>>
+                 uniqueNamespacesFromDeclAndQNames
                ) ) -<< page
 
 
@@ -224,6 +234,7 @@ notFoundToXHTML env
     -> do SiteName   siteName   <- getSysConfA (envSysConf env) -< ()
           BaseURI    baseURI    <- getSysConfA (envSysConf env) -< ()
           StyleSheet styleSheet <- getSysConfA (envSysConf env) -< ()
+          GlobalLock isGLocked  <- getSysConfA (envSysConf env) -< ()
 
           name <- (getXPathTreesInDoc "/pageNotFound/@name/text()" >>> getText) -< pageNotFound
 
@@ -256,6 +267,11 @@ notFoundToXHTML env
                            += sattr "type" "text/javascript"
                            += attr "src" (arr id >>> mkText)
                          )
+                      += ( eelem "script"
+                           += sattr "type" "text/javascript"
+                           += txt ("Rakka.baseURI = \"" ++ uriToString id baseURI "" ++ "\";")
+                           += txt ("Rakka.isGlobalLocked=" ++ trueOrFalse isGLocked ++ ";")
+                         )
                     )
                  += ( eelem "body"
                       += ( eelem "div"
@@ -290,12 +306,22 @@ notFoundToXHTML env
                               )
                          )
                     )
+                 >>>
+                 uniqueNamespacesFromDeclAndQNames
                ) ) -<< pageNotFound
 
 
 handlePut :: Environment -> PageName -> Resource ()
 handlePut env name
-    = runXmlA env "rakka-page-1.0.rng" $ proc tree
-    -> do page   <- parseXmlizedPage -< (name, tree)
-          status <- putPageA (envStorage env) -< page
-          returnA  -< setStatus status
+    = do userID <- getUserID env
+         runXmlA env "rakka-page-1.0.rng" $ proc tree
+             -> do page   <- parseXmlizedPage -< (name, tree)
+                   status <- putPageA (envStorage env) -< (userID, page)
+                   returnA  -< setStatus status
+
+
+handleDelete :: Environment -> PageName -> Resource ()
+handleDelete env name
+    = do userID <- getUserID env
+         status <- deletePage (envStorage env) userID name
+         setStatus status