long-urls: expand short urls.

diff --git a/extra/long-urls/authors.txt b/extra/long-urls/authors.txt
new file mode 100644 (file)
index 0000000..e091bb8
--- /dev/null
+++ b/extra/long-urls/authors.txt
@@ -0,0 +1 @@
+John Benediktsson

diff --git a/extra/long-urls/long-urls.factor b/extra/long-urls/long-urls.factor
new file mode 100644 (file)
index 0000000..4b63835
--- /dev/null
+++ b/extra/long-urls/long-urls.factor
@@ -0,0 +1,31 @@
+! Copyright (C) 2015 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: accessors http http.client http.client.private kernel
+math namespaces ;
+
+IN: long-urls
+
+SYMBOL: max-redirects
+5 max-redirects set-global
+
+<PRIVATE
+
+SYMBOL: redirects
+
+: http-head-no-redirects ( url -- response data )
+    <head-request> 0 >>redirects http-request* ;
+
+: next-url ( url -- next-url redirected? )
+    redirects inc
+    redirects get max-redirects get <= [
+        dup http-head-no-redirects drop
+        dup redirect? [
+            nip "location" header t
+        ] [ drop f ] if
+    ] [ too-many-redirects ] if ;
+
+PRIVATE>
+
+: long-url ( short-url -- long-url )
+    [ [ next-url ] loop ] with-scope ;

diff --git a/extra/long-urls/summary.txt b/extra/long-urls/summary.txt
new file mode 100644 (file)
index 0000000..e0bed50
--- /dev/null
+++ b/extra/long-urls/summary.txt
@@ -0,0 +1 @@
+Expand short urls.