better logging for webapps.planet

extra/io/server/server.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2003, 2007 Slava Pestov.
+! Copyright (C) 2003, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io io.sockets io.files continuations kernel math
 math.parser namespaces parser sequences strings
@@ -9,11 +9,14 @@ IN: io.server
 
 SYMBOL: log-stream
 
+: with-log-stream ( quot -- )
+    log-stream get swap with-stream* ; inline
+
 : log-message ( str -- )
-    log-stream get [
+    [
         "[" write now timestamp>string write "] " write
         print flush
-    ] with-stream* ;
+    ] with-log-stream ;
 
 : log-error ( str -- ) "Error: " swap append log-message ;
 
@@ -24,15 +27,13 @@ SYMBOL: log-stream
 : log-file ( service -- path )
     ".log" append resource-path ;
 
-: with-log-stream ( stream quot -- )
-    log-stream swap with-variable ; inline
-
 : with-log-file ( file quot -- )
     >r <file-appender> r>
-    [ with-log-stream ] curry with-disposal ; inline
+    [ log-stream swap with-variable ] curry
+    with-disposal ; inline
 
 : with-log-stdio ( quot -- )
-    stdio get swap with-log-stream ;
+    stdio get log-stream rot with-variable ; inline
 
 : with-logging ( service quot -- )
     over [

extra/webapps/planet/planet.factor

@@ -2,7 +2,7 @@ USING: sequences rss arrays concurrency kernel sorting
 html.elements io assocs namespaces math threads vocabs html
 furnace http.server.templating calendar math.parser splitting
 continuations debugger system http.server.responders
-xml.writer prettyprint ;
+xml.writer prettyprint io.server ;
 IN: webapps.planet
 
 : print-posting-summary ( posting -- )
@@ -75,13 +75,11 @@ SYMBOL: cached-postings
 
 SYMBOL: last-update
 
-: diagnostic write print flush ;
-
 : fetch-feed ( triple -- feed )
     second
-    dup "Fetching " diagnostic
+    "Fetching " over append log-message
     dup download-feed feed-entries
-    swap "Done fetching " diagnostic ;
+    "Done fetching " swap append log-message ;
 
 : <posting> ( author entry -- entry' )
     clone
@@ -89,7 +87,11 @@ SYMBOL: last-update
     [ set-entry-title ] keep ;
 
 : ?fetch-feed ( triple -- feed/f )
-    [ fetch-feed ] [ swap . error. f ] recover ;
+    [
+        fetch-feed
+    ] [
+        swap [ . error. ] with-log-stream f
+    ] recover ;
 
 : fetch-blogroll ( blogroll -- entries )
     dup 0 <column>
@@ -111,7 +113,11 @@ SYMBOL: last-update
     update-thread ;
 
 : start-update-thread ( -- )
-    [ update-thread ] in-thread ;
+    [
+        "webapps.planet" [
+            update-thread
+        ] with-logging
+    ] in-thread ;
 
 "planet" "planet-factor" "extra/webapps/planet" web-app