spider load file

This commit is contained in:
erana 2012-02-01 12:46:31 +09:00
parent 8cf151a71c
commit f740005eab
5 changed files with 80 additions and 15 deletions

View File

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

View File

@ -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)
))

View File

@ -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"))
;; )

View File

@ -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 "")

View File

@ -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)))