ITPub博客

首页 > Linux操作系统 > Linux操作系统 > cl 的完整程序

cl 的完整程序

原创 Linux操作系统 作者:babyyellow 时间:2012-04-20 09:57:56 0 删除 编辑

说明: 非原创,抄来的, 放在这里的目的是,给大家一个范例,写一个可以发布的lisp 程序基本就是这个格式了

http://blog.sina.com.cn/s/blog_510ac74901011fww.html


这应该还是算实用的一段代码,虽然,用python,perl 实现要远远的简单的多。



这个程序的思想是通过系统调用ls -al,然后用正则解析其输出结果,再依照这个原理遍历每一个子目录

;;-------------wy_file_fun.asd------------

;; 定义自己的package

(defpackage :wy.file
  (:use     :common-lisp
            :cl-ppcre)
  (:export  :walk
            :dir-detail)  )

 

 

;;--------------wy_file_fun.lisp--------------

(in-package :wy.file)

;;walk是接口函数,遍历每一个子目录,输出形式是((*(filename filepath&name size flag)) size)链表,*代表多个,

;;以这种形式将当前目录以及子目录中所有的文件和目录都返回出来

(defun walk  (path-name) (let ((file-list nil)
                               (tmp-res nil)
                               (value-after-total 0)
                               (dir-info nil))
                           (setf dir-info (dir-detail path-name))
                           (setf file-list (elt dir-info 0))
                           (setf value-after-total (elt dir-info 1))
                           (loop for x in file-list
                                do (if (eq (elt (elt x 3) 0) #\d)
                                  (progn (setf tmp-res  (walk (elt x 1)))
                                     (setf file-list (append file-list (elt tmp-res 0)))
                                     (setf value-after-total (+ value-after-total (elt tmp-res 1)))))
                                finally (return (list file-list value-after-total)))))

 

;;dir-detail也是接口函数,当然他也被walk调用

;;通过正则将当前目录ls命令的输出转换成((*(filename filepath&name size flag)) size)的链表形式,*代表多个

(defun dir-detail (path-name)
  (let ((res-ls-al (inner-os-ls-al path-name))
        (ret-table (make-hash-table))
        (res nil)
        (value-after-total nil)
        (file-list nil))
    ;strip the / at the tail of path-name
    (if  (not (string= path-name ""))
         (if (eq (elt path-name (- (length path-name) 1)) #\/)
             (if (string= path-name "/") (setf path-name "") (setf path-name (subseq path-name 0 (length path-name) 2)))))
    (loop for x in  res-ls-al
       do (multiple-value-bind
                 (tmp-string ppcre-res)
               (scan-to-strings "total\\s+(\\d+)" x)
             (if (not (eq nil ppcre-res))
                                        ;this line is  'total XXX', convert XXX to value-after-total
                 (setf value-after-total (parse-integer (elt ppcre-res 0)))
                                        ;the below is the files
                                        ;drwxr-xr-x  4 root root 4096 Jul  9  2011 .
                                        ;drwxr-xr-x 18 root root 4096 Jul  9  2011 ..
                                        ;drwxr-xr-x  2 root ftp  4096 May 28  2011 ftp
                                        ;-rw-r--r--  1 root root    0 May  3  2011 .keep
                                        ;drwxr-xr-x 18 wyao root 4096 Feb 19 17:32 wyao
                 (multiple-value-bind
                       (tmp-string ppcre-res)
                     (scan-to-strings "(\\S+)\\s+(\\d+)\\s+(\\S+)\\s+(\\S+)\\s+(\\d+)\\s+(\\S+)\\s+(\\d+)\\s+(\\S+)\\s+(\\S+)" x)
                   (if (not (eq nil ppcre-res))
                       (if (or (string= "." (elt ppcre-res 8)) (string= ".." (elt ppcre-res 8)))
                           nil
                           (setf file-list (cons (list
                                                  (elt ppcre-res 8)    ;name
                                                  (concatenate 'string  path-name "/" (elt ppcre-res 8) )  ;path + name
                                                  (parse-integer (elt ppcre-res 4)) ; size
                                                  (elt ppcre-res 0))  ;flag
                                                 file-list)))))
            ))
         finally (return (list file-list value-after-total))
    )))

 

;;inner-os-ls-al 是内部函数

;;用于执行/bin/ls -al这个系统调用,以获得某个目录的文件情况

(defun inner-os-ls-al (path-name)
  (let ((p (sb-ext:process-output (sb-ext:run-program "/bin/ls" (list "-al" (eval_r(string path-name))) :output :stream)))
        (file-list nil))
    (loop for line = (read-line p nil)
       while (> (length line) 0) do (setf file-list (cons line file-list))
         finally (return file-list))))

来自 “ ITPUB博客 ” ,链接:http://blog.itpub.net/133735/viewspace-721746/,如需转载,请注明出处,否则将追究法律责任。

上一篇: 正则表达工具
下一篇: lisp 代码示例
请登录后发表评论 登录
全部评论
oracle MySQL Postgresql 专职数据库dba。 系统架构师。 mysql 官方认知dba 。 15年专职dba 经验。

注册时间:2010-12-02

  • 博文量
    248
  • 访问量
    1472889