Merge branch 'master' of git://factorcode.org/git/factor

extra/asn1/tags.txt

@@ -0,0 +1 @@
+enterprise

extra/db/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

extra/db/summary.txt

@@ -0,0 +1 @@
+Relational database abstraction layer

extra/db/tags.txt

@@ -0,0 +1 @@
+enterprise

extra/furnace/tags.txt

@@ -0,0 +1 @@
+enterprise

extra/logging/analysis/analysis-docs.factor

@@ -0,0 +1,31 @@
+USING: help.markup help.syntax assocs logging math ;
+IN: logging.analysis
+
+HELP: analyze-entries
+{ $values { "entries" "a sequence of log entries" } { "word-names" "a sequence of strings" } { "errors" "a sequence of log entries" } { "word-histogram" assoc } { "message-histogram" assoc } }
+{ $description "Analyzes log entries:"
+    { $list
+        { "Errors (entries with level " { $link ERROR } " or " { $link CRITICAL } ") are collected into the " { $snippet "errors" } " sequence." }
+        { "All logging words are tallied into " { $snippet "word-histogram" } " - for example, this can tell you about HTTP server hit counts." }
+        { "All words listed in " { $snippet "word-names" } " have their messages tallied into " { $snippet "message-histogram" } " - for example, this can tell you about popular URLs on an HTTP server." }
+    }
+} ;
+
+HELP: analysis.
+{ $values { "errors" "a sequence of log entries" } { "word-histogram" assoc } { "message-histogram" assoc } }
+{ $description "Prints a logging report output by " { $link analyze-entries } ". Formatted output words are used, so the report looks nice in the UI or if sent to an HTML stream." } ;
+
+HELP: analyze-log
+{ $values { "service" "a log service name" } { "n" integer } { "word-names" "a sequence of strings" } }
+{ $description "Analyzes a log file and prints a formatted report. The " { $snippet "word-names" } " parameter is documented in " { $link analyze-entries } "." } ;
+
+ARTICLE: "logging.analysis" "Log analysis"
+"The " { $vocab-link "logging.analysis" } " vocabulary builds on the " { $vocab-link "logging.parser" } " vocabulary. It parses log files and produces formatted summary reports. It is used by the " { $vocab-link "logger.insomniac" } " vocabulary to e-mail daily reports."
+$nl
+"Print log file summary:"
+{ $subsection analyze-log }
+"Factors:"
+{ $subsection analyze-entries }
+{ $subsection analysis. } ;
+
+ABOUT: "logging.analysis"

extra/logging/analysis/analysis.factor

@@ -11,6 +11,7 @@ SYMBOL: message-histogram
 
 : analyze-entry ( entry -- )
     dup second ERROR eq? [ dup errors get push ] when
