[81260] branches/gsoc11-rev-upgrade/base/src/macports1.0/macports.tcl

[cal at macports.org]

Revision: 81260
          http://trac.macports.org/changeset/81260
Author:   cal at macports.org
Date:     2011-07-28 03:35:05 -0700 (Thu, 28 Jul 2011)
Log Message:
-----------
rev-upgrade: topologically sort broken ports

Modified Paths:
--------------
    branches/gsoc11-rev-upgrade/base/src/macports1.0/macports.tcl

Modified: branches/gsoc11-rev-upgrade/base/src/macports1.0/macports.tcl
===================================================================
--- branches/gsoc11-rev-upgrade/base/src/macports1.0/macports.tcl	2011-07-28 09:01:39 UTC (rev 81259)
+++ branches/gsoc11-rev-upgrade/base/src/macports1.0/macports.tcl	2011-07-28 10:35:05 UTC (rev 81260)
@@ -3792,6 +3792,11 @@
                     set libreturncode [lindex $libresultlist 0]
                     set libresult     [lindex $libresultlist 1]
 
+                    # if {[string first "/usr/" [$loadcommand cget -mlt_install_name]] == 0} {
+                    #     # TODO: Filter whitelist
+                    #     ui_warn "File links against /usr/*: `[$b path]' links against `[$loadcommand cget -mlt_install_name]'"
+                    # }
+
                     if {$libreturncode != $machista::SUCCESS} {
                         ui_info "Could not open `[$loadcommand cget -mlt_install_name]': [machista::strerror $libreturncode]"
                         if {$libreturncode == $machista::EFILE} {
@@ -3830,6 +3835,11 @@
         }
         machista::destroy_handle $handle
 
+        if {[llength $broken_files] == 0} {
+            ui_msg "---> No broken files found. :)"
+            return 0;
+        }
+        ui_msg "---> Found [llength $broken_files] broken file(s), matching files to ports"
         set broken_ports {}
         set broken_files [lsort -unique $broken_files]
         foreach file $broken_files {
@@ -3839,13 +3849,92 @@
             }
             lappend broken_ports $port
         }
+        set broken_ports [lsort -unique $broken_ports]
 
-        set broken_ports [lsort -unique $broken_ports]
-        ui_msg "broken ports: [llength $broken_ports]"
+        ui_msg "---> Found [llength $broken_ports] broken port(s), determining rebuild order"
+        # broken_ports are the nodes in our graph
+        # now we need adjacents
         foreach port $broken_ports {
-            ui_msg "    $port"
+            # initialize with empty list
+            set adjlist($port) {}
+            set revadjlist($port) {}
         }
+
+        array set visited {}
+        foreach port $broken_ports {
+            # stack of broken nodes we've come across
+            set stack {}
+            lappend stack $port
+
+            # build graph
+            if {![info exists visited($port)]} {
+                revupgrade_buildgraph $port stack adjlist revadjlist visited
+            }
+        }
+
+        set unsorted_ports $broken_ports
+        set topsort_ports {}
+        while {[llength $unsorted_ports] > 0} {
+            foreach port $unsorted_ports {
+                if {[llength $adjlist($port)] == 0} {
+                    # this node has no further dependencies
+                    # add it to topsorted list
+                    lappend topsort_ports $port
+                    # remove from unsorted list
+                    set index [lsearch $unsorted_ports $port]
+                    set unsorted_ports [concat [lrange $unsorted_ports 0 $index-1] [lrange $unsorted_ports $index+1 end]]
+
+                    # remove edges 
+                    foreach target $revadjlist($port) {
+                        set index [lsearch $adjlist($target) $port]
+                        set adjlist($target) [concat [lrange $adjlist($target) 0 $index-1] [lrange $adjlist($target) $index+1 end]]
+                    }
+                }
+            }
+        }
+
+        ui_msg "---> Rebuilding in order: $topsort_ports"
     }
 
     return 0;
 }
+
+proc revupgrade_buildgraph {port stackname adjlistname revadjlistname visitedname} {
+    upvar $stackname stack
+    upvar $adjlistname adjlist
+    upvar $revadjlistname revadjlist
+    upvar $visitedname visited
+
+    ui_debug "Processing port $port"
+    set dependent_ports [get_dependent_ports $port false]
+    foreach dep $dependent_ports {
+        array set deparray $dep
+        set depname $deparray(name)
+
+        if {[info exists visited($depname)]} {
+            continue
+        }
+        set visited($depname) true
+        set is_broken_port false
+
+        if {[info exists adjlist($depname)]} {
+            ui_debug "Dependency $depname is broken, adding edge from [lindex $stack 0] to $depname"
+            ui_debug "Making $depname new head of stack"
+            # $dep is one of the broken ports
+            # add an edge to the last broken port in the DFS
+            lappend adjlist([lindex $stack 0]) $depname
+            lappend revadjlist($depname) [lindex $stack 0]
+            # make this port the new last broken port by prepending it to the stack
+            set stack [linsert last_visited 0 $depname]
+            
+            set is_broken_port true
+        }
+        revupgrade_buildgraph $depname stack adjlist revadjlist visited
+        if {$is_broken_port} {
+            ui_debug "Removing $depname from stack"
+            # remove $dep from the stack
+            set stack [lrange $stack 1 end]
+        }
+    }
+}
+
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.macosforge.org/pipermail/macports-changes/attachments/20110728/e261bcc9/attachment-0001.html>