| 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,1096 |
|---|
| 10 | < proc dportsearch {pattern {case_sensitive yes} {matchstyle regexp} {field name}} { |
|---|
| 11 | --- |
|---|
| 12 | > |
|---|
| 13 | > proc dportsearch_old {pattern {case_sensitive yes} {matchstyle regexp} {field name}} { |
|---|
| 14 | 1161a1165,1306 |
|---|
| 15 | > } |
|---|
| 16 | > |
|---|
| 17 | > return $matches |
|---|
| 18 | > } |
|---|
| 19 | > |
|---|
| 20 | > |
|---|
| 21 | > proc _load_portindex_cache {} { |
|---|
| 22 | > global darwinports::portindex_cache darwinports::sources |
|---|
| 23 | > |
|---|
| 24 | > # if we've already loaded the portindex files, we don't need to run again |
|---|
| 25 | > if {[array size darwinports::portindex_cache] != 0} { |
|---|
| 26 | > return |
|---|
| 27 | > } |
|---|
| 28 | > |
|---|
| 29 | > set found 0 |
|---|
| 30 | > foreach source $sources { |
|---|
| 31 | > # if we have a remote source, don't cache |
|---|
| 32 | > if {[darwinports::getprotocol $source] == "dports"} { |
|---|
| 33 | > continue |
|---|
| 34 | > } |
|---|
| 35 | > |
|---|
| 36 | > ui_debug "Caching $source" |
|---|
| 37 | > |
|---|
| 38 | > if {[catch {set fd [open [darwinports::getindex $source] r]} result]} { |
|---|
| 39 | > ui_warn "Can't open index file for source: $source" |
|---|
| 40 | > continue |
|---|
| 41 | > } |
|---|
| 42 | > |
|---|
| 43 | > incr found 1 |
|---|
| 44 | > |
|---|
| 45 | > switch -regexp -- [darwinports::getprotocol ${source}] { |
|---|
| 46 | > {^rsync$} { |
|---|
| 47 | > # Rsync files are local |
|---|
| 48 | > set source_url "file://[darwinports::getsourcepath $source]" |
|---|
| 49 | > } |
|---|
| 50 | > default { |
|---|
| 51 | > set source_url $source |
|---|
| 52 | > } |
|---|
| 53 | > } |
|---|
| 54 | > |
|---|
| 55 | > while {[gets $fd line] >= 0} { |
|---|
| 56 | > set name [lindex $line 0] |
|---|
| 57 | > gets $fd line |
|---|
| 58 | > |
|---|
| 59 | > array set portinfo $line |
|---|
| 60 | > |
|---|
| 61 | > if {[info exists portinfo(portarchive)]} { |
|---|
| 62 | > set porturl ${source_url}/$portinfo(portarchive) |
|---|
| 63 | > } elseif {[info exists portinfo(portdir)]} { |
|---|
| 64 | > set porturl ${source_url}/$portinfo(portdir) |
|---|
| 65 | > } |
|---|
| 66 | > if {[info exists porturl]} { |
|---|
| 67 | > lappend line porturl $porturl |
|---|
| 68 | > } |
|---|
| 69 | > set darwinports::portindex_cache($name) $line |
|---|
| 70 | > } |
|---|
| 71 | > close $fd |
|---|
| 72 | > } |
|---|
| 73 | > |
|---|
| 74 | > if {!$found} { |
|---|
| 75 | > return -code error "No index(es) found! Have you synced your source indexes?" |
|---|
| 76 | > } |
|---|
| 77 | > |
|---|
| 78 | > return |
|---|
| 79 | > } |
|---|
| 80 | > |
|---|
| 81 | > # look up ports via all of the remote sources |
|---|
| 82 | > proc dportsearch_remote {pattern} { |
|---|
| 83 | > global darwinports::portdbpath darwinports::sources |
|---|
| 84 | > set matches [list] |
|---|
| 85 | > |
|---|
| 86 | > foreach source $sources { |
|---|
| 87 | > if {[darwinports::getprotocol $source] == "dports"} { |
|---|
| 88 | > array set attrs [list name $pattern] |
|---|
| 89 | > set res [darwinports::index::search $darwinports::portdbpath $source [array get attrs]] |
|---|
| 90 | > eval lappend matches $res |
|---|
| 91 | > } |
|---|
| 92 | > } |
|---|
| 93 | > |
|---|
| 94 | > return $matches |
|---|
| 95 | > } |
|---|
| 96 | > |
|---|
| 97 | > # match ports with case sensitivity on field name |
|---|
| 98 | > proc dportsearch_exact {name} { |
|---|
| 99 | > # load all the portindex caches |
|---|
| 100 | > set x [_load_portindex_cache] |
|---|
| 101 | > |
|---|
| 102 | > global darwinports::portindex_cache |
|---|
| 103 | > |
|---|
| 104 | > # if the port doesn't exist in the cache, return nothing |
|---|
| 105 | > if {[info exists darwinports::portindex_cache($name)]} { |
|---|
| 106 | > return [list $name $darwinports::portindex_cache($name)] |
|---|
| 107 | > } else { |
|---|
| 108 | > return [list] |
|---|
| 109 | > } |
|---|
| 110 | > } |
|---|
| 111 | > |
|---|
| 112 | > proc dportsearch {pattern {case_sensitive yes} {matchstyle regexp} {field name}} { |
|---|
| 113 | > global darwinports::portdbpath darwinports::sources darwinports::portindex_cache |
|---|
| 114 | > |
|---|
| 115 | > set matches [dportsearch_remote $pattern] |
|---|
| 116 | > |
|---|
| 117 | > # load all the portindex caches |
|---|
| 118 | > set x [_load_portindex_cache] |
|---|
| 119 | > |
|---|
| 120 | > if {$field == "name" && $case_sensitive == "yes" && $matchstyle == "exact"} { |
|---|
| 121 | > # have an optimized path if we can lookup the name exactly |
|---|
| 122 | > set matches [concat $matches [dportsearch_exact $pattern]] |
|---|
| 123 | > } else { |
|---|
| 124 | > # do an expensive search to match against other fields or without case sensitivity |
|---|
| 125 | > set easy [expr { $field == "name" }] |
|---|
| 126 | > |
|---|
| 127 | > # step through each item in the cache |
|---|
| 128 | > foreach {name line} [array get darwinports::portindex_cache] { |
|---|
| 129 | > if {$easy} { |
|---|
| 130 | > set target $name |
|---|
| 131 | > } else { |
|---|
| 132 | > array set portinfo $line |
|---|
| 133 | > if {![info exists portinfo($field)]} continue |
|---|
| 134 | > set target $portinfo($field) |
|---|
| 135 | > } |
|---|
| 136 | > |
|---|
| 137 | > switch $matchstyle { |
|---|
| 138 | > exact { set matchres [expr 0 == ( {$case_sensitive == "yes"} ? [string compare $pattern $target] : [string compare -nocase $pattern $target] )] } |
|---|
| 139 | > glob { set matchres [expr {$case_sensitive == "yes"} ? [string match $pattern $target] : [string match -nocase $pattern $target]] } |
|---|
| 140 | > regexp - |
|---|
| 141 | > default { set matchres [expr {$case_sensitive == "yes"} ? [regexp -- $pattern $target] : [regexp -nocase -- $pattern $target]] } |
|---|
| 142 | > } |
|---|
| 143 | > |
|---|
| 144 | > if {$matchres == 1} { |
|---|
| 145 | > if {$easy} { |
|---|
| 146 | > array set portinfo $line |
|---|
| 147 | > } |
|---|
| 148 | > if {[info exists porturl]} { |
|---|
| 149 | > ui_debug "Found port in $porturl" |
|---|
| 150 | > } else { |
|---|
| 151 | > ui_debug "Found port info: $line" |
|---|
| 152 | > } |
|---|
| 153 | > lappend matches $name |
|---|
| 154 | > lappend matches $line |
|---|
| 155 | > } |
|---|
| 156 | > } |
|---|
