From db6b24614fbfadf820a97af19a3cbc7299cf7ba4 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 18 Jun 2008 03:26:50 -0500
Subject: [PATCH] Improving user-admin tool

---
 .../deactivate-user/deactivate-user.factor    | 22 +++++++++++++++++++
 .../features/edit-profile/edit-profile.xml    |  3 +++
 .../features/registration/registration.factor |  5 +++--
 extra/html/templates/chloe/chloe.factor       |  5 ++---
 extra/webapps/user-admin/user-admin.factor    |  2 +-
 .../concatenative/concatenative.factor        |  2 ++
 6 files changed, 33 insertions(+), 6 deletions(-)
 create mode 100644 extra/furnace/auth/features/deactivate-user/deactivate-user.factor

diff --git a/extra/furnace/auth/features/deactivate-user/deactivate-user.factor b/extra/furnace/auth/features/deactivate-user/deactivate-user.factor
new file mode 100644
index 0000000000..49fa00353b
--- /dev/null
+++ b/extra/furnace/auth/features/deactivate-user/deactivate-user.factor
@@ -0,0 +1,22 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel assocs namespaces accessors db db.tuples urls
+http.server.dispatchers
+furnace.asides furnace.actions furnace.auth furnace.auth.providers ;
+IN: furnace.auth.features.deactivate-user
+
+: <deactivate-user-action> ( -- action )
+    <action>
+        [
+            logged-in-user get
+                1 >>deleted
+                t >>changed?
+            drop
+            URL" $realm" end-aside
+        ] >>submit ;
+    
+: allow-deactivation ( realm -- realm )
+    <deactivate-user-action> "deactivate-user" add-responder ;
+
+: allow-deactivation? ( -- ? )
+    realm get responders>> "deactivate-user" swap key? ;
diff --git a/extra/furnace/auth/features/edit-profile/edit-profile.xml b/extra/furnace/auth/features/edit-profile/edit-profile.xml
index 011cc2bdf8..a9d7994e97 100644
--- a/extra/furnace/auth/features/edit-profile/edit-profile.xml
+++ b/extra/furnace/auth/features/edit-profile/edit-profile.xml
@@ -67,4 +67,7 @@
 
 	</t:form>
 	
+	<t:if t:code="furnace.auth.features.deactivate-user:allow-deactivation?">
+		<t:button t:action="$realm/deactivate-user">Delete User</t:button>
+	</t:if>
 </t:chloe>
diff --git a/extra/furnace/auth/features/registration/registration.factor b/extra/furnace/auth/features/registration/registration.factor
index 5c1851fb64..20a48d07d2 100644
--- a/extra/furnace/auth/features/registration/registration.factor
+++ b/extra/furnace/auth/features/registration/registration.factor
@@ -35,10 +35,11 @@ IN: furnace.auth.features.registration
             realm get init-user-profile
 
             URL" $realm" <redirect>
-        ] >>submit ;
+        ] >>submit
+    <auth-boilerplate> ;
 
 : allow-registration ( login -- login )
-    <register-action> <auth-boilerplate> "register" add-responder ;
+    <register-action> "register" add-responder ;
 
 : allow-registration? ( -- ? )
     realm get responders>> "register" swap key? ;
diff --git a/extra/html/templates/chloe/chloe.factor b/extra/html/templates/chloe/chloe.factor
index 32fe954178..103020ee0f 100644
--- a/extra/html/templates/chloe/chloe.factor
+++ b/extra/html/templates/chloe/chloe.factor
@@ -87,11 +87,10 @@ CHLOE: comment drop ;
 CHLOE: call-next-template drop call-next-template ;
 
 : attr>word ( value -- word/f )
-    dup ":" split1 swap lookup
-    [ ] [ "No such word: " swap append throw ] ?if ;
+    ":" split1 swap lookup ;
 
 : if-satisfied? ( tag -- ? )
-    [ "code" optional-attr [ attr>word execute ] [ t ] if* ]
+    [ "code" optional-attr [ attr>word dup [ execute ] when ] [ t ] if* ]
     [ "value" optional-attr [ value ] [ t ] if* ]
     bi and ;
 
diff --git a/extra/webapps/user-admin/user-admin.factor b/extra/webapps/user-admin/user-admin.factor
index f445b6f471..2137abbc2d 100644
--- a/extra/webapps/user-admin/user-admin.factor
+++ b/extra/webapps/user-admin/user-admin.factor
@@ -139,7 +139,7 @@ TUPLE: user-admin < dispatcher ;
     <action>
         [
             validate-username
-            "username" value <user> select-tuple 1 >>deleted update-tuple
+            "username" value <user> delete-tuples
             URL" $user-admin" <redirect>
         ] >>submit ;
 
diff --git a/extra/websites/concatenative/concatenative.factor b/extra/websites/concatenative/concatenative.factor
index 1e79b043e2..a4f826d7f6 100644
--- a/extra/websites/concatenative/concatenative.factor
+++ b/extra/websites/concatenative/concatenative.factor
@@ -13,6 +13,7 @@ furnace.auth.providers.db
 furnace.auth.features.edit-profile
 furnace.auth.features.recover-password
 furnace.auth.features.registration
+furnace.auth.features.deactivate-user
 furnace.boilerplate
 furnace.redirection
 webapps.blogs
@@ -57,6 +58,7 @@ TUPLE: factor-website < dispatcher ;
         allow-registration
         allow-password-recovery
         allow-edit-profile
+        allow-deactivation
     <boilerplate>
         { factor-website "page" } >>template
     test-db <alloy> ;