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

Un article de Caverne des 1001 nuits.

(Différences entre les versions)

1001nuits (Discuter | Contributions)
(Nouvelle page : == 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 :-) == Code == <pre> ;=====================...)
Différence suivante →

Version du 19 août 2010 à 23:12

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

Code

;=============================HEADER====================================
; champ.lisp "Timeline explorer" v 1.0
; Copyleft 1001nuits (http://www.1001nuits.org - August 2010
;=======================================================================

;=====================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* (list "January" "February" "March" "April" "May" "June" 
                        "July" "August" "September" "October" "November" "December"))

(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-dire :accessor dire
              :initarg :dire) 
     (fi-name :accessor name
              :initarg :name)
     (fi-year :accessor year
              :initarg :year)
     (fi-month :accessor month
               :initarg :month) 
     (fi-day :accessor day
             :initarg :day)
     (fi-seconds :accessor seconds
                 :initarg :seconds)))

(defun get-file-info (f)
    "Gets file information and put them in a list"
    (let* ((n (with-open-file (s f) (file-write-date s)))
           (l (multiple-value-list (decode-universal-time n)))
           (seconds (+ (first l) (* 60 (second l)) (* 3600 (third l))))
           (day (fourth l))
           (month (fifth l))
           (year (sixth l))
           (dire (namestring (car (directory f)))))
        (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)
    (if (> (univ a) (univ b)) t nil)) 

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

;===========================runfrom=======================
(defun runfrom (dir)
    "The dir parameter is supposed to end with '/' because it is a folder"
    (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 get-label (month)
    (nth (- month 1) *months*))

(defun html-format-dict (outputfile dict)
    (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>~%" 
                            (get-label (month obj))(year obj)))
                    (if changeofday (format strea "<p><font color=\"blue\"><b><i>~d ~A ~d</i></b></font></p>~%" 
                            (day obj) (get-label (month obj))(year obj)))
                    (format strea "<font size=\"-1\"><b>~A</b> - ~A<br></font>~%" 
                        (get-time obj)(format-link obj))
                    )))
        (format strea "</html>")))

(defun champ-usage ()
    (format t "Timeline Explorer usage:~%  >(load \"champ.lisp\")(main \"dir1/\" [...]) - ")
    (format t "[...] can be other directories.~%Constraint: directories must end with '/' like '/home/user1/'")
    (abort))

;=====================main=====================
(defun main(&rest others)
    (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-efficient?)))
            (format t "Sorting done. Writing output to file...~%")
            (html-format-dict "output.html" temp)
            (format t "Output written~%Total time: ~A seconds~%" (- (get-universal-time) start))))
    t)

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]> (main)  
Timeline Explorer usage:
  >(load "champ.lisp")(main "dir1/" [...]) - [...] can be other directories.
Constraint: directories must end with '/' like '/home/user1/'
[3]> (main "/home/toto/folder1/" "/home/titi/folder2")
10922 records treated in 3 seconds
Sorting done. Writing output to file...
Output written
Total time: 6 seconds
T

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