+    dup second CRITICAL eq? [ dup errors get push ] when
     1 over third word-histogram get at+
     dup third word-names get member? [
         1 over 1 tail message-histogram get at+
@@ -65,5 +66,5 @@ SYMBOL: message-histogram
     "==== ERRORS:" print nl
     errors. ;
 
-: log-analysis ( lines word-names -- )
+: analyze-log ( lines word-names -- )
     >r parse-log r> analyze-entries analysis. ;

extra/logging/analysis/tags.txt

@@ -0,0 +1 @@
+enterprise

extra/logging/insomniac/insomniac-docs.factor

@@ -0,0 +1,44 @@
+USING: help.markup help.syntax assocs strings logging
+logging.analysis smtp ;
+IN: logging.insomniac
+
+HELP: insomniac-smtp-host
+{ $var-description "An SMTP server to use for e-mailing log reports. If not set, the value of " { $link smtp-host } " is used." } ;
+
+HELP: insomniac-smtp-port
+{ $var-description "An SMTP server port to use for e-mailing log reports. If not set, the value of " { $link smtp-port } " is used." } ;
+
+HELP: insomniac-sender
+{ $var-description "The originating e-mail address for mailing log reports. Must be set before " { $vocab-link "logging.insomniac" } " is used." } ;
+
+HELP: insomniac-recipients
+{ $var-description "A sequence of e-mail addresses to mail log reports to. Must be set before " { $vocab-link "logging.insomniac" } " is used." } ;
+
+HELP: ?analyze-log
+{ $values { "service" "a log service name" } { "word-names" "a sequence of strings" } { "string" string } }
+{ $description "Analyzes the most recent log and outputs the string analysis, or outputs " { $link f } " if it doesn't exist." }
+{ $see-also analyze-log } ;
+
+HELP: email-log-report
+{ $values { "service" "a log service name" } { "word-names" "a sequence of strings" } }
+{ $description "E-mails a log report for the given log service. The " { $link insomniac-smtp-host } ", " { $link insomniac-sender } " and " { $link insomniac-recipients } " parameters must be set up first. The " { $snippet "word-names" } " parameter is documented in " { $link analyze-entries } "." } ;
+
+HELP: schedule-insomniac
+{ $values { "alist" "a sequence of pairs of shape " { $snippet "{ service word-names }" } } }
+{ $description "Starts a thread which e-mails log reports and rotates logs daily." } ;
+
+ARTICLE: "logging.insomniac" "Automating log analysis and rotation"
+"The " { $vocab-link "logging.insomniac" } " vocabulary builds on the " { $vocab-link "logging.analysis" } " vocabulary. It provides support for e-mailing log reports and rotating logs on a daily basis. E-mails are sent using the " { $vocab-link "smtp" } " vocabulary."
+$nl
+"Required configuration parameters:"
+{ $subsection insomniac-sender }
+{ $subsection insomniac-recipients }
+"Optional configuration parameters:"
+{ $subsection insomniac-smtp-host }
+{ $subsection insomniac-smtp-port }
+"E-mailing a one-off report:"
+{ $subsection email-log-report }
+"E-mailing reports and rotating logs on a daily basis:"
+{ $subsection schedule-insomniac } ;
+
+ABOUT: "logging.insomniac"

extra/logging/insomniac/insomniac.factor

@@ -1,19 +1,17 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: logging.analysis logging.server logging smtp io.sockets
-kernel io.files io.streams.string namespaces raptor.cron ;
+kernel io.files io.streams.string namespaces raptor.cron assocs ;
 IN: logging.insomniac
 
-SYMBOL: insomniac-config
-
 SYMBOL: insomniac-smtp-host
 SYMBOL: insomniac-smtp-port
 SYMBOL: insomniac-sender
 SYMBOL: insomniac-recipients
 
-: ?log-analysis ( service word-names -- string/f )
+: ?analyze-log ( service word-names -- string/f )
     >r log-path 1 log# dup exists? [
-        file-lines r> [ log-analysis ] string-out
+        file-lines r> [ analyze-log ] string-out
     ] [
         r> 2drop f
     ] if ;
