8 次代码提交 aea2d00bf7 ... 289ebe3934

作者 SHA1 备注 提交日期
  Arne Babenhauserheide 289ebe3934 move tasks out of main 4 年之前
  Arne Babenhauserheide db72a60ddb move round-trip to round-trip 4 年之前
  Arne Babenhauserheide bcc2dfda8f simplify 4 年之前
  Arne Babenhauserheide f08f5595c6 remove version 4 年之前
  Arne Babenhauserheide 69e25268b8 reduce imports 4 年之前
  Arne Babenhauserheide 494e77fda1 typo 4 年之前
  Arne Babenhauserheide 70f8b25c32 clearer code 4 年之前
  Arne Babenhauserheide ee2b28f5e4 clearer code 4 年之前
共有 1 个文件被更改,包括 48 次插入78 次删除
  1. 48 78
      fcp-example.w

+ 48 - 78
fcp-example.w

@@ -2,14 +2,7 @@
 # -*- wisp -*-
 # A Freenet Client Protocol library for Guile Scheme.
 
-guile -L $(dirname $(realpath "$0")) -c '(import (language wisp spec))'
-PROG="$0"
-if [[ "$1" == "-i" ]]; then
-    shift
-    exec -a "${PROG}" guile -L $(dirname $(realpath "$0")) --language=wisp -x .w -e '(fcp-example)' -- "${@}"
-else
-    exec -a "${0}" guile -L $(dirname $(realpath "$0")) --language=wisp -x .w -e '(fcp-example)' -c '' "${@}"
-fi;
+exec -a "${0}" guile -L $(dirname $(realpath "$0")) --language=wisp -x .w -e '(fcp-example)' -c '' "${@}"
 ; !#
 
 ;; for emacs (defun test-this-file () (interactive) (save-current-buffer) (async-shell-command (concat (buffer-file-name (current-buffer)) " --test")))
@@ -17,8 +10,6 @@ fi;
 define-module : fcp-example
     . #:export : main
 
-define version "0.0.0 just-do-it"
-
 import
     only (fcp) message-create message-task message-type message-data message-fields
              . message-client-get  message-client-get-realtime message-client-get-bulk 
@@ -30,66 +21,43 @@ import
              . processor-datafound-getdata 
              . task-id
              . call-with-fcp-connection with-fcp-connection
-    only (ice-9 pretty-print) pretty-print truncated-print
-    only (srfi srfi-1) first second third alist-cons assoc lset<= lset-intersection lset-difference take
+    only (srfi srfi-1) first second third assoc
     only (rnrs bytevectors) string->utf8 utf8->string
-    doctests
 
-define : help args
-    format : current-output-port
-           . "~a [-i] [--help | --version | --test | YYYY-mm-dd]
 
-Options:
-        -i    load the script and run an interactive REPL."
-           first args
+define : request-successful-upload message
+    . "When the put succeeds, download the data."
+    if : equal? 'PutSuccessful : message-type message
+         let : : fields : message-fields message
+           when : and=> (assoc 'URI fields) : λ (uri-cel) : equal? key (cdr uri-cel)
+                  send-message
+                       message-client-get-realtime get-task key
+           . #f
+         . message
 
-define : final-action? args
-   if {(length args) <= 1} #f
-     cond 
-       : equal? "--help" : second args
-         help args
-         . #t
-       : equal? "--version" : second args
-         format : current-output-port
-                . "~a\n" version
-         . #t
-       else #f
-       
-    
-define : main args
-  define put-task : task-id
-  define get-task : task-id
-  define key : string-append "KSK@" put-task
-  define successful #f
-  ;; setup interaction:
-  ;; when the put succeeds, download the data.
-  define : request-successful-upload message
-      if : equal? 'PutSuccessful : message-type message
-           let : : fields : message-fields message
-             when : and=> (assoc 'URI fields) : λ (uri) : equal? key : cdr uri
-                    pretty-print message
-                    send-message
-                         message-client-get-realtime get-task key
-             . #f
-           . message
-  ;; when the download succeeds, display the result and 
-  define : record-successful-download message
-      if : equal? 'AllData : message-type message
-           let : : task : message-task message
-             when : equal? task get-task
-                    pretty-print message
-                    display "Data: "
-                    truncated-print : utf8->string (message-data message)
-                    newline
-                    set! successful #t
-             . #f
-           . message
-  ;; cleanup the task because we use the global queue for easier debugging
-  define : remove-successful-tasks-from-queue message
-    when : member (message-type message) '(AllData PutSuccessful)
-           send-message : message-remove-request : message-task message
-    . message
-  ;; standard processorrs
+define : record-successful-download message
+    . "When the download succeeds, display the result"
+    if : equal? 'AllData : message-type message
+         let : : task : message-task message
+           when : equal? task get-task
+                  format #t "Received Message: ~a\n" : utf8->string (message-data message)
+                  set! successful #t
+           . #f
+         . message
+
+define : remove-successful-tasks-from-queue message
+  . "Cleanup the task because we use the global queue for easier debugging"
+  when : member (message-type message) '(AllData PutSuccessful)
+         send-message : message-remove-request : message-task message
+  . message
+
+define put-task : task-id
+define get-task : task-id
+define key : string-append "KSK@" put-task
+define successful #f
+
+define : setup-handlers
+  ;; standard processors
   processor-put! printing-discarding-processor
   processor-put! processor-nodehello-printer
   ;; immediately request data from successfull get requests
@@ -98,15 +66,17 @@ define : main args
   processor-put! request-successful-upload
   processor-put! record-successful-download
   processor-put! remove-successful-tasks-from-queue
-  when : not : final-action? args
-    ;; setup the FCP connection. Anything inside this scope can
-    ;; communicate directly with Freenet via FCP, other interaction
-    ;; must be done through processing procedures as setup above.
-    with-fcp-connection
-        ;; get the ball rolling
-        send-message
-            message-client-put-realtime put-task key
-                string->utf8 : string-append "Hello " key
-        while : not successful
-            display "."
-            sleep 1 ;; relaxed heartbeat
+
+define : main args
+  setup-handlers
+  ;; setup the FCP connection. Anything inside this scope can
+  ;; communicate directly with Freenet via FCP, other interaction
+  ;; must be done through processing procedures as setup above.
+  with-fcp-connection
+      ;; get the ball rolling
+      send-message
+          message-client-put-realtime put-task key
+              string->utf8 : string-append "Hello " key
+      while : not successful
+          display "."
+          sleep 1