spider load file
This commit is contained in:
parent
8cf151a71c
commit
f740005eab
|
@ -83,8 +83,8 @@
|
|||
(display c out-file-port)
|
||||
;;(display c)
|
||||
)
|
||||
))
|
||||
))
|
||||
dir-filename))
|
||||
|
||||
|
||||
; (let ((contents (file->contents (string-append dir-filename "/" filename))))
|
||||
|
|
|
@ -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)
|
||||
))
|
||||
|
|
|
@ -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"))
|
||||
;; )
|
||||
|
|
|
@ -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 "")
|
||||
|
|
|
@ -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)))
|
||||
|
|
Loading…
Reference in New Issue