[26128] branches/dp2mp-move/base/src/macports1.0/macports.tcl

[source_changes at macosforge.org]

Revision: 26128
          http://trac.macosforge.org/projects/macports/changeset/26128
Author:   jmpp at macports.org
Date:     2007-06-13 02:48:38 -0700 (Wed, 13 Jun 2007)

Log Message:
-----------
Merging Eridius' r25980: Wrap dportsearch inner block in a try-finally clause to ensure PortIndex file is always closed even if an error occurs.

Modified Paths:
--------------
    branches/dp2mp-move/base/src/macports1.0/macports.tcl

Modified: branches/dp2mp-move/base/src/macports1.0/macports.tcl
===================================================================
--- branches/dp2mp-move/base/src/macports1.0/macports.tcl	2007-06-13 09:19:00 UTC (rev 26127)
+++ branches/dp2mp-move/base/src/macports1.0/macports.tcl	2007-06-13 09:48:38 UTC (rev 26128)
@@ -1295,6 +1295,7 @@
 			if {[catch {set fd [open [macports::getindex $source] r]} result]} {
 				ui_warn "Can't open index file for source: $source"
 			} else {
+			    try {
 				incr found 1
 				while {[gets $fd line] >= 0} {
 					array unset portinfo
@@ -1302,50 +1303,55 @@
 				        set len [lindex $line 1]
 				        set line [read $fd $len]
 
-					if {$easy} {
-						set target $name
-					} else {
-						array set portinfo $line
-						if {![info exists portinfo($field)]} continue
-						set target $portinfo($field)
-					}
-					
-					switch $matchstyle {
-						exact	{ set matchres [expr 0 == ( {$case_sensitive == "yes"} ? [string compare $pattern $target] : [string compare -nocase $pattern $target] )] }
-						glob	{ set matchres [expr {$case_sensitive == "yes"} ? [string match $pattern $target] : [string match -nocase $pattern $target]] }
-						regexp	-
-						default	{ set matchres [expr {$case_sensitive == "yes"} ? [regexp -- $pattern $target] : [regexp -nocase -- $pattern $target]] }
-					}
-					
-					if {$matchres == 1} {
 						if {$easy} {
+						    set target $name
+						} else {
 							array set portinfo $line
+						    if {![info exists portinfo($field)]} continue
+						    set target $portinfo($field)
 						}
-						switch -regexp -- [macports::getprotocol ${source}] {
-							{^rsync$} {
-								# Rsync files are local
-								set source_url "file://[macports::getsourcepath $source]"
-							}
-							default {
-								set source_url $source
-							}
-						}
-						if {[info exists portinfo(portarchive)]} {
-							set porturl ${source_url}/$portinfo(portarchive)
-						} elseif {[info exists portinfo(portdir)]} {
-							set porturl ${source_url}/$portinfo(portdir)
-						}
-						if {[info exists porturl]} {
-							lappend line porturl $porturl
-							ui_debug "Found port in $porturl"
-						} else {
-							ui_debug "Found port info: $line"
-						}
-						lappend matches $name
-						lappend matches $line
+
+				    switch $matchstyle {
+					exact { set matchres [expr 0 == ( {$case_sensitive == "yes"} ? [string compare $pattern $target] : [string compare -nocase $pattern $target] )] }
+					glob { set matchres [expr {$case_sensitive == "yes"} ? [string match $pattern $target] : [string match -nocase $pattern $target]] }
+					regexp -
+					default { set matchres [expr {$case_sensitive == "yes"} ? [regexp -- $pattern $target] : [regexp -nocase -- $pattern $target]] }
+				    }
+
+				    if {$matchres == 1} {
+					if {$easy} {
+					    array set portinfo $line
 					}
+					switch -regexp -- [macports::getprotocol ${source}] {
+					    {^rsync$} {
+						# Rsync files are local
+						set source_url "file://[macports::getsourcepath $source]"
+					    }
+					    default {
+						set source_url $source
+					    }
+					}
+					if {[info exists portinfo(portarchive)]} {
+					    set porturl ${source_url}/$portinfo(portarchive)
+					} elseif {[info exists portinfo(portdir)]} {
+					    set porturl ${source_url}/$portinfo(portdir)
+					}
+					if {[info exists porturl]} {
+					    lappend line porturl $porturl
+					    ui_debug "Found port in $porturl"
+					} else {
+					    ui_debug "Found port info: $line"
+					}
+					lappend matches $name
+					lappend matches $line
+				    }
 				}
+			    } catch {*} {
+				ui_warn "It looks like your PortIndex file may be corrupt."
+				throw
+			    } finally {
 				close $fd
+			    }
 			}
 		}
 	}

-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://lists.macosforge.org/pipermail/macports-changes/attachments/20070613/e238ba58/attachment.html