+++ /dev/null
-Doug Coleman
+++ /dev/null
-! Copyright (C) 2009 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax http.server.filters kernel
-multiline furnace.actions ;
-IN: furnace.chloe-tags.recaptcha
-
-HELP: <recaptcha>
-{ $values
- { "responder" "a responder" }
- { "obj" object }
-}
-{ $description "A " { $link filter-responder } " wrapping another responder. Set the domain, public, and private keys using the key you get by registering with Recaptcha." } ;
-
-HELP: recaptcha-error
-{ $var-description "Set to the error string returned by the Recaptcha server." } ;
-
-HELP: recaptcha-valid?
-{ $var-description "Set to " { $link t } " if the user solved the last Recaptcha correctly." } ;
-
-HELP: validate-recaptcha
-{ $description "Validates a Recaptcha using the Recaptcha web service API." } ;
-
-ARTICLE: "recaptcha-example" "Recaptcha example"
-"There are several steps to using the Recaptcha library."
-{ $list
- { "Wrap the responder in a " { $link <recaptcha> } }
- { "Add a handler calling " { $link validate-recaptcha } " in the " { $slot "submit" } " of the " { $link page-action } }
- { "Put the chloe tag " { $snippet "<recaptcha/>" } " in the template for your " { $link action } }
-}
-"An example follows:"
-{ $code
-HEREDOC: RECAPTCHA-TUTORIAL
-TUPLE: recaptcha-app < dispatcher recaptcha ;
-
-: <recaptcha-challenge> ( -- obj )
- <action>
- [
- validate-recaptcha
- recaptcha-valid? get "?good" "?bad" ? <redirect>
- ] >>submit
- [
- <response>
-{" <?xml version='1.0' ?>
-<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
-<html><body><t:recaptcha/></body></html>
-</t:chloe>"} >>body
- ] >>display ;
-
-: <recaptcha-app> ( -- obj )
- \ recaptcha-app new-dispatcher
- <recaptcha-challenge> "" add-responder
- <recaptcha>
- "concatenative.org" >>domain
- "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" >>public-key
- "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" >>private-key ;
-
-<recaptcha-app> main-responder set-global
-RECAPTCHA-TUTORIAL
-}
-
-;
-
-ARTICLE: "furnace.chloe-tags.recaptcha" "Recaptcha chloe tag"
-"The " { $vocab-link "furnace.chloe-tags.recaptcha" } " vocabulary implements support for the Recaptcha. Recaptcha is a web service that provides the user with a captcha, a test that is easy to solve by visual inspection, but hard to solve by writing a computer program. Use a captcha to protect forms from abusive users." $nl
-
-"The recaptcha responder is a " { $link filter-responder } " that wraps another responder. Set the " { $slot "domain" } ", " { $slot "public-key" } ", and " { $slot "private-key" } " slots of this responder to your Recaptcha account information." $nl
-
-"Wrapping a responder with Recaptcha:"
-{ $subsection <recaptcha> }
-"Validating recaptcha:"
-{ $subsection validate-recaptcha }
-"Symbols set after validation:"
-{ $subsection recaptcha-valid? }
-{ $subsection recaptcha-error }
-{ $subsection "recaptcha-example" } ;
-
-ABOUT: "furnace.chloe-tags.recaptcha"
+++ /dev/null
-! Copyright (C) 2009 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors furnace.actions furnace.redirection html.forms
-html.templates.chloe.compiler html.templates.chloe.syntax
-http.client http.server http.server.filters io.sockets kernel
-locals namespaces sequences splitting urls validators
-xml.syntax ;
-IN: furnace.chloe-tags.recaptcha
-
-TUPLE: recaptcha < filter-responder domain public-key private-key ;
-
-SYMBOLS: recaptcha-valid? recaptcha-error ;
-
-: <recaptcha> ( responder -- obj )
- recaptcha new
- swap >>responder ;
-
-M: recaptcha call-responder*
- dup \ recaptcha set
- responder>> call-responder ;
-
-<PRIVATE
-
-: (render-recaptcha) ( private-key -- xml )
- dup
-[XML <script type="text/javascript"
- src=<->>
-</script>
-
-<noscript>
- <iframe src=<->
- height="300" width="500" frameborder="0"></iframe><br/>
- <textarea name="recaptcha_challenge_field" rows="3" cols="40">
- </textarea>
- <input type="hidden" name="recaptcha_response_field"
- value="manual_challenge"/>
-</noscript>
-XML] ;
-
-: recaptcha-url ( secure? -- ? )
- [ "https://api.recaptcha.net/challenge" >url ]
- [ "http://api.recaptcha.net/challenge" >url ] if ;
-
-: render-recaptcha ( -- xml )
- secure-connection? recaptcha-url
- recaptcha get public-key>> "k" set-query-param (render-recaptcha) ;
-
-: parse-recaptcha-response ( string -- valid? error )
- "\n" split first2 [ "true" = ] dip ;
-
-:: (validate-recaptcha) ( challenge response recaptcha -- valid? error )
- recaptcha private-key>> :> private-key
- remote-address get host>> :> remote-ip
- H{
- { "challenge" challenge }
- { "response" response }
- { "privatekey" private-key }
- { "remoteip" remote-ip }
- } URL" http://api-verify.recaptcha.net/verify"
- <post-request> http-request nip parse-recaptcha-response ;
-
-CHLOE: recaptcha
- drop [ render-recaptcha ] [xml-code] ;
-
-PRIVATE>
-
-: validate-recaptcha ( -- )
- {
- { "recaptcha_challenge_field" [ v-required ] }
- { "recaptcha_response_field" [ v-required ] }
- } validate-params
- "recaptcha_challenge_field" value
- "recaptcha_response_field" value
- \ recaptcha get (validate-recaptcha)
- [ recaptcha-valid? set ] [ recaptcha-error set ] bi* ;
+++ /dev/null
-<?xml version='1.0' ?>
-<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
-<html>
- <body><t:recaptcha/>
- </body>
-</html>
-</t:chloe>
+++ /dev/null
-Recaptcha library
--- /dev/null
+Doug Coleman
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors db.sqlite furnace.actions furnace.alloy
+furnace.conversations furnace.recaptcha furnace.redirection
+html.templates.chloe.compiler http.server
+http.server.dispatchers http.server.responses io.streams.string
+kernel urls xml.syntax ;
+IN: furnace.recaptcha.example
+
+TUPLE: recaptcha-app < dispatcher recaptcha ;
+
+: recaptcha-db ( -- obj ) "recaptcha-example" <sqlite-db> ;
+
+: <recaptcha-challenge> ( -- obj )
+ <page-action>
+ [
+ begin-conversation
+ validate-recaptcha
+ recaptcha-valid? cget
+ "?good" "?bad" ? >url <continue-conversation>
+ ] >>submit
+ { recaptcha-app "example" } >>template ;
+
+: <recaptcha-app> ( -- obj )
+ \ recaptcha-app new-dispatcher
+ <recaptcha-challenge> "" add-responder
+ <recaptcha>
+ "concatenative.org" >>domain
+ "6LeJWQgAAAAAAFlYV7SuBClE9uSpGtV_ZS-qVON7" >>public-key
+ "6LeJWQgAAAAAALh-XJgSSQ6xKygRgJ8-029Ip2Xv" >>private-key
+ recaptcha-db <alloy> ;
--- /dev/null
+<?xml version='1.0' ?>
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+<html><body><form submit="" method="post"><t:recaptcha/></form></body></html>
+</t:chloe>
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax http.server.filters kernel
+multiline furnace.actions furnace.alloy furnace.conversations ;
+IN: furnace.recaptcha
+
+HELP: <recaptcha>
+{ $values
+ { "responder" "a responder" }
+ { "obj" object }
+}
+{ $description "A " { $link filter-responder } " wrapping another responder. Set the domain, public, and private keys using the key you get by registering with Recaptcha." } ;
+
+HELP: recaptcha-error
+{ $var-description "Set to the error string returned by the Recaptcha server." } ;
+
+HELP: recaptcha-valid?
+{ $var-description "Set to " { $link t } " if the user solved the last Recaptcha correctly." } ;
+
+HELP: validate-recaptcha
+{ $description "Validates a Recaptcha using the Recaptcha web service API." } ;
+
+ARTICLE: "recaptcha-example" "Recaptcha example"
+"There are several steps to using the Recaptcha library."
+{ $list
+ { "Wrap the responder in a " { $link <recaptcha> } }
+ { "Wrap the responder in a " { $link <conversations> } " if it is not already" }
+ { "Ensure that there is a database connected, with the " { $link <alloy> } " word" }
+ { "Start a conversation to move values between requests" }
+ { "Add a handler calling " { $link validate-recaptcha } " in the " { $slot "submit" } " of the " { $link page-action } }
+ { "Pass the conversation from your submit action using " { $link <continue-conversation> } }
+ { "Put the chloe tag " { $snippet "<recaptcha/>" } " inside a form tag in the template for your " { $link page-action } }
+}
+$nl
+"Run this example vocabulary:"
+{ $code
+ "USE: furnace.recaptcha.example"
+ "<recaptcha-app> main-responder set-global"
+} ;
+
+ARTICLE: "furnace.recaptcha" "Recaptcha"
+"The " { $vocab-link "furnace.chloe-tags.recaptcha" } " vocabulary implements support for the Recaptcha. Recaptcha is a web service that provides the user with a captcha, a test that is easy to solve by visual inspection, but hard to solve by writing a computer program. Use a captcha to protect forms from abusive users." $nl
+
+"The recaptcha responder is a " { $link filter-responder } " that wraps another responder. Set the " { $slot "domain" } ", " { $slot "public-key" } ", and " { $slot "private-key" } " slots of this responder to your Recaptcha account information." $nl
+
+"Wrapping a responder with Recaptcha:"
+{ $subsection <recaptcha> }
+"Validating recaptcha:"
+{ $subsection validate-recaptcha }
+"Symbols set after validation:"
+{ $subsection recaptcha-valid? }
+{ $subsection recaptcha-error }
+{ $subsection "recaptcha-example" } ;
+
+ABOUT: "furnace.recaptcha"
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors furnace.actions furnace.redirection html.forms
+html.templates.chloe.compiler html.templates.chloe.syntax
+http.client http.server http.server.filters io.sockets kernel
+locals namespaces sequences splitting urls validators
+xml.syntax furnace.conversations ;
+IN: furnace.recaptcha
+
+TUPLE: recaptcha < filter-responder domain public-key private-key ;
+
+SYMBOLS: recaptcha-valid? recaptcha-error ;
+
+: <recaptcha> ( responder -- obj )
+ recaptcha new
+ swap >>responder ;
+
+M: recaptcha call-responder*
+ dup \ recaptcha set
+ responder>> call-responder ;
+
+<PRIVATE
+
+: (render-recaptcha) ( private-key -- xml )
+ dup
+[XML <script type="text/javascript"
+ src=<->>
+</script>
+
+<noscript>
+ <iframe src=<->
+ height="300" width="500" frameborder="0"></iframe><br/>
+ <textarea name="recaptcha_challenge_field" rows="3" cols="40">
+ </textarea>
+ <input type="hidden" name="recaptcha_response_field"
+ value="manual_challenge"/>
+</noscript>
+XML] ;
+
+: recaptcha-url ( secure? -- ? )
+ [ "https://api.recaptcha.net/challenge" ]
+ [ "http://api.recaptcha.net/challenge" ] if
+ recaptcha-error cget [ "?error=" glue ] when* >url ;
+
+: render-recaptcha ( -- xml )
+ secure-connection? recaptcha-url
+ recaptcha get public-key>> "k" set-query-param (render-recaptcha) ;
+
+: parse-recaptcha-response ( string -- valid? error )
+ "\n" split first2 [ "true" = ] dip ;
+
+:: (validate-recaptcha) ( challenge response recaptcha -- valid? error )
+ recaptcha private-key>> :> private-key
+ remote-address get host>> :> remote-ip
+ H{
+ { "challenge" challenge }
+ { "response" response }
+ { "privatekey" private-key }
+ { "remoteip" remote-ip }
+ } URL" http://api-verify.recaptcha.net/verify"
+ <post-request> http-request nip parse-recaptcha-response ;
+
+CHLOE: recaptcha
+ drop [ render-recaptcha ] [xml-code] ;
+
+PRIVATE>
+
+: validate-recaptcha ( -- )
+ {
+ { "recaptcha_challenge_field" [ v-required ] }
+ { "recaptcha_response_field" [ v-required ] }
+ } validate-params
+ "recaptcha_challenge_field" value
+ "recaptcha_response_field" value
+ \ recaptcha get (validate-recaptcha)
+ [ recaptcha-valid? cset ] [ recaptcha-error cset ] bi* ;
--- /dev/null
+<?xml version='1.0' ?>
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+<html>
+ <body><t:recaptcha/>
+ </body>
+</html>
+</t:chloe>
--- /dev/null
+Recaptcha library
{ $description "Compiles code which pushes an attribute value previously extracted by " { $link required-attr } " or " { $link optional-attr } " on the stack. If the attribute value begins with " { $snippet "@" } ", compiles into code which pushes the a form value." } ;
HELP: CHLOE:
-{ $syntax "name definition... ;" }
+{ $syntax "CHLOE: name definition... ;" }
{ $values { "name" "the tag name" } { "definition" { $quotation "( tag -- )" } } }
{ $description "Defines compilation semantics for the Chloe tag named " { $snippet "tag" } ". The definition body receives a " { $link tag } " on the stack." } ;
"bootstrap.layouts" require
[
- "vocab:bootstrap/stage2.factor"
+ "resource:basis/bootstrap/stage2.factor"
dup exists? [
run-file
] [
! Factor port of
! http://shootout.alioth.debian.org/gp4/benchmark.php?test=spectralnorm&lang=all
USING: specialized-arrays kernel math math.functions
-math.vectors sequences sequences.private prettyprint words hints
-locals ;
+math.vectors sequences prettyprint words hints locals ;
SPECIALIZED-ARRAY: double
IN: benchmark.spectral-norm
+ 1 + recip ; inline
: (eval-A-times-u) ( u i j -- x )
- tuck [ swap nth-unsafe ] [ eval-A ] 2bi* * ; inline
+ [ swap nth ] [ eval-A ] bi-curry bi* * ; inline
: eval-A-times-u ( n u -- seq )
[ (eval-A-times-u) ] inner-loop ; inline
: (eval-At-times-u) ( u i j -- x )
- tuck [ swap nth-unsafe ] [ swap eval-A ] 2bi* * ; inline
+ [ swap nth ] [ swap eval-A ] bi-curry bi* * ; inline
: eval-At-times-u ( u n -- seq )
[ (eval-At-times-u) ] inner-loop ; inline
! Test join
[ { "JOIN #factortest" } [
- "#factortest" %join %pop-output-line
+ "#factortest" %join %pop-output-line
+ ] unit-test
+] spawning-irc
+
+[ { "PART #factortest" } [
+ "#factortest" %join %pop-output-line drop
+ "#factortest" chat> remove-chat %pop-output-line
] unit-test
] spawning-irc
M: irc-server-chat remove-chat drop +server-chat+ unregister-chat ;
M: irc-channel-chat remove-chat
- [ part new annotate-message irc-send ]
+ [ name>> "PART " prepend string>irc-message irc-send ]
[ name>> unregister-chat ] bi ;
: (speak) ( message irc-chat -- ) swap annotate-message irc-send ;
projects / factor.git / commitdiff