cl-web-crawler包的概要解读
本文大概介绍cl-web-crawler中的函数

 

=========总览=========

cl-web-crawler这个包有这些文件
　　cl-web-crawler.asd
　　web-crawler.lisp
　　unique-queue.lisp
　　packages.lisp
　　conditions.lisp
　　macros.lisp
另外两个
　　tests.lisp
　　test-packages.lisp
应该是用作测试的，不过我没试。。。

 

cl-web-crawler的用法在packages.lisp中就可以看出来，看:export的符号。但是我总觉得start-crawl函数写得有问题，所以这里建议这样做
在(asdf:load-system "cl-web-crawler")之后，执行(in-package :webc);;
然后执行

(start-crawl "[你想要抓的网址,如:http://admin.wen.ithaowai.com/member/default/login]"     
    (make-save-page-processor "[你要将爬取结果保存到哪个目录下，例如:d:/crawler-test-results/]") 
    :uri-filter (make-same-host-filter "[跟之前相同的网址]") 
    :verbose t)

这里没有设定自动抓取间隔时间参数:crawl-delay，参数默认值是10s抓一次，你可以加上:crawl-delay 1来实现每秒抓一次。
这里的这个示例网址没什么结果，因为这个网站的robots.txt里面是禁止所有爬取的(http://admin.wen.ithaowai.com/robots.txt)。

 

=========各部分概览============
首先看macros.lisp，这里只定义了一个macro。
　　看这个名叫cut的宏定义，上来就是一个let定义一个局部变量syms，然后用labels定义一个局部函数（与labels功能相近的一个特殊操作符是flet，这两个之间的关系，就像是let*与let之间的关系）gen-used-syms，它接受一个参数。它的函数主体是一个mapcar函数，此处简化就是(mapcar #'(lambda ...) tree)，意思就是对tree中的每个元素应用lambda函数；lambda函数中只有个typecase：如果参数elem是个"_"(就是个下划线），那就让lambda函数返回一个符号，形式为#:ARG123,#ARG456...(就是#:ARG后加个数字）；如果是个list，递归调用gen-used-syms，最终他会把一个列表中所有的"_"替换为#:ARG333的形式。
　　下面看局部函数定义之后的内容，又是一个let的局部变量定义，将newbody绑定为了经过gen-used-syms处理过的body，然后后面的`(function....)说明cut宏展开之后形成的表达式的返回值是个函数，这个函数的参数是(nreverse syms)。syms是怎么产生的呢？在之前gen-used-syms处理参数body的过程中，每次在body中发现一个"_",就产生一个#:ARGxxx,并将#:ARGxxx push进入syms中。由此可见body参数中有几个下划线，syms中就有几个参数，只不过由于push的关系，顺序是相反的，而现在(nreverse syms)就让顺序变得跟body中的一样了。
　　综上，cut的作用是，用gensym产生的符号代替body中的"_",并利用其参数返回一个函数。例如：

(cut member _ '(#\Space #\Tab #\Return #\Newline))

　　首先处理body参数，产生未来lambda函数的主体，

(member #:ARG234 '(#\Space #\Tab #\Return #\Newline))

　　lambda函数的参数来源是syms，则最终cut宏展开，再求值之后返回一个函数对象：

#'(lambda (#:ARG234) (member #:ARG234 '(#\Space #\Tab #\Return #\Newline)))

 

下面看unique-queue.lisp的内容，这里只定义了一个类。
　　在这个类定义中，qlist是个list，qtail是个list，qlist相当于个C语言中的指针，指向qlist中的最后一个元素。具体来说就像，qlist是'((:apple banana) (:melon water)),而qtail是'((:melon water));另外推测：qtail所代表的列表并不是是qlist中的(:melon water)元素的复制，两个应该是相同的内存地址，原因可以看下面的q-add的method。
　　可以看到下面定义了一个广义函数，并定义了method，这种方式定义method应该和先(defgeneric q-add (...) ...)再(defmethod q-add (...) ...)并没有什么区别，（大概吧。。。主要是没查到）

　　q-add函数主体：比较绕的地方在：

(let ((new (list item)))
　　(if (qlist q) ;;如果这个表达式为真的话，则证明qlist中有东西
　　 　　(setf (cdr (qtail q)) new)
　　　　 (setf (qlist q) new))
　　(setf (qtail q) new)
　　(setf (gethash (funcall (key q) item) (qhash q)) t)
t)

　　如果qlist为真的话，证明qlist中有东西，就使(cdr qtail q)为new(new就像是个'((:straw rebey)) 。。。）这样的东西，下面是几个例子：

CL-USER> (setq *ap-list* '((e e)))
((E E))
CL-USER> (setf (cdr *ap-list*) '((f f)))
((F F))
CL-USER> *ap-list*
((E E) (F F))
CL-USER> (setf (cdr *ap-list*) '(f f))
(F F)
CL-USER> *ap-list*
((E E) F F)
CL-USER> '((f f))
((F F))

　　这样的结果我并不怎么理解，可能这与点对单元和list的实现有关。而且像(setf (cdr *ap-list*) '((f f)))这样的操作可以完全不用cdr和setf实现，而用append和nconc实现。
　　总之q-add的method就是向qlist中添加一个之前不存在的元素。

　　qhash槽代表一个hash-table，用来记录qlist中是否有某个元素。

　　下面定义了一个函数make-unique-queue，它是用来创建unique-queue对象的。
　　identity函数，只接收一个参数object，cltl文档中给出的解释是，这个object作为函数返回值被返回。意思应该就是返回object本身。

　　另外，key参数的作用同样可以在q-add函数中看出来：

(setf (gethash (funcall (key q) item) (qhash q)) t)

　　(key q)的求值结果是在(make-instance 'unique-queue ... :key key ....)时传入的参数，这个参数是个函数；(funcall (key q) item)正是用这个函数，将其作用于item提取出用于gethash的键值。
　　q-existed用于判断item是否在qlist中，一样可以通过gethash来实现。
　　q-empty判断qlist是否为空；如果空，返回t。
　　q-pop用于从qlist中pop一个元素。

 

下面来看conditions.lisp。其中定义了一个状况，stop-crawling，和一个函数。
　（顺便说句，这里的define-condition里的“(reason :initarg reason :reader reason)”是不是应该把:initarg 后面的那个reason改成:reason呢？）

　　这个状况和函数只在web-crawler.lisp中用到了，等到了那时再看吧。

 

下面主要分析web-crawler.lisp。
挑主要的。
首先是

#string-only-whitespace-p

　　这个函数，根据上面对cut宏的解释，这个函数的主体可以展开为

(every #'(lambda (#:ARG2345) (member #:ARG2345 '(#\Space #\Tab #\Return #\Newline))) 
 text)

　　这个函数最为奇葩的地方在于它在web-crawler.lisp中没有被调用，而是在那个用来测试的tests.lisp中被调用了。

#parse-robots-txt

　　接着是parse-robots-txt函数，这里写了的注释意思大概是，接受一个text参数（比如http://baidu.com/robots.txt里面的内容），而且这个text参数应该是个字符串（字符串是序列）；函数返回值是个列表，就像是这样

(("Baiduspider" "/baidu" "/s?" "/ulink?" "/link?" "/home/news/data/" "/bh") 
 ("Googlebot" "/baidu" "/s?" "/shifen/" "/homepage/" "/cpro" "/ulink?" "/link?" "/home/news/data/" "/bh") 
 ("MSNBot" "/baidu" "/s?" "/shifen/" "/homepage/" "/cpro" "/ulink?" "/link?" "/home/news/data/" "/bh") 
 ("Baiduspider-image" "/baidu" "/s?" "/shifen/" "/homepage/" "/cpro" "/ulink?" "/link?" "/home/news/data/" "/bh") 
 ("YoudaoBot" "/baidu" "/s?" "/shifen/" "/homepage/" "/cpro" "/ulink?" "/link?" "/home/news/data/" "/bh") 
 ("Sogou" "/baidu" "/s?" "/shifen/" "/homepage/" "/cpro" "/ulink?" "/link?" "/home/news/data/" "/bh") 
 ("Sogou" "/baidu" "/s?" "/shifen/" "/homepage/" "/cpro" "/ulink?" "/link?" "/home/news/data/" "/bh")
 ("Sogou" "/baidu" "/s?" "/shifen/" "/homepage/" "/cpro" "/ulink?" "/link?" "/home/news/data/" "/bh")
 ("Sogou" "/baidu" "/s?" "/shifen/" "/homepage/" "/cpro" "/ulink?" "/link?" "/home/news/data/" "/bh")
 ("Sogou" "/baidu" "/s?" "/shifen/" "/homepage/" "/cpro" "/ulink?" "/link?" "/home/news/data/" "/bh")
 ("Sogou" "/baidu" "/s?" "/shifen/" "/homepage/" "/cpro" "/ulink?" "/link?" "/home/news/data/" "/bh")
 ("ChinasoSpider" "/baidu" "/s?" "/shifen/" "/homepage/" "/cpro" "/ulink?" "/link?" "/home/news/data/" "/bh")
 ("Sosospider" "/baidu" "/s?" "/shifen/" "/homepage/" "/cpro" "/ulink?" "/link?" "/home/news/data/" "/bh")
 ("yisouspider" "/baidu" "/s?" "/shifen/" "/homepage/" "/cpro" "/ulink?" "/link?" "/home/news/data/" "/bh")
 ("EasouSpider" "/baidu" "/s?" "/shifen/" "/homepage/" "/cpro" "/ulink?" "/link?" "/home/news/data/" "/bh")
 ("*" "/"))

　　你可以执行(get-robots-rules "https://baidu.com")来试试。

#uri-is-allowed

　　然后是uri-is-allowed函数，这个主要用在后面，在后面爬取url的循环中，程序从之前unique-queue类的对象中的qlist中取出一个item（这个item就是一个具体的url，另外uri和url都看作一样的东西就行了，就像是“https://baidu.com”这样的东西就行，具体的区别在这里不用考虑），然后用这个函数来判断这个item（url）是否允许被抓取（网站在那个robots.txt中规定了它自身的某些目录禁止爬虫爬取）。

　　然后是find-all-links函数，它用于在在获取的一个reply的html文档中的所有链接（然后看qlist中是否有这个链接，如果没有，就加进去，这样的话就能从这个url爬到更多的url）。这里面的函数mapcan，参照cltl的话，它和mapcar是很像的，只不过mapcan用nonc连接结果，而不是list，具体是这样：

(mapcan #'(lambda (x) (and (numberp x) (list x))) '(a 1 b c 3 4 d 5))
=> (1 3 4 5)
(mapcar #'(lambda (x) (and (numberp x) (list x))) '(a 1 b c 3 4 d 5))
=> (NIL (1) NIL NIL (3) (4) NIL (5))

另外：

(nconc nil '(1 3)) => (1 3)
(list nil '(1 2)) => (NIL (1 2))

　　因此在这里，如果对links中的任意一个元素，应用lambda函数之后产生了nil，那么nil将不会包含如mapcan函数的返回结果中。而lambda函数产生nil的可能情况就是(uri-parse-error () nil)。

#make-same-host-filter

　　然后是make-same-host-filter函数，它接受一个uri（或者一个puri:uri对象），返回一个函数对象。这里面的那句 ((host (uri-host (uri uri))))（就是let那里的那个绑定），你可以在(in-package :webc)（webc就是这个"WEB-CRAWLER"的包的nickname）之后试试

 

(uri-host (uri "https://www.nuomiphp.com/github/zh/5ff3bc0be8b0687fe54a47b0.html"))

 

 

 

　　它会返回"www.nuomiphp.com"，也就是主机地址。
　　等到看完下面的start-crawl函数就会知道，这个函数返回的函数对象是用来保证从find-all-links得到的link（就是爬页面爬到的link）是否还在最最开始指定的uri的主机地址上，也就是说保证爬baidu.com的时候不会爬到bing.com上去。

#make-save-page-processor

　　这个函数返回的也是个函数对象。这个函数对象用来将爬到的页面保存在计算机上的某个目录中。

#crawl-and-save-site和start-craw

　　我怀疑作者把这两个函数写乱了。
　　观察start-crawl函数要接受的参数，再看crawl-and-save-site函数中对start-crawl函数的调用，就大概明白start-crawl函数怎样调用了。

　　start-crawl这个函数内部流程大概就是：最开始，将start-uri放入已经建好的unique-queue对象的qlist槽中，然后启动一个loop：

　　从qlist中取出uri，将其作为参数传给在start-crawl中局部定义的函数crawl-page中，crawl-page会发get请求来请求页面，并且会解析出页面上所有的link，并且将link加入qlist中。crawl-page的返回值之一text（请求的页面的正文）会被保存到文件里。当qlist中没有item时（也就是没有uri要爬时），loop终止，函数也就结束了。

　　这就是start-crawl这个函数的大致流程，但还有一些细节没有提到，但总之不影响理解原理。