| 1 | Index: darwinports.tcl |
|---|
| 2 | =================================================================== |
|---|
| 3 | RCS file: /Volumes/src/cvs/od/proj/darwinports/base/src/darwinports1.0/darwinports.tcl,v |
|---|
| 4 | retrieving revision 1.195 |
|---|
| 5 | diff -r1.195 darwinports.tcl |
|---|
| 6 | 49a50,51 |
|---|
| 7 | > |
|---|
| 8 | > array set portindex_cache [list] |
|---|
| 9 | 1093c1095,1167 |
|---|
| 10 | < proc dportsearch {pattern {case_sensitive yes} {matchstyle regexp} {field name}} { |
|---|
| 11 | --- |
|---|
| 12 | > |
|---|
| 13 | > proc _load_portindex_cache {} { |
|---|
| 14 | > global darwinports::portindex_cache darwinports::sources |
|---|
| 15 | > |
|---|
| 16 | > # if we've already loaded the portindex files, we don't need to run again |
|---|
| 17 | > if {[array size darwinports::portindex_cache] != 0} { |
|---|
| 18 | > return |
|---|
| 19 | > } |
|---|
| 20 | > |
|---|
| 21 | > set found 0 |
|---|
| 22 | > foreach source $sources { |
|---|
| 23 | > # if we have a remote source, don't cache |
|---|
| 24 | > if {[darwinports::getprotocol $source] == "dports"} { |
|---|
| 25 | > continue |
|---|
| 26 | > } |
|---|
| 27 | > |
|---|
| 28 | > ui_debug "Caching $source" |
|---|
| 29 | > |
|---|
| 30 | > if {[catch {set fd [open [darwinports::getindex $source] r]} result]} { |
|---|
| 31 | > ui_warn "Can't open index file for source: $source" |
|---|
| 32 | > continue |
|---|
| 33 | > } |
|---|
| 34 | > |
|---|
| 35 | > incr found 1 |
|---|
| 36 | > |
|---|
| 37 | > switch -regexp -- [darwinports::getprotocol ${source}] { |
|---|
| 38 | > {^rsync$} { |
|---|
| 39 | > # Rsync files are local |
|---|
| 40 | > set source_url "file://[darwinports::getsourcepath $source]" |
|---|
| 41 | > } |
|---|
| 42 | > default { |
|---|
| 43 | > set source_url $source |
|---|
| 44 | > } |
|---|
| 45 | > } |
|---|
| 46 | > |
|---|
| 47 | > while {[gets $fd line] >= 0} { |
|---|
| 48 | > set name [lindex $line 0] |
|---|
| 49 | > gets $fd line |
|---|
| 50 | > |
|---|
| 51 | > array set portinfo $line |
|---|
| 52 | > |
|---|
| 53 | > if {[info exists portinfo(portarchive)]} { |
|---|
| 54 | > set porturl ${source_url}/$portinfo(portarchive) |
|---|
| 55 | > } elseif {[info exists portinfo(portdir)]} { |
|---|
| 56 | > set porturl ${source_url}/$portinfo(portdir) |
|---|
| 57 | > } |
|---|
| 58 | > if {[info exists porturl]} { |
|---|
| 59 | > lappend line porturl $porturl |
|---|
| 60 | > } |
|---|
| 61 | > |
|---|
| 62 | > set name [string tolower $name] |
|---|
| 63 | > |
|---|
| 64 | > # if there's a name collision, print out a warning |
|---|
| 65 | > # however, since the earlier portindex files have precident over |
|---|
| 66 | > # the later, don't overwrite |
|---|
| 67 | > if {[info exists darwinports::portindex_cache($name)]} { |
|---|
| 68 | > ui_debug "key collision in portindex cache: $name" |
|---|
| 69 | > } else { |
|---|
| 70 | > set darwinports::portindex_cache($name) $line |
|---|
| 71 | > } |
|---|
| 72 | > } |
|---|
| 73 | > close $fd |
|---|
| 74 | > } |
|---|
| 75 | > |
|---|
| 76 | > if {!$found} { |
|---|
| 77 | > return -code error "No index(es) found! Have you synced your source indexes?" |
|---|
| 78 | > } |
|---|
| 79 | > |
|---|
| 80 | > return |
|---|
| 81 | > } |
|---|
| 82 | > |
|---|
| 83 | > # look up ports via all of the remote sources |
|---|
| 84 | > proc dportsearch_remote {pattern} { |
|---|
| 85 | 1096d1169 |
|---|
| 86 | < set easy [expr { $field == "name" }] |
|---|
| 87 | 1098d1170 |
|---|
| 88 | < set found 0 |
|---|
| 89 | 1104,1106c1176,1217 |
|---|
| 90 | < } else { |
|---|
| 91 | < if {[catch {set fd [open [darwinports::getindex $source] r]} result]} { |
|---|
| 92 | < ui_warn "Can't open index file for source: $source" |
|---|
| 93 | --- |
|---|
| 94 | > } |
|---|
| 95 | > } |
|---|
| 96 | > |
|---|
| 97 | > return $matches |
|---|
| 98 | > } |
|---|
| 99 | > |
|---|
| 100 | > # match ports with case sensitivity on field name |
|---|
| 101 | > proc dportsearch_exact_lower {name} { |
|---|
| 102 | > global darwinports::portindex_cache |
|---|
| 103 | > |
|---|
| 104 | > # load all the portindex caches |
|---|
| 105 | > _load_portindex_cache |
|---|
| 106 | > |
|---|
| 107 | > set name [string tolower $name] |
|---|
| 108 | > |
|---|
| 109 | > # if the port doesn't exist in the cache, return nothing |
|---|
| 110 | > if {[info exists darwinports::portindex_cache($name)]} { |
|---|
| 111 | > return [list $name $darwinports::portindex_cache($name)] |
|---|
| 112 | > } else { |
|---|
| 113 | > return [list] |
|---|
| 114 | > } |
|---|
| 115 | > } |
|---|
| 116 | > |
|---|
| 117 | > proc dportsearch {pattern {case_sensitive yes} {matchstyle regexp} {field name}} { |
|---|
| 118 | > global darwinports::portdbpath darwinports::sources darwinports::portindex_cache |
|---|
| 119 | > |
|---|
| 120 | > set matches [dportsearch_remote $pattern] |
|---|
| 121 | > |
|---|
| 122 | > # load all the portindex caches |
|---|
| 123 | > set x [_load_portindex_cache] |
|---|
| 124 | > |
|---|
| 125 | > if {$field == "name" && $case_sensitive == "no" && $matchstyle == "exact"} { |
|---|
| 126 | > # have an optimized path if we can lookup the name exactly |
|---|
| 127 | > set matches [concat $matches [dportsearch_exact_lower $pattern]] |
|---|
| 128 | > } else { |
|---|
| 129 | > # do an expensive search to match against other fields or without case sensitivity |
|---|
| 130 | > set easy [expr { $field == "name" }] |
|---|
| 131 | > |
|---|
| 132 | > # step through each item in the cache |
|---|
| 133 | > foreach {name line} [array get darwinports::portindex_cache] { |
|---|
| 134 | > if {$easy} { |
|---|
| 135 | > set target $name |
|---|
| 136 | 1108,1119c1219,1222 |
|---|
| 137 | < incr found 1 |
|---|
| 138 | < while {[gets $fd line] >= 0} { |
|---|
| 139 | < set name [lindex $line 0] |
|---|
| 140 | < gets $fd line |
|---|
| 141 | < |
|---|
| 142 | < if {$easy} { |
|---|
| 143 | < set target $name |
|---|
| 144 | < } else { |
|---|
| 145 | < array set portinfo $line |
|---|
| 146 | < if {![info exists portinfo($field)]} continue |
|---|
| 147 | < set target $portinfo($field) |
|---|
| 148 | < } |
|---|
| 149 | --- |
|---|
| 150 | > array set portinfo $line |
|---|
| 151 | > if {![info exists portinfo($field)]} continue |
|---|
| 152 | > set target $portinfo($field) |
|---|
| 153 | > } |
|---|
| 154 | 1121,1126c1224,1229 |
|---|
| 155 | < switch $matchstyle { |
|---|
| 156 | < exact { set matchres [expr 0 == ( {$case_sensitive == "yes"} ? [string compare $pattern $target] : [string compare -nocase $pattern $target] )] } |
|---|
| 157 | < glob { set matchres [expr {$case_sensitive == "yes"} ? [string match $pattern $target] : [string match -nocase $pattern $target]] } |
|---|
| 158 | < regexp - |
|---|
| 159 | < default { set matchres [expr {$case_sensitive == "yes"} ? [regexp -- $pattern $target] : [regexp -nocase -- $pattern $target]] } |
|---|
| 160 | < } |
|---|
| 161 | --- |
|---|
| 162 | > switch $matchstyle { |
|---|
| 163 | > exact { set matchres [expr 0 == ( {$case_sensitive == "yes"} ? [string compare $pattern $target] : [string compare -nocase $pattern $target] )] } |
|---|
| 164 | > glob { set matchres [expr {$case_sensitive == "yes"} ? [string match $pattern $target] : [string match -nocase $pattern $target]] } |
|---|
| 165 | > regexp - |
|---|
| 166 | > default { set matchres [expr {$case_sensitive == "yes"} ? [regexp -- $pattern $target] : [regexp -nocase -- $pattern $target]] } |
|---|
| 167 | > } |
|---|
| 168 | 1128,1154c1231,1233 |
|---|
| 169 | < if {$matchres == 1} { |
|---|
| 170 | < if {$easy} { |
|---|
| 171 | < array set portinfo $line |
|---|
| 172 | < } |
|---|
| 173 | < switch -regexp -- [darwinports::getprotocol ${source}] { |
|---|
| 174 | < {^rsync$} { |
|---|
| 175 | < # Rsync files are local |
|---|
| 176 | < set source_url "file://[darwinports::getsourcepath $source]" |
|---|
| 177 | < } |
|---|
| 178 | < default { |
|---|
| 179 | < set source_url $source |
|---|
| 180 | < } |
|---|
| 181 | < } |
|---|
| 182 | < if {[info exists portinfo(portarchive)]} { |
|---|
| 183 | < set porturl ${source_url}/$portinfo(portarchive) |
|---|
| 184 | < } elseif {[info exists portinfo(portdir)]} { |
|---|
| 185 | < set porturl ${source_url}/$portinfo(portdir) |
|---|
| 186 | < } |
|---|
| 187 | < if {[info exists porturl]} { |
|---|
| 188 | < lappend line porturl $porturl |
|---|
| 189 | < ui_debug "Found port in $porturl" |
|---|
| 190 | < } else { |
|---|
| 191 | < ui_debug "Found port info: $line" |
|---|
| 192 | < } |
|---|
| 193 | < lappend matches $name |
|---|
| 194 | < lappend matches $line |
|---|
| 195 | < } |
|---|
| 196 | --- |
|---|
| 197 | > if {$matchres == 1} { |
|---|
| 198 | > if {$easy} { |
|---|
| 199 | > array set portinfo $line |
|---|
| 200 | 1156c1235,1241 |
|---|
| 201 | < close $fd |
|---|
| 202 | --- |
|---|
| 203 | > if {[info exists porturl]} { |
|---|
| 204 | > ui_debug "Found port in $porturl" |
|---|
| 205 | > } else { |
|---|
| 206 | > ui_debug "Found port info: $line" |
|---|
| 207 | > } |
|---|
| 208 | > lappend matches $name |
|---|
| 209 | > lappend matches $line |
|---|
| 210 | 1159,1161d1243 |
|---|
| 211 | < } |
|---|
| 212 | < if {!$found} { |
|---|
| 213 | < return -code error "No index(es) found! Have you synced your source indexes?" |
|---|
