diff --git a/s48/cavespider/client.scm b/s48/cavespider/client.scm index 6c79886..e074125 100644 --- a/s48/cavespider/client.scm +++ b/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)))) diff --git a/s48/cavespider/load.scm b/s48/cavespider/load.scm index 43a47d5..7b2faa4 100644 --- a/s48/cavespider/load.scm +++ b/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)) - (url->hostname url-list hostname-list);;FIXME url-list - (display hostname-list) - - ) + (let ((hostname-list '()) + (keywordl '()) + (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) )) diff --git a/s48/cavespider/string-util-alt.scm b/s48/cavespider/string-util-alt.scm index b6afb5f..27e37fe 100644 --- a/s48/cavespider/string-util-alt.scm +++ b/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)) - -(display - (file-contents->url (html-dump "index.html")) - ) +;; test +;;(display +;; (file-contents->url (html-dump "index.html")) +;; ) diff --git a/s48/cavespider/string-util.scm b/s48/cavespider/string-util.scm index 5773e8c..60d1382 100644 --- a/s48/cavespider/string-util.scm +++ b/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 "") diff --git a/s48/cavespider/util.scm b/s48/cavespider/util.scm index 8f0ab0a..1fa3c0d 100644 --- a/s48/cavespider/util.scm +++ b/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)))