@@ -31,7 +29,7 @@ SYMBOL: insomniac-recipients
 : (email-log-report) ( service word-names -- )
     [
         over >r
-        ?log-analysis dup [
+        ?analyze-log dup [
             r> email-subject
             insomniac-recipients get
             insomniac-sender get
@@ -39,11 +37,12 @@ SYMBOL: insomniac-recipients
         ] [ r> 2drop ] if
     ] with-insomniac-smtp ;
 
+\ (email-log-report) NOTICE add-error-logging
+
 : email-log-report ( service word-names -- )
-    (email-log-report) ;
+    "logging.insomniac" [ (email-log-report) ] with-logging ;
 
-\ email-log-report NOTICE add-error-logging
-
-: schedule-insomniac ( service word-names -- )
-    { 25 } { 6 } f f f <when> -rot
-    [ email-log-report ] 2curry schedule ;
+: schedule-insomniac ( alist -- )
+    { 25 } { 6 } f f f <when> -rot [
+        [ email-log-report ] assoc-each rotate-logs
+    ] 2curry schedule ;

extra/logging/insomniac/tags.txt

@@ -0,0 +1 @@
+enterprise

extra/logging/logging-docs.factor

@@ -0,0 +1,130 @@
+IN: logging
+USING: help.markup help.syntax assocs math calendar
+logging.server strings words quotations ;
+
+HELP: DEBUG
+{ $description "Log level for debug messages." } ;
+
+HELP: NOTICE
+{ $description "Log level for ordinary messages." } ;
+
+HELP: ERROR
+{ $description "Log level for error messages." } ;
+
+HELP: CRITICAL
+{ $description "Log level for critical errors which require immediate attention." } ;
+
+ARTICLE: "logging.levels" "Log levels"
+"Several log levels are supported, from lowest to highest:"
+{ $subsection DEBUG }
+{ $subsection NOTICE }
+{ $subsection ERROR }
+{ $subsection CRITICAL } ;
+
+ARTICLE: "logging.files" "Log files"
+"Each application that wishes to use logging must choose a log service name; the following combinator should wrap the top level of the application:"
+{ $subsection with-logging }
+"Log messages are written to " { $snippet "log-root/service/1.log" } ", where"
+{ $list
+    { { $snippet "log-root" } " is the Factor source directory by default, but can be overriden with the " { $link log-root } " variable" }
+    { { $snippet "service" } " is the service name" }
+}
+"You can get the log path for a service:"
+{ $subsection log-path }
+{ $subsection log# }
+"New log entries are always sent to " { $snippet "1.log" } " but " { $link "logging.rotation" } " moves " { $snippet "1.log" } " to " { $snippet "2.log" } ", " { $snippet "2.log" } " to " { $snippet "3.log" } ", and so on." ;
+
+HELP: log-message
+{ $values { "msg" string } { "word" word } { "level" "a log level" } }
+{ $description "Sends a message to the current log. Does nothing if not executing in a dynamic scope established by " { $link with-logging } "." } ;
+
+HELP: add-logging
+{ $values { "word" word } }
+{ $description "Causes the word to log a message every time it is called." } ;
+
+HELP: add-input-logging
+{ $values { "word" word } }
+{ $description "Causes the word to log its input values every time it is called. The word must have a stack effect declaration." } ;
+
+HELP: add-output-logging
+{ $values { "word" word } }
+{ $description "Causes the word to log its output values every time it is called. The word must have a stack effect declaration." } ;
+
+HELP: add-error-logging
+{ $values { "word" word } }
+{ $description "Causes the word to log its input values and any errors it throws."
+$nl
+"If the word is not executed in a dynamic scope established by " { $link with-logging } ", its behavior is unchanged, and any errors it throws are passed to the caller."
+$nl
+"If called from a logging context, its input values are logged, and if it throws an error, the error is logged and the word returns normally. Any inputs are popped from the stack and " { $link f } " is pushed in place of each output." } ;
+
+HELP: log-error
+{ $values { "error" "an error" } { "word" word } }
+{ $description "Logs an error." } ;
+
+HELP: log-critical
+{ $values { "critical" "an critical" } { "word" word } }
+{ $description "Logs a critical error." } ;
+
+HELP: LOG:
+{ $syntax "LOG: name level" }
+{ $values { "name" "a new word name" } { "level" "a log level" } }
+{ $description "Creates a word with stack effect " { $snippet "( object -- )" } " which logs its input and does nothing else." } ;
+
+ARTICLE: "logging.messages" "Logging messages"
+"Logging messages explicitly:"
+{ $subsection log-message }
+{ $subsection log-error }
+{ $subsection log-critical }
+"A utility for defining words which just log and do nothing else:"
+{ $subsection POSTPONE: LOG: }
+"Annotating words to log; this uses the " { $link "tools.annotations" } " feature:"
+{ $subsection add-input-logging }
+{ $subsection add-output-logging }
+{ $subsection add-error-logging } ;
+
+HELP: rotate-logs
+{ $description "Rotates all logs. The highest numbered log file in each log directory is deleted, and each file is renamed so that its number increments by one. Subsequent logging calls will create a new #1 log file. This keeps log files from getting too large and makes them easier to search." } ;
+
+HELP: close-logs
+{ $description "Closes all open log streams. Subsequent logging will re-open the streams. This should be used before moving or deleting log files." } ;
+
+HELP: with-logging
+{ $values { "service" "a log service name" } { "quot" quotation } }
+{ $description "Calls the quotation a new dynamic scope where all logging calls are sent to the log file for " { $snippet "service" } "." } ;
+
+ARTICLE: "logging.rotation" "Log rotation"
+"Log files should be rotated periodically to prevent unbounded growth."
+{ $subsection rotate-logs }
+{ $subsection close-logs }
+"The " { $vocab-link "logging.insomniac" } " vocabulary automates log rotation." ;
+
+ARTICLE: "logging.server" "Log implementation"
+"The " { $vocab-link "logging.server" } " vocabulary implements a concurrent log server using " { $vocab-link "concurrency" } ". User code never interacts with the server directly, instead ot uses the words in the " { $link "logging" } " vocabulary. The server is used to synchronize access to log files and ensure that log rotation can proceed in an orderly fashion."
+$nl
+"The " { $link log-message } " word sends a message to the server which results in the server executing an internal word:"
+{ $subsection (log-message) }
+"The " { $link rotate-logs } " word sends a message to the server which results in the server executing an internal word:"
+{ $subsection (rotate-logs) }
+"The " { $link close-logs } " word sends a message to the server which results in the server executing an internal word:"
+{ $subsection (close-logs) } ;
+
+ARTICLE: "logging" "Logging framework"
+"The " { $vocab-link "logging" } " vocabulary implements a comprehensive logging framework suitable for server-side production applications."
+{ $subsection "logging.files" }
+{ $subsection "logging.levels" }
+{ $subsection "logging.messages" }
+{ $subsection "logging.rotation" }
+{ $subsection "logging.parser" }
+{ $subsection "logging.analysis" }
+{ $subsection "logging.insomniac" }
+{ $subsection "logging.server" } ;
+
+ABOUT: "logging"
+
+! A workaround for circular dependency prohibition
+USING: threads vocabs.loader ;
+[
+    yield
+    "logging.insomniac" require
+] in-thread

extra/logging/logging.factor

@@ -39,8 +39,8 @@ SYMBOL: log-service
 : rotate-logs ( -- )
     { } "rotate-logs" send-to-log-server ;
 
-: close-log-files ( -- )
-    { } "close-log-files" send-to-log-server ;
+: close-logs ( -- )
+    { } "close-logs" send-to-log-server ;
 
 : with-logging ( service quot -- )
     log-service swap with-variable ; inline
@@ -56,7 +56,7 @@ SYMBOL: log-service
         [ dup first string? ]
     } && nip ;
 
-: inputs>message ( obj -- inputs>message )
+: stack>message ( obj -- inputs>message )
     dup one-string? [ first ] [
         H{
             { string-limit f }
@@ -77,9 +77,9 @@ PRIVATE>
 : add-logging ( word level -- )
     [ call-logging-quot ] (define-logging) ;
 
-: log-inputs ( n word level -- )
+: log-stack ( n word level -- )
     log-service get [
-        >r >r [ ndup ] keep narray inputs>message
+        >r >r [ ndup ] keep narray stack>message
         r> r> log-message
     ] [
         3drop
@@ -88,11 +88,19 @@ PRIVATE>
 : input# stack-effect effect-in length ;
 
 : input-logging-quot ( quot word level -- quot' )
-    over input# -rot [ log-inputs ] 3curry swap compose ;
+    over input# -rot [ log-stack ] 3curry swap compose ;
 
 : add-input-logging ( word level -- )
     [ input-logging-quot ] (define-logging) ;
 
+: output# stack-effect effect-out length ;
+
+: output-logging-quot ( quot word level -- quot' )
+    over output# -rot [ log-stack ] 3curry compose ;
+
+: add-output-logging ( word level -- )
+    [ output-logging-quot ] (define-logging) ;
+
 : (log-error) ( object word level -- )
     log-service get [
         >r >r [ print-error ] string-out r> r> log-message
@@ -100,9 +108,9 @@ PRIVATE>
         2drop rethrow
     ] if ;
 
-: log-error ( object word -- ) ERROR (log-error) ;
+: log-error ( error word -- ) ERROR (log-error) ;
 
-: log-critical ( object word -- ) CRITICAL (log-error) ;
+: log-critical ( error word -- ) CRITICAL (log-error) ;
 
 : error-logging-quot ( quot word -- quot' )
     dup stack-effect effect-in length
@@ -118,5 +126,5 @@ PRIVATE>
     CREATE
     dup reset-generic
     dup scan-word
-    [ >r >r 1array inputs>message r> r> log-message ] 2curry
+    [ >r >r 1array stack>message r> r> log-message ] 2curry
     define ; parsing

extra/logging/parser/parser-docs.factor

@@ -0,0 +1,21 @@
+IN: logging.parser
+USING: help.markup help.syntax assocs logging math calendar ;
+
+HELP: parse-log
+{ $values { "lines" "a sequence of strings" } { "entries" "a sequence of log entries" } }
+{ $description "Parses a sequence of log entries. Malformed entries are printed out and ignore. The result is a sequence of arrays of the shape " { $snippet "{ timestamp level word-name message }" } ", where"
+    { $list
+        { { $snippet "timestamp" } " is a " { $link timestamp } }
+        { { $snippet "level" } " is a log level; see " { $link "logger.levels" } }
+        { { $snippet "word-name" } " is a string" }
+        { { $snippet "message" } " is a string" }
+    }
+} ;
+
+ARTICLE: "logging.parser" "Log file parser"
+"The " { $vocab-link "logging.parser" } " vocabulary parses log files output by the " { $vocab-link "logging" } " vocabulary. It is used by " { $link "logging.analysis" } " and " { $link "logging.insomniac" } " to analyze logs."
+$nl
+"There is only one primary entry point:"
+{ $subsection parse-log } ;
+
+ABOUT: "logging.parser"

extra/logging/parser/tags.txt

@@ -0,0 +1 @@
+enterprise

extra/logging/server/server-docs.factor

@@ -0,0 +1,4 @@
+IN: logging.server
+USING: help.syntax ;
+
+ABOUT: "logging.server"

extra/logging/server/server.factor

@@ -50,11 +50,11 @@ SYMBOL: log-files
 : try-dispose ( stream -- )
     [ dispose ] curry [ error. ] recover ;
 
-: close-log-file ( service -- )
+: close-log ( service -- )
     log-files get delete-at*
     [ try-dispose ] [ drop ] if ;
 
-: (close-log-files) ( -- )
+: (close-logs) ( -- )
     log-files get
     dup values [ try-dispose ] each
     clear-assoc ;
@@ -73,13 +73,13 @@ SYMBOL: log-files
     [ 1- log# ] 2keep log# ?rename-file ;
 
 : rotate-log ( service -- )
-    dup close-log-file
+    dup close-log
     log-path
     dup delete-oldest
     keep-logs 1 [a,b] [ advance-log ] with each ;
 
 : (rotate-logs) ( -- )
-    (close-log-files)
+    (close-logs)
     log-root directory [ drop rotate-log ] assoc-each ;
 
 : log-server-loop
@@ -87,9 +87,9 @@ SYMBOL: log-files
         receive unclip {
             { "log-message" [ (log-message) ] }
             { "rotate-logs" [ drop (rotate-logs) ] }
-            { "close-log-files" [ drop (close-log-files) ] }
+            { "close-logs" [ drop (close-logs) ] }
         } case
-    ] [ error. (close-log-files) ] recover
+    ] [ error. (close-logs) ] recover
     log-server-loop ;
 
 : log-server ( -- )

extra/logging/server/tags.txt

@@ -0,0 +1 @@
+enterprise

extra/logging/summary.txt

@@ -1 +1 @@
-AOP Logging framework with support for log rotation and machine-readable logs
+Logging framework with support for log rotation and machine-readable logs

extra/logging/tags.txt

@@ -0,0 +1 @@
+enterprise

extra/project-euler/041/041.factor

@@ -32,7 +32,7 @@ IN: project-euler.041
 
 : euler041 ( -- answer )
     { 7 6 5 4 3 2 1 } all-permutations
-    [ 10 swap digits>integer ] map [ prime? ] find nip ;
+    [ 10 digits>integer ] map [ prime? ] find nip ;
 
 ! [ euler041 ] 100 ave-time
 ! 107 ms run / 7 ms GC ave time - 100 trials

extra/project-euler/043/043.factor

@@ -36,7 +36,7 @@ IN: project-euler.043
 <PRIVATE
 
 : subseq-divisible? ( n index seq -- ? )
-    [ 1- dup 3 + ] dip subseq 10 swap digits>integer swap mod zero? ;
+    [ 1- dup 3 + ] dip subseq 10 digits>integer swap mod zero? ;
 
 : interesting? ( seq -- ? )
     {
@@ -53,7 +53,7 @@ PRIVATE>
 
 : euler043 ( -- answer )
     1234567890 number>digits all-permutations
-    [ interesting? ] subset [ 10 swap digits>integer ] map sum ;
+    [ interesting? ] subset [ 10 digits>integer ] map sum ;
 
 ! [ euler043 ] time
 ! 125196 ms run / 19548 ms GC time
@@ -89,7 +89,7 @@ PRIVATE>
 PRIVATE>
 
 : euler043a ( -- answer )
-    interesting-pandigitals [ 10 swap digits>integer ] sigma ;
+    interesting-pandigitals [ 10 digits>integer ] sigma ;
 
 ! [ euler043a ] 100 ave-time
 ! 19 ms run / 1 ms GC ave time - 100 trials

extra/project-euler/079/079.factor

@@ -54,7 +54,7 @@ PRIVATE>
     concat prune dupd seq-diff append ;
 
 : euler079 ( -- answer )
-    source-079 >edges topological-sort 10 swap digits>integer ;
+    source-079 >edges topological-sort 10 digits>integer ;
 
 ! [ euler079 ] 100 ave-time
 ! 2 ms run / 0 ms GC ave time - 100 trials