Ticket #685: bigpatch-landonf

Index: src/darwinports1.0/darwinports.tcl
===================================================================
RCS file: /Volumes/src/cvs/od/proj/darwinports/base/src/darwinports1.0/darwinports.tcl,v
retrieving revision 1.96
diff -u -r1.96 darwinports.tcl
--- src/darwinports1.0/darwinports.tcl  14 Aug 2003 02:11:04 -0000      1.96
+++ src/darwinports1.0/darwinports.tcl  19 Aug 2003 00:24:13 -0000
@@ -140,6 +140,11 @@
        return -code error "$portdbpath is not a directory. Please create the directory $portdbpath and try again"
     }
 
+    set darwinports::registry.path [file join $portdbpath receipts]
+    if {![file isdirectory ${darwinports::registry.path}]} {
+       return -code error "${darwinports::registry.path} is not a directory."
+    }
+
     set portsharepath ${prefix}/share/darwinports
     if {![file isdirectory $portsharepath]} {
        return -code error "Data files directory '$portsharepath' must exist"
@@ -177,10 +182,6 @@
     $workername alias ui_event darwinports::ui_event $workername
 
        # xxx: find a better home for this registry cruft--like six feet under.
-       global darwinports::portdbpath darwinports::registry.path
-       if {[info exists darwinports::portdbpath] && ![info exists darwinports::registry.path]} {
-               set darwinports::registry.path [file join ${darwinports::portdbpath} receipts]
-       }
        $workername alias registry_new dportregistry::new $workername
        $workername alias registry_store dportregistry::store
        $workername alias registry_delete dportregistry::delete
@@ -246,7 +247,7 @@
 proc darwinports::getportdir {url} {
     if {[regexp {(?x)([^:]+)://(.+)} $url match protocol string] == 1} {
         switch -regexp -- ${protocol} {
-            {^file$} { return $string}
+            {^file$} { return $string }
            {http|ftp} { return [darwinports::fetch_port $url] }
             default { return -code error "Unsupported protocol $protocol" }
         }
@@ -752,5 +753,24 @@
        dportregistry::fileinfo_for_entry rval $dir $file
     }
     return $rval
+}
+
+proc dportregistry::listinstalled {} {
+    global darwinports::registry.path
+
+    set receiptglob [glob -nocomplain ${darwinports::registry.path}/*]
+
+    if {$receiptglob == ""} {
+        puts "No ports installed."
+    } else {
+        puts "The following ports are installed:"
+        foreach receipt $receiptglob {
+            if {[file extension $receipt] == ".bz2"} {
+                puts "\t[file rootname [file tail $receipt]]"
+            } else {
+                puts "\t[file tail $receipt]"
+            }
+        }
+    }
 }
 
Index: src/port/port.1
===================================================================
RCS file: /Volumes/src/cvs/od/proj/darwinports/base/src/port/port.1,v
retrieving revision 1.17
diff -u -r1.17 port.1
--- src/port/port.1     13 Aug 2003 08:52:11 -0000      1.17
+++ src/port/port.1     19 Aug 2003 00:24:14 -0000
@@ -139,7 +139,19 @@
 .Pp
 To list the files (table of contents) installed by a given port (in this case apr):
 .Pp
-.Dl "port toc apr"
+.Dl "port contents apr"
+.Pp
+To find out what dependencies a port has:
+.Pp
+.Dl "port deps exim"
+.Pp
+To find out what ports are installed:
+.Pp
+.Dl "port installed"
+.Pp
+To find out what variants a port has:
+.Pp
+.Dl "port variants php"
 .Pp
 The following demonstrates invoking
 .Nm
Index: src/port/port.tcl
===================================================================
RCS file: /Volumes/src/cvs/od/proj/darwinports/base/src/port/port.tcl,v
retrieving revision 1.44
diff -u -r1.44 port.tcl
--- src/port/port.tcl   18 Aug 2003 02:34:37 -0000      1.44
+++ src/port/port.tcl   19 Aug 2003 00:24:14 -0000
@@ -172,6 +172,121 @@
 }
 
 switch -- $action {
+    deps {
+        set nodeps true
+
+        # make sure a port was given on the command line
+        if {![info exists portname]} {
+           return -code error "You must specify a port"
+        }
+
+        # search for port
+        if {[catch {dportsearch ^$portname$} result]} {
+           return -code error "port search failed: $result"
+        }
+
+        if {$result == ""} {
+            return -code error "No port $portname found."
+        }
+
+        array set portinfo [lindex $result 1]
+
+        # find build dependencies
+        if {[info exists portinfo(depends_build)]} {
+            puts "$portname has build dependencies on:"
+            foreach i $portinfo(depends_build) {
+                puts "\t[lindex [split [lindex $i 0] :] 2]"
+            }
+            set nodeps false
+        }
+
+        # find library dependencies
+        if {[info exists portinfo(depends_lib)]} {
+            puts "$portname has library dependencies on:"
+            foreach i $portinfo(depends_lib) {
+                puts "\t[lindex [split [lindex $i 0] :] 2]"
+            }
+            set nodeps false
+        }
+
+        # find runtime dependencies
+        if {[info exists portinfo(depends_run)]} {
+            puts "$portname has runtime dependencies on:"
+            foreach i $portinfo(depends_run) {
+                puts "\t[lindex [split [lindex $i 0] :] 2]"
+            }
+            set nodeps false
+        }
+
+        # no dependencies found
+        if {$nodeps == "true"} {
+            puts "$portname has no dependencies"
+        }
+    }
+    installed {
+        if {[catch {dportregistry::listinstalled} result]} {
+            return -code error "Port failed: $result"
+        }
+    }
+    variants {
+        # make sure a port was given on the command line
+        if {![info exists portname]} {
+           return -code error "You must specify a port"
+        }
+
+        # search for port
+        if {[catch {dportsearch ^$portname$} result]} {
+           return -code error "port search failed: $result"
+        }
+
+        if {$result == ""} {
+            return -code error "No port $portname found."
+        }
+
+        array set portinfo [lindex $result 1]
+
+        # if this fails the port doesn't have any variants
+        if {![info exists portinfo(variants)]} {
+            puts "$portname has no variants"
+        } else {
+        # print out all the variants
+            for {set i 0} {$i < [llength $portinfo(variants)]} {incr i} {
+                puts "[lindex $portinfo(variants) $i]"
+            }
+        }
+    }
+    contents {
+        set rfile [dportregistry::exists $portname]
+        if {$rfile != ""} {
+            if {[file extension $rfile] == ".bz2"} {
+                set shortname [file rootname [file tail $rfile]]
+                set fd [open "|bzcat -q $rfile" r]
+            } else {
+                set shortname [file tail $rfile]
+                set fd [open $rfile r]
+            }
+            set entry [read $fd]
+            # kind of a corner case but I ran into it testing
+            if {[catch {close $fd} result]} {
+                return -code error "Port failed: $rfile may be corrupted"
+            }
+
+            # look for a contents list
+            set ix [lsearch $entry contents]
+            if {$ix >= 0} {
+                set contents [lindex $entry [incr ix]]
+                set uninst_err 0
+                puts "Contents of $shortname"
+                foreach f $contents {
+                    puts "\t[lindex $f 0]"
+                }
+            } else {
+                return -code error "No contents list for $shortname"
+            }
+        } else {
+            return -code error "Contents listing failed - no registry entry"
+        }
+    }
     search {
        if {![info exists portname]} {
            puts "You must specify a search pattern"
Index: src/port1.0/Makefile
===================================================================
RCS file: /Volumes/src/cvs/od/proj/darwinports/base/src/port1.0/Makefile,v
retrieving revision 1.35
diff -u -r1.35 Makefile
--- src/port1.0/Makefile        17 Aug 2003 02:20:55 -0000      1.35
+++ src/port1.0/Makefile        19 Aug 2003 00:24:14 -0000
@@ -2,10 +2,9 @@
 
 SRCS= port.tcl portchecksum.tcl portconfigure.tcl portextract.tcl          \
        portfetch.tcl portmain.tcl portbuild.tcl portpatch.tcl portutil.tcl \
-       portinstall.tcl portdepends.tcl portdestroot.tcl                    \
-       portinstall.tcl portuninstall.tcl                                   \
-       portdepends.tcl portclean.tcl portpackage.tcl portcontents.tcl      \
-       porttest.tcl portmpkg.tcl portrpmpackage.tcl
+       portinstall.tcl portdepends.tcl portdestroot.tcl portuninstall.tcl  \
+        portclean.tcl portpackage.tcl porttest.tcl portmpkg.tcl             \
+        portrpmpackage.tcl
 
 SUBDIR=                resources
 
Index: src/port1.0/port.tcl
===================================================================
RCS file: /Volumes/src/cvs/od/proj/darwinports/base/src/port1.0/port.tcl,v
retrieving revision 1.23
diff -u -r1.23 port.tcl
--- src/port1.0/port.tcl        17 Aug 2003 02:20:55 -0000      1.23
+++ src/port1.0/port.tcl        19 Aug 2003 00:24:15 -0000
@@ -45,6 +45,5 @@
 package require portclean 1.0
 package require portpackage 1.0
 package require portrpmpackage 1.0
-package require portcontents 1.0
 package require portmpkg 1.0
 package require porttest 1.0