Timeline view of some directories of the hard drive (Common Lisp)

Un article de Caverne des 1001 nuits.

(Différences entre les versions)
Version du 20 août 2010 à 09:11 (modifier)
1001nuits (Discuter | Contributions)
m (Comments)
← Différence précédente
Version actuelle (20 août 2010 à 09:12) (modifier) (défaire)
1001nuits (Discuter | Contributions)
m (Code)
 
Ligne 13 : Ligne 13 :
; Copyleft 1001nuits (http://www.1001nuits.org - August 2010 ; Copyleft 1001nuits (http://www.1001nuits.org - August 2010
;======================================================================= ;=======================================================================
 +(defpackage "TIMELINE-EXPLORER"
 + (:use "COMMON-LISP")
 + (:nicknames "CHAMP")
 + (:export "MAIN"))
 +
 +(in-package timeline-explorer)
;=====================General constants ===================== ;=====================General constants =====================
Ligne 23 : Ligne 29 :
"July" "August" "September" "October" "November" "December")) "July" "August" "September" "October" "November" "December"))
 +;dictionary of fi-info instances
(defparameter *dict* nil) (defparameter *dict* nil)
Ligne 30 : Ligne 37 :
;=====================Get file info===================== ;=====================Get file info=====================
- 
- 
(defclass fi-info () (defclass fi-info ()
((fi-univ :accessor univ ((fi-univ :accessor univ
:initarg :univ) :initarg :univ)
- (fi-dire :accessor dire 
- :initarg :dire)  
(fi-name :accessor name (fi-name :accessor name
:initarg :name) :initarg :name)
Ligne 44 : Ligne 47 :
:initarg :month) :initarg :month)
(fi-day :accessor day (fi-day :accessor day
- :initarg :day)+ :initarg :day)))
- (fi-seconds :accessor seconds+
- :initarg :seconds)))+
(defun get-file-info (f) (defun get-file-info (f)
- "Gets file information and put them in a list"+ "fi-finfo construct: gets file information and put them in a fi-info object"
(let* ((n (with-open-file (s f) (file-write-date s))) (let* ((n (with-open-file (s f) (file-write-date s)))
(l (multiple-value-list (decode-universal-time n))) (l (multiple-value-list (decode-universal-time n)))
- (seconds (+ (first l) (* 60 (second l)) (* 3600 (third l)))) 
(day (fourth l)) (day (fourth l))
(month (fifth l)) (month (fifth l))
- (year (sixth l))+ (year (sixth l)))
- (dire (namestring (car (directory f)))))+ (make-instance 'fi-info :univ n :name f :day day :month month :year year)))
- (make-instance 'fi-info :univ n :dire dire :name f :seconds seconds :day day :month month :year year)))+
-(defun fi-more-recent-efficient? (a b)+(defmethod fi-more-recent? ((a fi-info) (b fi-info))
 + "fi-finfo comparison operator"
(if (> (univ a) (univ b)) t nil)) (if (> (univ a) (univ b)) t nil))
(defmethod format-link ((a fi-info)) (defmethod format-link ((a fi-info))
 + "fi-info link formatter"
(let* ((fname (concatenate 'string (pathname-name (pathname (name a))) "." (pathname-type (pathname (name a))))) (let* ((fname (concatenate 'string (pathname-name (pathname (name a))) "." (pathname-type (pathname (name a)))))
(fdir (subseq (name a) 0 (- (length (name a)) (length fname))))) (fdir (subseq (name a) 0 (- (length (name a)) (length fname)))))
Ligne 69 : Ligne 70 :
(defmethod get-time ((a fi-info)) (defmethod get-time ((a fi-info))
 + "fi-finto time formatter"
(let ((timeobj (multiple-value-list (decode-universal-time (univ a))))) (let ((timeobj (multiple-value-list (decode-universal-time (univ a)))))
(format nil "~2,'0d:~2,'0d:~2,'0d" (third timeobj) (second timeobj) (first timeobj)))) (format nil "~2,'0d:~2,'0d:~2,'0d" (third timeobj) (second timeobj) (first timeobj))))
Ligne 74 : Ligne 76 :
;===========================runfrom======================= ;===========================runfrom=======================
(defun runfrom (dir) (defun runfrom (dir)
- "The dir parameter is supposed to end with '/' because it is a folder"+ "Get files in a directory and recurse on sub directories"
(let ((files (directory (concatenate 'string dir *FILE-WC*)))) (let ((files (directory (concatenate 'string dir *FILE-WC*))))
(dolist (file files 'done-files) (dolist (file files 'done-files)
Ligne 84 : Ligne 86 :
;===========================formatting======================= ;===========================formatting=======================
(defun html-format-dict (outputfile dict) (defun html-format-dict (outputfile dict)
 + "Prints a list of fi-info instances"
(with-open-file (strea outputfile :direction :output (with-open-file (strea outputfile :direction :output
:if-exists :supersede) :if-exists :supersede)
Ligne 114 : Ligne 117 :
(progn (progn
(setf changeofday t) (setf tday tempday)))) (setf changeofday t) (setf tday tempday))))
- (if changeofyear (format strea "<hr>== Comments ==+ (if changeofyear (format strea "<hr><h1>Year ~d</h1>~%"
 + (year obj)))
 + (if changeofmonth (format strea "<hr><h2>~A ~d</h2>~%"
 + (svref *months* (- (month obj) 1))(year obj)))
 + (if changeofday (format strea "<p><font color=\"blue\"><b><i>~d ~A ~d</i></b></font></p>~%"
 + (day obj) (svref *months* (- (month obj) 1))(year obj)))
 + (format strea "<font size=\"-1\"><b>~A</b> - ~A<br></font>~%"
 + (get-time obj)(format-link obj))
 + )))
 + (format strea "</html>")))
 + 
 +;=====================main=====================
 +(defun champ-usage ()
 + "Usage function"
 + (format t "Timeline Explorer usage:~% >(load \"champ.lisp\")(timeline-explorer:main \"output.html\" \"dir1/\" [...])~%")
 + (format t "[...] can be other directories.~%Info: directories should end with '/' like '/home/user1/'")
 + (abort))
 + 
 +(defun main(outputfilename &rest others)
 + "Main entry point"
 + (if (equal others nil)
 + (champ-usage))
 + (if (not (equal (length *dict*) 0))
 + (progn (setf *dict* nil)
 + (format t "Info: memory has been cleaned up...~%")))
 + (let ( (start (get-universal-time)) )
 + (dolist (dirtemp others)
 + (if (not (stringp dirtemp))
 + (progn (format t "Invalid input parameter, string expected.~%") (champ-usage)))
 + (runfrom dirtemp))
 + (format t "~A records treated in ~A seconds~%" (length *dict*)(- (get-universal-time) start))
 + (let ((temp (sort *dict* #'fi-more-recent?)))
 + (format t "Sorting done. Writing output to file...~%")
 + (html-format-dict outputfilename temp)
 + (format t "Output written~%Total time: ~A seconds~%" (- (get-universal-time) start))))
 + t)
 + 
 +</pre>
 + 
 +== Comments ==
Tested on [http://clisp.cons.org CLISP]. This is important because wild cards for directories are implementation specific. Tested on [http://clisp.cons.org CLISP]. This is important because wild cards for directories are implementation specific.

Version actuelle

[modifier] Purpose

Having a timeline view of several folders in the hard drive.

This is my first Common Lisp program, so don't be too harsh :-)

[modifier] Code


;=============================HEADER====================================
; champ.lisp "Timeline explorer" v 1.1
; Copyleft 1001nuits (http://www.1001nuits.org - August 2010
;=======================================================================
(defpackage "TIMELINE-EXPLORER"
            (:use "COMMON-LISP")
            (:nicknames "CHAMP")
            (:export "MAIN"))

(in-package timeline-explorer)

;=====================General constants =====================
(defparameter *symbols* (list 'get-file-info 'test-get-file-info
                      'remove-singletons 'test-remove-singletons) "General symbols of the file")
(defparameter *DIR-WC* "*/" "Wild card default for directories. Could be implementation specific")
(defparameter *DIR* "/")
(defparameter *FILE-WC* "*" "Wild card default for files.")
(defparameter *months* (vector "January" "February" "March" "April" "May" "June" 
                        "July" "August" "September" "October" "November" "December"))

;dictionary of fi-info instances
(defparameter *dict* nil)

(defun doc ()
    (dolist (elt *symbols*)
        (format t "Documentation for '~A': ~A~%" elt (documentation elt 'function))))

;=====================Get file info=====================
(defclass fi-info ()
    ((fi-univ :accessor univ
              :initarg :univ)
     (fi-name :accessor name
              :initarg :name)
     (fi-year :accessor year
              :initarg :year)
     (fi-month :accessor month
               :initarg :month) 
     (fi-day :accessor day
             :initarg :day)))

(defun get-file-info (f)
    "fi-finfo construct: gets file information and put them in a fi-info object"
    (let* ((n (with-open-file (s f) (file-write-date s)))
           (l (multiple-value-list (decode-universal-time n)))
           (day (fourth l))
           (month (fifth l))
           (year (sixth l)))
        (make-instance 'fi-info :univ n :name f :day day :month month :year year)))

(defmethod fi-more-recent? ((a fi-info) (b fi-info))
    "fi-finfo comparison operator"
    (if (> (univ a) (univ b)) t nil)) 

(defmethod format-link ((a fi-info))
    "fi-info link formatter"
    (let* ((fname (concatenate 'string (pathname-name (pathname (name a))) "." (pathname-type (pathname (name a)))))
           (fdir (subseq (name a) 0 (- (length (name a)) (length fname)))))
        (format nil "<a href=\"file://~A\" target=\"new\">~A</a> - <a href=\"file://~A\" target=\"new\">Folder</a>"
            (name a) fname fdir)))
            
(defmethod get-time ((a fi-info))
    "fi-finto time formatter"
    (let ((timeobj (multiple-value-list (decode-universal-time (univ a)))))
        (format nil "~2,'0d:~2,'0d:~2,'0d" (third timeobj) (second timeobj) (first timeobj))))

;===========================runfrom=======================
(defun runfrom (dir)
    "Get files in a directory and recurse on sub directories"
    (let ((files (directory (concatenate 'string dir *FILE-WC*))))
        (dolist (file files 'done-files)
            (push (get-file-info (namestring file)) *dict*)))
    (let ((subdirs (directory (concatenate 'string dir *DIR-WC*))))
        (dolist (subdir subdirs 'done-dirs)
            (runfrom (concatenate 'string (namestring subdir) *DIR*))))) ;recurse

;===========================formatting=======================
(defun html-format-dict (outputfile dict)
    "Prints a list of fi-info instances"
    (with-open-file (strea outputfile :direction :output
                                    :if-exists :supersede)
        (format strea "<html><head><title>Timeline Explorer</title></head>~%")
        (let ((tyear 0) (tmonth 0) (tday 0))
            (dolist (obj dict 'end)
                (let ( (tempyear (year obj))
                       (tempmonth (month obj))
                       (tempday (day obj))
                       (changeofyear nil)
                       (changeofmonth nil)
                       (changeofday nil))
                    (if (equal tyear 0)
                        (progn 
                            (setf tyear tempyear) ;init loop
                            (setf changeofyear t))
                        (if (not (equal tyear tempyear))
                            (progn (setf changeofyear t) (setf tyear tempyear))))
                    (if (equal tmonth 0)
                        (progn
                            (setf tmonth tempmonth) ;init loop
                            (setf changeofmonth t))
                        (if (not (equal tmonth tempmonth))
                            (progn (setf changeofmonth t) (setf tmonth tempmonth))))
                    (if (equal tday 0)
                        (progn
                            (setf tday tempday) ;init loop
                            (setf changeofday t))
                        (if (not (equal tday tempday))
                            (progn 
                                (setf changeofday t) (setf tday tempday))))
                    (if changeofyear (format strea "<hr><h1>Year ~d</h1>~%"
                            (year obj)))
                    (if changeofmonth (format strea "<hr><h2>~A ~d</h2>~%" 
                            (svref *months* (- (month obj) 1))(year obj)))
                    (if changeofday (format strea "<p><font color=\"blue\"><b><i>~d ~A ~d</i></b></font></p>~%" 
                            (day obj) (svref *months* (- (month obj) 1))(year obj)))
                    (format strea "<font size=\"-1\"><b>~A</b> - ~A<br></font>~%" 
                        (get-time obj)(format-link obj))
                    )))
        (format strea "</html>")))

;=====================main=====================
(defun champ-usage ()
    "Usage function"
    (format t "Timeline Explorer usage:~%  >(load \"champ.lisp\")(timeline-explorer:main \"output.html\" \"dir1/\" [...])~%")
    (format t "[...] can be other directories.~%Info: directories should end with '/' like '/home/user1/'")
    (abort))

(defun main(outputfilename &rest others)
    "Main entry point"
    (if (equal others nil) 
        (champ-usage)) 
    (if (not (equal (length *dict*) 0))
        (progn (setf *dict* nil)
            (format t "Info: memory has been cleaned up...~%")))
    (let ( (start (get-universal-time)) )
        (dolist (dirtemp others)
            (if (not (stringp dirtemp))
                (progn (format t "Invalid input parameter, string expected.~%") (champ-usage)))
            (runfrom dirtemp))
        (format t "~A records treated in ~A seconds~%" (length *dict*)(- (get-universal-time) start))
        (let ((temp (sort *dict* #'fi-more-recent?)))
            (format t "Sorting done. Writing output to file...~%")
            (html-format-dict outputfilename temp)
            (format t "Output written~%Total time: ~A seconds~%" (- (get-universal-time) start))))
    t)

[modifier] Comments

Tested on CLISP. This is important because wild cards for directories are implementation specific.

Usage:

[1]> (load "champ.lisp")
;; Loading file champ.lisp ...
;; Loaded file champ.lisp
T
[2]> (timeline-explorer:main "/home/foo/temp/output.html" "/home/foo/Documents" "/home/bar/Things")
7637 records treated in 4 seconds
Sorting done. Writing output to file...
Output written
Total time: 8 seconds
T
[3]>

The program generates a very basic html page that you can bookmark in order to get it when you refresh it.