From 14481db63f1ef04af43972009aa78cff1d7c85e2 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 31 Jan 2008 01:15:28 -0600
Subject: [PATCH] Smarter download word, old download word renamed to
 download-to for Ed

---
 extra/http/client/client-tests.factor |  5 +++++
 extra/http/client/client.factor       | 18 ++++++++++++++++--
 2 files changed, 21 insertions(+), 2 deletions(-)
 mode change 100644 => 100755 extra/http/client/client-tests.factor

diff --git a/extra/http/client/client-tests.factor b/extra/http/client/client-tests.factor
old mode 100644
new mode 100755
index 5c570993e6..d2fb719acd
--- a/extra/http/client/client-tests.factor
+++ b/extra/http/client/client-tests.factor
@@ -7,3 +7,8 @@ USING: http.client tools.test ;
 [ 404 ] [ "404 File not found" parse-response ] unit-test
 [ 200 ] [ "HTTP/1.0 200" parse-response ] unit-test
 [ 200 ] [ "HTTP/1.0 200 Success" parse-response ] unit-test
+
+[ "foo.txt" ] [ "http://www.paulgraham.com/foo.txt" download-name ] unit-test
+[ "foo.txt" ] [ "http://www.arcsucks.com/foo.txt?xxx" download-name ] unit-test
+[ "foo.txt" ] [ "http://www.arcsucks.com/foo.txt/" download-name ] unit-test
+[ "www.arcsucks.com" ] [ "http://www.arcsucks.com////" download-name ] unit-test
diff --git a/extra/http/client/client.factor b/extra/http/client/client.factor
index d03ce37c14..dde2c7d205 100755
--- a/extra/http/client/client.factor
+++ b/extra/http/client/client.factor
@@ -59,9 +59,23 @@ DEFER: http-get-stream
         http-get-stream [ stdio get contents ] with-stream
     ] with-scope ;
 
-: download ( url file -- )
+: download-name ( url -- name )
+    file-name "?" split1 drop "/" ?tail drop ;
+
+: default-timeout 60 1000 * over set-timeout ;
+
+: success? ( code -- ? ) 200 = ;
+
+: download-to ( url file -- )
     #! Downloads the contents of a URL to a file.
-    >r http-get 2nip r> <file-writer> [ write ] with-stream ;
+    >r http-get-stream nip default-timeout swap success? [
+        r> <file-writer> stream-copy
+    ] [
+        r> drop dispose "HTTP download failed" throw
+    ] if ;
+
+: download ( url -- )
+    dup download-name download-to ;
 
 : post-request ( content-type content host resource -- )
     #! Note: It is up to the caller to url encode the content if