Ticket #685: bigpatch-posttest

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  16 Aug 2003 04:59:55 -0000
@@ -160,6 +160,11 @@
     } else {
                return -code error "Library directory '$libpath' must exist"
     }
+
+    # Moved from darwinports::worker_init
+    if {[info exists darwinports::portdbpath] && ![info exists darwinports::registry.path]} {
+        set darwinports::registry.path [file join ${darwinports::portdbpath} receipts]
+    }
 }
 
 proc darwinports::worker_init {workername portpath options variations} {
@@ -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
@@ -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 {![string length $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     16 Aug 2003 04:59:55 -0000
@@ -141,6 +141,18 @@
 .Pp
 .Dl "port toc apr"
 .Pp
+To find out what dependencies a port has:
+.Pp
+.Dl "port query-dependencies"
+.Pp
+To find out what ports are installed:
+.Pp
+.Dl "port query-installed"
+.Pp
+To find out what variants a port has:
+.Pp
+.Dl "port query-variants"
+.Pp
 The following demonstrates invoking
 .Nm
 with the "extract" target on portdir "textproc/figlet" and extract.sufx set to ".tgz":
Index: src/port/port.tcl
===================================================================
RCS file: /Volumes/src/cvs/od/proj/darwinports/base/src/port/port.tcl,v
retrieving revision 1.43
diff -u -r1.43 port.tcl
--- src/port/port.tcl   14 Aug 2003 02:11:05 -0000      1.43
+++ src/port/port.tcl   16 Aug 2003 04:59:55 -0000
@@ -172,6 +172,121 @@
 }
 
 switch -- $action {
+    query-dependencies {
+        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 {![string length $result]} {
+            return -code error "No port $portname found."
+        }
+
+        array set portinfo [lindex $result 1]
+
+        # find build dependencies
+        if {![catch {set depends_build $portinfo(depends_build)} result]} {
+            puts "$portname has build dependencies on:"
+            foreach i $depends_build {
+                puts "\t[lindex [split [lindex $i 0] :] 2]"
+            }
+            set nodeps false
+        }
+
+        # find library dependencies
+        if {![catch {set depends_lib $portinfo(depends_lib)} result]} {
+            puts "$portname has library dependencies on:"
+            foreach i $depends_lib {
+                puts "\t[lindex [split [lindex $i 0] :] 2]"
+            }
+            set nodeps false
+        }
+
+        # find runtime dependencies
+        if {![catch {set depends_run $portinfo(depends_run)} result]} {
+            puts "$portname has runtime dependencies on:"
+            foreach i $depends_run {
+                puts "\t[lindex [split [lindex $i 0] :] 2]"
+            }
+            set nodeps false
+        }
+
+        # no dependencies found
+        if {"$nodeps" == "true"} {
+            puts "$portname has no dependencies"
+        }
+    }
+    query-installed {
+        if {[catch {dportregistry::listinstalled} result]} {
+            return -code error "Port failed: $result"
+        }
+    }
+    query-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 {[catch {set portvariants $portinfo(variants)} result]} {
+            puts "$portname has no variants"
+        } else {
+        # print out all the variants
+            for {set i 0} {$i < [llength $portvariants]} {incr i} {
+                puts "[lindex $portvariants $i]"
+            }
+        }
+    }
+    toc {
+        set rfile [dportregistry::exists $portname]
+        if {[string length $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        17 Aug 2003 13:57:34 -0000
@@ -3,9 +3,8 @@
 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 portuninstall.tcl portdepends.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        17 Aug 2003 13:59:40 -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