[52527] branches/images-and-archives/base/src

[blb at macports.org]

Revision: 52527
          http://trac.macports.org/changeset/52527
Author:   blb at macports.org
Date:     2009-06-18 01:11:48 -0700 (Thu, 18 Jun 2009)
Log Message:
-----------
Beginning of implementation for installimage command

Modified Paths:
--------------
    branches/images-and-archives/base/src/macports1.0/macports.tcl
    branches/images-and-archives/base/src/port/port.tcl

Modified: branches/images-and-archives/base/src/macports1.0/macports.tcl
===================================================================
--- branches/images-and-archives/base/src/macports1.0/macports.tcl	2009-06-18 07:54:07 UTC (rev 52526)
+++ branches/images-and-archives/base/src/macports1.0/macports.tcl	2009-06-18 08:11:48 UTC (rev 52527)
@@ -2658,9 +2658,47 @@
 }
 
 # Procedure to install an image file; protocols currently supported
-# are file:, https?:, and ftp:.
+# are file: and anything which curl supports.
 proc macports::install_image {imageurl} {
-    # Implement
+    set filetoinstall ""
+    set tmpfetchdir [mkdtemp [file join [gettmpdir] mpimagefetchXXXXXXXX]]
+    try {
+        # Handle case where just a plain local path was passed
+        if {[file exists $imageurl]} {
+            set filetoinstall $imageurl
+        } else {
+            if {[regexp {(?x)([^:]+)://(.+)} $imageurl -> protocol imagepath] != 1} {
+                throw MACPORTS "Invalid URL spec: $imageurl (should be protocol://information)"
+            } else {
+                switch -- $protocol {
+                    file {
+                        set filetoinstall $imagepath
+                    }
+                    default {
+                        set filetoinstall [file join $tmpfetchdir [file tail $imagepath]]
+                        if {[catch {curl fetch $imageurl $filetoinstall} result]} {
+                            throw MACPORTS "Fetching remote image failed: $result"
+                        }
+                    }
+                }
+            }
+        }
+
+        if {$filetoinstall == ""} {
+            throw MACPORTS "Cannot determine/fetch file to install from $imageurl"
+        }
+        if {![file exists $filetoinstall]} {
+            throw MACPORTS "The file $filetoinstall does not exist"
+        }
+        ui_info "Installing from image at $imageurl"
+        set result [install_register_imagefile $filetoinstall]
+    } catch {* errorCode errorMessage } {
+        return -code error $errorMessage
+    } finally {
+        file delete -force $tmpfetchdir
+    }
+
+    return $result
 }
 
 # Procedure to install and register an imagefile; the file itself must
@@ -2670,6 +2708,7 @@
 # the registry as installed, but not active.
 proc macports::install_register_imagefile {imagefile} {
     global env macports::portimagefilepath macports::prefix
+
     set mytempdir [mkdtemp [file join [gettmpdir] mpimageXXXXXXXX]]
     set startpwd [pwd]
     try {
@@ -2721,7 +2760,7 @@
         }
         registry::write_entry $regref
     } catch {* errorCode errorMessage } {
-        ui_error $errorMessage
+        return -code error $errorMessage
     } finally {
         cd $startpwd
         file delete -force $mytempdir

Modified: branches/images-and-archives/base/src/port/port.tcl
===================================================================
--- branches/images-and-archives/base/src/port/port.tcl	2009-06-18 07:54:07 UTC (rev 52526)
+++ branches/images-and-archives/base/src/port/port.tcl	2009-06-18 08:11:48 UTC (rev 52527)
@@ -1790,6 +1790,30 @@
 }
 
 
+proc action_installimage { action portlist opts } {
+    # portlist here is actually a list of URLs for image files
+    if {![llength $portlist]} {
+        ui_error "Please provide at least one URL for an image file to install"
+        return 1
+    }
+    foreach imageurl $portlist {
+        if {![macports::global_option_isset ports_dryrun]} {
+            if {[catch {macports::install_image $imageurl} result] || $result != 0} {
+                ui_error "Failed to install from image: $result"
+                return 1
+            } else {
+               # Need to extract information from this image (name, version, etc)
+               ui_msg "activate here"
+            }
+        } else {
+            ui_msg "Skipping install of image $imageurl (dry run)"
+        }
+    }
+
+    return 0
+}
+
+
 proc action_activate { action portlist opts } {
     set status 0
     if {[require_portlist portlist]} {
@@ -2881,6 +2905,7 @@
     info           [list action_info            [action_args_const ports]] \
     notes          [list action_notes           [action_args_const ports]] \
     provides       [list action_provides        [action_args_const strings]] \
+    installimage   [list action_installimage    [action_args_const strings]] \
     \
     activate       [list action_activate        [action_args_const ports]] \
     deactivate     [list action_deactivate      [action_args_const ports]] \
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.macosforge.org/pipermail/macports-changes/attachments/20090618/9c1561ce/attachment.html>