From 94f7550f4fc3591d83cdaed9d3ae9e78c2561228 Mon Sep 17 00:00:00 2001
From: erana <jceuppen@vub.ac.be>
Date: Wed, 18 Jan 2012 02:20:18 +0900
Subject: [PATCH] SPAN - client get command

---
 scsh/SPAN/SPAN-client.scm |  6 +++---
 scsh/SPAN/SPAN-server.scm |  2 +-
 scsh/SPAN/SPAN.scm        |  2 +-
 scsh/SPAN/load.scm        | 40 +++++++++++++++++++++++++++++++--------
 4 files changed, 37 insertions(+), 13 deletions(-)

diff --git a/scsh/SPAN/SPAN-client.scm b/scsh/SPAN/SPAN-client.scm
index b957bd3..79035a8 100644
--- a/scsh/SPAN/SPAN-client.scm
+++ b/scsh/SPAN/SPAN-client.scm
@@ -1,6 +1,6 @@
 ;;; client.scm - a full-duplex connect-to-server
 ;;;
-;;; Copyright (c) 2011-2012 Johan Ceuppens
+;;; Copyright (c) 2012 Johan Ceuppens
 ;;;
 ;;; All rights reserved.
 ;;;
@@ -26,10 +26,10 @@
 ;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
 ;;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
-(define (SPAN-ask-server request port-number)
+(define (SPAN-ask-server request hostname port)
   (call-with-values
     (lambda ()
-      (socket-client (get-host-name) port-number))
+      (socket-client hostname port))
     (lambda (in out)
        (display request out)
        (close-output-port out)
diff --git a/scsh/SPAN/SPAN-server.scm b/scsh/SPAN/SPAN-server.scm
index 55228b6..005bb6c 100644
--- a/scsh/SPAN/SPAN-server.scm
+++ b/scsh/SPAN/SPAN-server.scm
@@ -1,6 +1,6 @@
 ;;; server.scm - a full-duplex connect-to-client
 ;;;
-;;; Copyright (c) 2011-2012 Johan Ceuppens
+;;; Copyright (c) 2012 Johan Ceuppens
 ;;;
 ;;; All rights reserved.
 ;;;
diff --git a/scsh/SPAN/SPAN.scm b/scsh/SPAN/SPAN.scm
index 787fc37..bc94e01 100644
--- a/scsh/SPAN/SPAN.scm
+++ b/scsh/SPAN/SPAN.scm
@@ -1,6 +1,6 @@
 ;;; SPAN.scm - Scheme Perl Archive Network
 ;;;
-;;; Copyright (c) 2011-2012 Johan Ceuppens
+;;; Copyright (c) 2012 Johan Ceuppens
 ;;;
 ;;; All rights reserved.
 ;;;
diff --git a/scsh/SPAN/load.scm b/scsh/SPAN/load.scm
index 755fb03..6fb1e85 100644
--- a/scsh/SPAN/load.scm
+++ b/scsh/SPAN/load.scm
@@ -1,6 +1,6 @@
-;;; schemedoc.scm - a scheme perldoc utility
+;;; load.scm - a scheme SPAN
 ;;;
-;;; Copyright (c) 2011-2012 Johan Ceuppens
+;;; Copyright (c) 2012 Johan Ceuppens
 ;;;
 ;;; All rights reserved.
 ;;;
@@ -27,9 +27,14 @@
 ;;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 (load "SPAN.scm")
+(load "SPAN-client.scm")
 
 ;; initialization
 
+;; Commands:
+;; h : display help
+;; get : fetch file
+
 ;; question 1
 
 (define SPAN-build-and-cache-dir (string-append (getenv "HOME") "/.span"))
@@ -147,10 +152,29 @@
                   #f))
 
 (display SPAN-shell-droptext-22)
-(do ((s (read)(read))
-     ((and (symbol? s)
-           (string<=? (symbol->string s)(string #\return)))
-      0)
-     #t))
+(define (url-bite-off url)
+  (let ((s "")
+        (do ((i 0 (+ i 1)))
+            ((>= i (string-length url))
+             ;;(if (= (string-ref url i) #\/)
+             ;;    (set!
+             s)
+          (set! s (string-append s (string (string-ref url i)))))
+        (if (or (eq? s "http://")(eq? s "ftp://"))
+            (set! s "")))))
 
-(display "Signing off - rest is under dev"))
\ No newline at end of file
+(do ((s (read)(read)))
+    ((null? s)0)
+  (cond ((symbol? s)
+         (cond ((string<=? (symbol->string s)(string #\return))
+                0)
+               ((string=? "h" (symbol->string s))
+                (display "Commands : get ")
+                0)
+               ((string<=? "get" (symbol->string s))
+                (display "enter package to fetch : ")
+                (SPAN-ask-server (string-append "get " (symbol->string (read)))
+                                 (url-bite-off SPAN-mirror-url) 6969))
+               ))
+        ))
+(display "Signing off.")
\ No newline at end of file