Improving user-admin tool
parent
9ce8116fad
commit
db6b24614f
|
@ -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? ;
|
|
@ -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>
|
||||
|
|
|
@ -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? ;
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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> ;
|
||||
|
|
Loading…
Reference in New Issue