github/melpa
1
0
Fork 0
mirror of https://github.com/correl/melpa.git synced 2024-11-15 03:00:14 +00:00
Code Issues Projects Releases Packages Wiki Activity

Extract looping logic used to find most recent svn timestamp (see #79)

Browse source
This commit is contained in:
Steve Purcell 2012-04-20 16:48:30 +01:00
parent 142e1a2506
commit 6e25a6da87
1 changed files with 28 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

41
package-build.el
View file

@ -71,13 +71,34 @@
;;; Internal functions ;;; Internal functions
(defun pb/find-parse-time (regex &optional bound) (defun pb/parse-time (str)
"Find REGEX in current buffer and format as a proper time version." "Parse STR as a time, and format as a YYYYMMDD string."
(format-time-string (format-time-string
"%Y%m%d" "%Y%m%d"
(date-to-time (date-to-time
(print (progn (re-search-backward regex bound) (print (substring-no-properties str)))))
(match-string-no-properties 1))))))
(defun pb/string-match-all (regex str &optional group)
"Find every match for `REGEX' within `STR', returning the full match string or group `GROUP'."
(let (result
(pos 0)
(group (or group 0)))
(while (string-match regex str pos)
(push (match-string group str) result)
(setq pos (match-end group)))
result))
(defun pb/find-parse-time (regex &optional bound)
"Find REGEX in current buffer and format as a proper time version, optionally looking only as far as BOUND."
(pb/parse-time (progn (re-search-backward regex bound)
(match-string-no-properties 1))))
(defun pb/find-parse-time-latest (regex &optional bound)
"Find the latest timestamp matching REGEX, optionally looking only as far as BOUND."
(let* ((text (buffer-substring-no-properties
(or bound (point-min)) (point)))
(times (mapcar 'pb/parse-time (pb/string-match-all regex text 1))))
(car (nreverse (sort times 'string<)))))
(defun pb/run-process (dir prog &rest args) (defun pb/run-process (dir prog &rest args)
"In DIR (or `default-directory' if unset) run command PROG with ARGS. "In DIR (or `default-directory' if unset) run command PROG with ARGS.
@ -188,8 +209,7 @@ seconds; the server cuts off after 10 requests in 20 seconds.")
"Check package NAME with config CONFIG out of svn into DIR." "Check package NAME with config CONFIG out of svn into DIR."
(with-current-buffer (get-buffer-create "*package-build-checkout*") (with-current-buffer (get-buffer-create "*package-build-checkout*")
(let ((repo (pb/trim (plist-get config :url) ?/)) (let ((repo (pb/trim (plist-get config :url) ?/))
(bound (goto-char (point-max))) (bound (goto-char (point-max))))
timestamps ts)
(cond (cond
((and (file-exists-p (expand-file-name ".svn" dir)) ((and (file-exists-p (expand-file-name ".svn" dir))
(string-equal (pb/svn-repo dir) repo)) (string-equal (pb/svn-repo dir) repo))
@ -201,13 +221,8 @@ seconds; the server cuts off after 10 requests in 20 seconds.")
(print "cloning repository") (print "cloning repository")
(pb/run-process nil "svn" "checkout" repo dir))) (pb/run-process nil "svn" "checkout" repo dir)))
(apply 'pb/run-process dir "svn" "info" (pb/expand-file-list dir config)) (apply 'pb/run-process dir "svn" "info" (pb/expand-file-list dir config))
(while (setq ts (ignore-errors (or (pb/find-parse-time-latest "Last Changed Date: \\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [0-9]\\{2\\}:[0-9]\\{2\\}:[0-9]\\{2\\}\\)" bound)
(pb/find-parse-time (error "No valid timestamps found!")))))
"Last Changed Date: \\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [0-9]\\{2\\}:[0-9]\\{2\\}:[0-9]\\{2\\}\\)" bound)))
(add-to-list 'timestamps ts))
(unless timestamps
(error "No valid timestamps found!"))
(car (reverse (sort timestamps 'string<))))))
(defun pb/git-repo (dir) (defun pb/git-repo (dir)
"Get the current git repo for DIR." "Get the current git repo for DIR."