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.