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 à 08:34 (modifier)
1001nuits (Discuter | Contributions)
m
← Différence précédente
Version du 20 août 2010 à 09:11 (modifier) (défaire)
1001nuits (Discuter | Contributions)
m (Comments)
Différence suivante →
Ligne 114 : Ligne 114 :
(progn (progn
(setf changeofday t) (setf tday tempday)))) (setf changeofday t) (setf tday tempday))))
- (if changeofyear (format strea "<hr><h1>Year ~d</h1>~%"+ (if changeofyear (format strea "<hr>== Comments ==
- (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>")))+
- +
-(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)+
- +
-</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.
Ligne 161 : Ligne 124 :
;; Loaded file champ.lisp ;; Loaded file champ.lisp
T T
-[2]> (main) +[2]> (timeline-explorer:main "/home/foo/temp/output.html" "/home/foo/Documents" "/home/bar/Things")
-Timeline Explorer usage:+7637 records treated in 4 seconds
- >(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... Sorting done. Writing output to file...
Output written Output written
-Total time: 6 seconds+Total time: 8 seconds
T T
 +[3]>
</pre> </pre>

Version du 20 août 2010 à 09:11

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.1
; 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* (vector "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* ((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))
    (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)
    "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 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>== Comments ==

Tested on [http://clisp.cons.org CLISP]. This is important because wild cards for directories are implementation specific.

Usage:
<pre>
[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.