source: trunk/source/cocoa-ide/ide-self-update.lisp @ 9540

Last change on this file since 9540 was 9540, checked in by mikel, 11 years ago

added more infrastructure for svn self-update, including some sequence utilities

File size: 3.8 KB
Line 
1;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: cl-user -*-
2;;;; ***********************************************************************
3;;;; FILE IDENTIFICATION
4;;;;
5;;;; Name:          svn-self.lisp
6;;;; Version:       0.1
7;;;; Project:       Cocoa IDE
8;;;; Purpose:       Cocoa UI for updating the Cocoa IDE from the source repo
9;;;;
10;;;; ***********************************************************************
11
12(in-package :ccl)
13
14;;; IDE: decide how and whether to handle cvs self-updates.
15;;; see the cvs/svn code in update-ccl in compile-ccl.lisp
16
17;;; use GUI::FIND-CCL-DIRECTORY to find the effective CCL directory
18;;; (it gracefully handles the case where we are running from an
19;;; app bundle, as well as the case where we are not)
20
21;;; How to self-update the IDE from the svn or cvs repo
22;;; 1. Find the ccl directory that corresponds to the running image
23;;; 2. determine whether this is an svn or cvs checkout
24;;; 3. SVN:
25;;;   a. find the .svn directory
26;;;   b. run svn info to get the svn URL
27;;;   c. determine from the URL whether we need to authenticate
28;;;   d. get auth tokens if we need them
29;;;   d. record the svn revision before we start (so we can roll back
30;;;      if things go horribly wrong)
31;;;   e. run svn status to check for potential merge conflicts before starting
32;;;      the update
33;;;   f. construct the svn command:
34;;;       i. cd to the proper CCL directory
35;;;      ii. run svn update
36;;;   g. run the svn command with external-process-status.
37;;;   h.  check the status of the external command for success or failure:
38;;;      i. if okay, queue a full-rebuild, and a rebuild of the IDE
39;;;         (need to make some infrastructure for queuing these activities
40;;;         and running them on next launch, or immediately in an external process)
41;;;     ii. if not okay, warn the user, and offer to roll back to the
42;;;         previously-recorded version (need to make some infrastructure for
43;;;         running a rollback)
44;;; TODO: make a cvs version if needed
45
46;;; VALIDATE-SVN-DATA-PATHNAME p
47;;; ---------------------
48;;; returns TRUE if P is really an existing directory that appears to
49;;; contain valid Subversion metadata; FALSE otherwise
50
51(defun validate-svn-data-pathname (p)
52  (and (probe-file p)
53       (directoryp p)
54       (string= ".svn" (first (last (pathname-directory p))))
55       ;; if we reached this point, it's an existing directory
56       ;; named ".svn". now, does it have Subversion metadata files
57       ;; in it?
58       (let ((subversion-metafiles '("dir-prop-base" "entries" "format"
59                                     "prop-base/" "props/" "text-base/")))
60         (every (lambda (f) (probe-file (merge-pathnames f p))) 
61                subversion-metafiles))))
62
63;;; given a valid-looking .svn directory, we should be able to use
64;;; the svn executable to get the repository URL. we call:
65;;;  svn info
66;;; and get a big block of info text. one line of the output
67;;; is of the form:
68;;;  URL: yatta-yatta
69;;; where yatta-yatta is the repository URL of the checked out directory
70;;; Another piece of information we want shows Up here, too: the
71;;; current revision, on a line of the form:
72;;; Revision: foobar
73
74(defun split-svn-info-line (line)
75  (let* ((split-sequence ": ")
76         (split-index (find-matching-subsequence split-sequence line :test #'char=))
77         (prefix (subseq line 0 split-index))
78         (suffix (subseq line (if split-index
79                                  (+ split-index (length split-sequence))
80                                  (length line)))))
81    (list prefix suffix)))
82
83(defun parse-svn-info (info-string)
84  (let ((info-lines (split-lines info-string)))
85    (mapcar #'split-svn-info-line info-lines)))
86
87(defun get-svn-info (p)
88  (parse-svn-info
89   (with-output-to-string (out)
90     (run-program "svn" `("info" ,(namestring p)) :output out))))
Note: See TracBrowser for help on using the repository browser.