/usr/share/saods9/src/catflt.tcl is in saods9-data 7.3.2+repack-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 | # Copyright (C) 1999-2014
# Smithsonian Astrophysical Observatory, Cambridge, MA, USA
# For conditions of distribution and use, see copyright notice in "copyright"
package provide DS9 1.0
proc CATFltSort {varname} {
upvar #0 $varname var
global $varname
global $var(catdb)
global $var(tbldb)
upvar #0 $var(catdb) src
upvar #0 $var(tbldb) dest
# create header
set dest(Header) $src(Header)
starbase_colmap dest
set dest(Ndshs) [llength $dest(Header)]
set dest(Nrows) 0
set dest(HLines) $src(HLines)
set dest(Dashes) $src(Dashes)
# optional
if {[info exists src(DataType)]} {
set dest(DataType) $src(DataType)
}
if {[info exists src(Id)]} {
set dest(Id) $src(Id)
}
if {[info exists src(ArraySize)]} {
set dest(ArraySize) $src(ArraySize)
}
if {[info exists src(Width)]} {
set dest(Width) $src(Width)
}
if {[info exists src(Precision)]} {
set dest(Precision) $src(Precision)
}
if {[info exists src(Unit)]} {
set dest(Unit) $src(Unit)
}
if {[info exists src(Ref)]} {
set dest(Ref) $src(Ref)
}
if {[info exists src(Ucd)]} {
set dest(Ucd) $src(Ucd)
}
if {[info exists src(Description)]} {
set dest(Description) $src(Description)
}
for {set ii 1} {$ii<=$src(HLines)} {incr ii} {
set dest(H_$ii) $src(H_$ii)
}
for {set jj 1} {$jj<=$src(Ncols)} {incr jj} {
set dest(0,$jj) $src(0,$jj)
}
# sort?
set order {}
if {$var(sort) != {}} {
set col $src($var(sort))
for {set ii 1} {$ii<=$src(Nrows)} {incr ii} {
set val $src($ii,$col)
# if blank, set to 0
if {$val == {}} {
set val 0
}
lappend order "[list $ii $val]"
}
# first try as real, if error, then ascii
if [catch {lsort $var(sort,dir) -real -index 1 $order} oo] {
set oo [lsort $var(sort,dir) -ascii -index 1 $order]
}
set order $oo
} else {
for {set ii 1} {$ii<=$src(Nrows)} {incr ii} {
lappend order "[list $ii {}]"
}
}
# data
set kk 0
for {set ii 1} {$ii<=$src(Nrows)} {incr ii} {
set id [lindex [lindex $order [expr $ii-1]] 0]
# now filter
set pass 1
if {$var(filter) != {}} {
# eval all colnames
foreach col $src(Header) {
set col [string trim $col]
set val $src($id,$src($col))
# here's a tough one--
# what to do if the column is blank
# for now, just set it to '0'
if {[string trim "$val"] == {}} {
set val 0
}
eval "set \{$col\} \{$val\}"
}
# subst any columv vars
if [catch {subst $var(filter)} ff] {
return 0
}
# evaluate filter
if [catch {expr $ff} result] {
return 0
}
# do we keep the row?
if {!$result} {
set pass 0
}
}
if {$pass} {
incr kk
for {set jj 1} {$jj<=$src(Ncols)} {incr jj} {
set dest($kk,$jj) $src($id,$jj)
}
}
}
# success
set dest(Nrows) $kk
return 1
}
|