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))) |
- | + | ||
- | + | ||
(defun get-file-info (f) | (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))) | (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))) |
- | + | (make-instance 'fi-info :univ n :name f :day day :month month :year year))) | |
- | (make-instance 'fi-info :univ n | + | |
- | ( | + | (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) | ||
- | " | + | "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.