From 56e74bf7e13c20675f7745cf03e144564e46c57c Mon Sep 17 00:00:00 2001
From: Jacob Matthews <jacobm@cs.uchicago.edu>
Date: Fri, 14 Sep 2007 20:26:47 +0000
Subject: [PATCH] * Added an unpack w/o installation option to the command-line
 tool * Misc. fixes

svn: r7337
---
 collects/planet/doc.txt     | 15 ++++++++++++---
 collects/planet/planet.ss   | 10 ++++++++++
 collects/planet/resolver.ss |  6 +++---
 collects/planet/util.ss     | 10 ++++++++--
 4 files changed, 33 insertions(+), 8 deletions(-)

diff --git a/collects/planet/doc.txt b/collects/planet/doc.txt
index be42918594..81373b7b46 100644
--- a/collects/planet/doc.txt
+++ b/collects/planet/doc.txt
@@ -20,14 +20,13 @@ The structure of user PLaneT invocations is listed below.
 
 PLANET-REQUEST ::= (planet FILE-NAME PKG-SPEC [PATH ...]) 
 FILE-NAME      ::= string
-PKG-SPEC       ::= (FILE-PATH ... PKG-NAME) | (FILE-PATH ... PKG-NAME VER-SPEC)
-VER-SPEC       ::= Nat | (Nat MINOR) 
+PKG-SPEC       ::= (OWNER-NAME PKG-NAME) | (OWNER PKG-NAME . VER-SPEC)
+VER-SPEC       ::= (Nat) | (Nat MINOR) 
 MINOR          ::= Nat       ; the specified revision or above
                  | (Nat Nat) ; a revision between the two specified numbers (inclusive)
                  | (= Nat)   ; exactly the revision specified
                  | (+ Nat)   ; the specified revision or above
                  | (- Nat)   ; the specified revision or below
-FILE-PATH      ::= string    ; the path to the given package in the repository
 PKG-NAME       ::= string
 OWNER-NAME     ::= string
 PATH           ::= string    ; the subdirectory path to the specified file within the package
@@ -167,6 +166,11 @@ files in the given directory and returns that file's name.  If the
 optional filename argument is provided, that filename will be used as
 the output file's name.
 
+> (unpack-planet-archive filename pathname) -> void
+
+Unpacks the PLaneT archive with the given filename, placing its contents
+into the given directory (creating that path if necessary).
+
 > (remove-pkg owner name major-version minor-version) -> void
 
 Removes the specified package from the local planet cache. Owner and
@@ -317,6 +321,11 @@ of what development links are.)
 
 Remove any development links from the given package specifier.
 
+--unpack <plt-file> <path>
+
+Unpack the given PLaneT archive into the given path, which is 
+created if necessary.
+
 
 _Development links_
 -------------------
diff --git a/collects/planet/planet.ss b/collects/planet/planet.ss
index c0f0fe2db3..cb73dae7a7 100644
--- a/collects/planet/planet.ss
+++ b/collects/planet/planet.ss
@@ -105,6 +105,11 @@ PLANNED FEATURES:
        owner pkg maj min
        "Get a URL for the given package"
        (set! actions (cons (lambda () (get-download-url owner pkg maj min)) actions)))
+      
+      (("--unpack")
+       plt-file target
+       "Unpack the contents of the given package into the given directory without installing"
+       (set! actions (cons (lambda () (do-unpack plt-file target)) actions)))
                                        
       ;; unimplemented so far:
       #;(("-u" "--unlink")
@@ -252,6 +257,11 @@ PLANNED FEATURES:
     (let ([fps (params->full-pkg-spec ownerstr pkgstr majstr minstr)])
       (printf "~a\n" (url->string (pkg->download-url fps)))))
   
+  (define (do-unpack plt-file target)
+    (unless (file-exists? plt-file)
+      (fail (format "The specified file (~a) does not exist" plt-file))) 
+    (let ([file (normalize-path plt-file)])
+      (unpack-planet-archive file target)))
   
   ;; ------------------------------------------------------------
   ;; Utility
diff --git a/collects/planet/resolver.ss b/collects/planet/resolver.ss
index 633ad345ef..2bfaf03a25 100644
--- a/collects/planet/resolver.ss
+++ b/collects/planet/resolver.ss
@@ -265,8 +265,8 @@ an appropriate subdirectory.
                 (for-each
                  (lambda (already-loaded-pkg-record)
                    (let* ([already-loaded-pkg (car already-loaded-pkg-record)]
-                          [stx (cadr already-loaded-pkg-record)]
-                          [stx-origin-string (stx->origin-string stx)])
+                          [prior-stx (cadr already-loaded-pkg-record)]
+                          [prior-stx-origin-string (stx->origin-string prior-stx)])
                      (unless (can-be-loaded-together? pkg already-loaded-pkg)
                        (set!
                         all-violations
@@ -283,7 +283,7 @@ an appropriate subdirectory.
                            (pkg-min pkg)
                            (pkg-maj already-loaded-pkg)
                            (pkg-min already-loaded-pkg)
-                           stx-origin-string)
+                           prior-stx-origin-string)
                           (current-continuation-marks)))
                          all-violations)))))
                  loaded-packages)])
diff --git a/collects/planet/util.ss b/collects/planet/util.ss
index 1ddab469f8..47dadd0542 100644
--- a/collects/planet/util.ss
+++ b/collects/planet/util.ss
@@ -13,7 +13,8 @@
            (lib "list.ss")
            (lib "pack.ss" "setup")
            (lib "plt-single-installer.ss" "setup")
-           (lib "getinfo.ss" "setup"))
+           (lib "getinfo.ss" "setup")
+           (lib "unpack.ss" "setup"))
 
   #| The util collection provides a number of useful functions for interacting with the PLaneT system. |#
   
@@ -22,6 +23,7 @@
    current-cache-contents
    current-linkage
    make-planet-archive
+   unpack-planet-archive
    force-package-building?
    get-installed-planet-archives
    get-hard-linked-packages
@@ -259,7 +261,11 @@
             (reverse warnings)))
          
          (normalize-path archive-name))]))
- 
+  
+  (define (unpack-planet-archive plt-file target)
+    (parameterize ([current-directory target])
+      (unpack plt-file)))
+  
   ;; check-info.ss-sanity : path (string -> void) (string -> void) (string -> void) -> void
   ;; gets all the info.ss fields that planet will use (using the info.ss file
   ;; from the current directory) and calls the announce, warn, and fail functions with strings