spider load file

s48/cavespider/client.scm

@@ -83,8 +83,8 @@
       (display c out-file-port)
       ;;(display c)
       )
-	))
     ))
+    dir-filename))
 
 
 ;    (let ((contents (file->contents (string-append dir-filename "/" filename))))

s48/cavespider/load.scm

@@ -37,14 +37,20 @@
 (display "give port : ")
 (define port (number->string (read)))
 (newline)
-(display (ask-server (string-append "GET / HTTP/1.0" (string #\return #\newline #\return #\newline) "index.html" hostname port)))
+(define dir-filename (display (ask-server (string-append "GET / HTTP/1.0" (string #\return #\newline #\return #\newline) "index.html" hostname port))))
 
-(let ((file-contents (file->string "index.html")))
+(display "give string to search for (no spaces): ")
+(define keyword (symbol->string (read))
+(newline)
+
+(let ((file-contents (file->string (string-append dir-filename "/" "index.html"))));;FIXME dir
 ;;  (do ((url-list (file-contents->url file-contents 0)
 ;;                 (file-contents->url file-contents 0)))
-  (let ((url-list (file-contents->url file-contents 0))
+  (let ((hostname-list '())
-        (url->hostname url-list hostname-list);;FIXME url-list
+        (keywordl '())
-        (display hostname-list)
+        (url-list (file-contents->url file-contents 0)))
-
+    (set! hostname-list (url->hostname url-list hostname-list));;FIXME url-list
-        )
+    (display hostname-list)
+    (file-contents->keyword file-contents keyword)
+    (display keywordl)
     ))

s48/cavespider/string-util-alt.scm

@@ -1,4 +1,4 @@
-;;;
+
 ;;; Copyright (c) 2012 Johan Ceuppens
 ;;;
 ;;; All rights reserved.
@@ -33,11 +33,69 @@
 ;;  (let ((file-contents (file-contents->url )))
 ;;    ))
 
+;; FIXME double in string-util.scm
+
+(define (url->hostname url-list hostname-list)
+  (let ((s "")
+        (rets "")
+        (j 0)
+        (url (if (null? url-list)
+                 #f
+                 (car url-list)))
+        )
+
+    ;;(display "URL=")(display url)(newline)
+
+    (if url
+        (begin
+          (set! url (string-append url (string #\/)));;following /
+          (if (>= (string-length url) 8)
+              (begin
+                (do ((i 0 (+ i 1)))
+                    ((cond ((>= i (string-length url))
+                            (set! j (string-length url)))
+                           ((or (string=? s "http://")(string=? s "ftp://")
+                                (string=? s " http://")(string=? s " ftp://"))
+                            (set! j i)))
+                   #t)
+                  (set! s (string-append s (string (string-ref url i))))
+                )
+
+                (do ((i j (+ i 1)))
+                    ((cond ((>= i (string-length url))
+                          #t)
+                           ((not (eq? #\/ (string-ref url i)))
+                            (set! j i)))
+                     #t)
+                  )
+
+                (do ((i j (+ i 1)))
+                    ((or (>= i (string-length url))
+                         (eq? (string-ref url i) #\space)
+                         (eq? (string-ref url i) #\newline)
+                         (eq? (string-ref url i) #\/)
+                         (eq? (string-ref url i) #\\))
+                     #t)
+                  (set! rets (string-append rets (string (string-ref url i))))
+                  )
+
+                (display rets)
+
+                (set! hostname-list (append (list rets) (url->hostname (cdr url-list) hostname-list)))
+                )
+              rets)
+          rets)
+        (begin
+          ;;(display s)
+          rets))
+    rets))
+
+
 
 (define (tags filename)
   (html-tags filename))
 
-(define (file-contents->url tags-of-file-contents-str)
+(define (file-contents->url tags-of-file-contents-str . dummy)
   ;;(display tags-of-file-contents-str)
   (let ((s "")
         (ret '())
@@ -93,7 +151,7 @@
       )
     ret))
 
-
+;; test
-(display
+;;(display
- (file-contents->url (html-dump "index.html"))
+;; (file-contents->url (html-dump "index.html"))
- )
+;; )

s48/cavespider/string-util.scm

@@ -25,7 +25,7 @@
 ;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
 ;;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
-
+;; FIXME double in string-util-alt.scm
 (define (url->hostname url-list hostname-list)
   (let ((s "")
         (rets "")

s48/cavespider/util.scm

@@ -26,6 +26,7 @@
 ;;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 (load "file-util.scm")
+(load "search-util.scm")
 
 (display "Do you want to use hash tables (y/n)?")
 (let ((c (read-char)))