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 19 août 2010 à 23:12 (modifier) 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 précédente |
Version du 20 août 2010 à 08:34 (modifier) (défaire) 1001nuits (Discuter | Contributions) m Différence suivante → |
||
Ligne 8 : | Ligne 8 : | ||
<pre> | <pre> | ||
+ | |||
;=============================HEADER==================================== | ;=============================HEADER==================================== | ||
- | ; champ.lisp "Timeline explorer" v 1. | + | ; champ.lisp "Timeline explorer" v 1.1 |
; Copyleft 1001nuits (http://www.1001nuits.org - August 2010 | ; Copyleft 1001nuits (http://www.1001nuits.org - August 2010 | ||
;======================================================================= | ;======================================================================= | ||
Ligne 19 : | Ligne 20 : | ||
(defparameter *DIR* "/") | (defparameter *DIR* "/") | ||
(defparameter *FILE-WC* "*" "Wild card default for files.") | (defparameter *FILE-WC* "*" "Wild card default for files.") | ||
- | (defparameter *months* ( | + | (defparameter *months* (vector "January" "February" "March" "April" "May" "June" |
"July" "August" "September" "October" "November" "December")) | "July" "August" "September" "October" "November" "December")) | ||
Ligne 62 : | Ligne 63 : | ||
(defmethod format-link ((a fi-info)) | (defmethod format-link ((a fi-info)) | ||
- | (let* ( | + | (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)))) ) | + | (format nil "<a href=\"file://~A\" target=\"new\">~A</a> - <a href=\"file://~A\" target=\"new\">Folder</a>" |
- | (format | + | (name a) fname fdir))) |
- | (name a) fname fdir | + | |
- | + | ||
(defmethod get-time ((a fi-info)) | (defmethod get-time ((a fi-info)) | ||
- | (let ( | + | (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======================= | ;===========================runfrom======================= | ||
Ligne 86 : | Ligne 83 : | ||
;===========================formatting======================= | ;===========================formatting======================= | ||
- | (defun get-label (month) | ||
- | (nth (- month 1) *months*)) | ||
- | |||
(defun html-format-dict (outputfile dict) | (defun html-format-dict (outputfile dict) | ||
(with-open-file (strea outputfile :direction :output | (with-open-file (strea outputfile :direction :output | ||
Ligne 123 : | Ligne 117 : | ||
(year obj))) | (year obj))) | ||
(if changeofmonth (format strea "<hr><h2>~A ~d</h2>~%" | (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>~%" | (if changeofday (format strea "<p><font color=\"blue\"><b><i>~d ~A ~d</i></b></font></p>~%" | ||
- | (day obj) ( | + | (day obj) (svref *months* (- (month obj) 1))(year obj))) |
(format strea "<font size=\"-1\"><b>~A</b> - ~A<br></font>~%" | (format strea "<font size=\"-1\"><b>~A</b> - ~A<br></font>~%" | ||
(get-time obj)(format-link obj)) | (get-time obj)(format-link obj)) | ||
Ligne 154 : | Ligne 148 : | ||
(format t "Output written~%Total time: ~A seconds~%" (- (get-universal-time) start)))) | (format t "Output written~%Total time: ~A seconds~%" (- (get-universal-time) start)))) | ||
t) | t) | ||
+ | |||
</pre> | </pre> | ||
Version du 20 août 2010 à 08:34
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><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>"))) (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.