The netinfo Tcl extension provides access to system proto-
       col,  service,  network  and  host  information  which  is
       retrieved  from  system  databases  and made available for
       querying.  This functionality  is  somewhat  analogous  to
       that  provided  by some of the functions referenced in the
       <netdb.h> C include file usually found on unix-like  oper-
       ating systems (gethostbyname, getservbyport, etc).  Unlike
       those functions, netinfo does not  go  beyond  referencing
       the  data  stored  in the system "databases"; netinfo does
       not access the databases per query, rather  it  loads  the
       data  and  parses  it  into an internal ready-for-querying
       format.  If any changes are made to  the  databases  after
       loading  then  the  affected  databases  would  need to be
       reloaded if the changes are to  be  available  to  netinfo
       queries.
       Normal  usage  involves optionally specifying any database
       files if the defaults do not match your  reality,  calling
       as many of the "load" commands as are necessary (depending
       on what data you need to access;  netinfo  does  not  load
       anything at startup) and using the querying and extraction
       commands to retrieve info.

       # Results noted with #=>
       package require netinfo
       namespace import ::netinfo::*
       loadProtocolData; loadServiceData; loadNetworkData; loadHostData

       protocolData protocol -number 123 -comment
       #=> Performance Transparency Protocol
       protocolData protocol -number 123 -comment -name
       #=> {Performance Transparency Protocol} ptp

       service -port 9
       #=> discard 9 {sink null} {} tcp
       service -port 9 -protocol udp
       #=> discard 9 {sink null} {} udp
       service -port 9 -protocol *
       #=> {discard 9 {sink null} {} tcp} {discard 9 {sink null} {} udp}
       serviceData lindex [service -port 9 -protocol * 1] -protocol -port
       #=> udp 9

       network -number 127
       #=> loopback loop {} 127
       networkData network -number 224 -name
       #=> BASE-ADDRESS.MCAST.NET

       hostData host -aliases localhost -address
       #=> 127.0.0.1
       hostData host -aliases localhost -domain inet6 -address
       #=> ::1

       # List all services:
       service -name *

#! /bin/sh
# \
exec tclsh "$0" ${1+"$@"}

#
# TkNib - GUI Netinfo browser
#
# Stuart Cassoff
# Winter 2009
#
# Version 0.1
#


namespace eval tknib {


#
#
#
proc gui {} {
        variable cfg
        variable gui

        set ns $cfg(NS):

        set w [set gui(w) {}]
        set W [set gui(W) $w.]

        {*}[gubProc [gub "N;:;|.;-.;/N0 mainBook"]];widget $W

        foreach t $cfg(tables) {
                load[string totitle $t]Data
                set fields {}; set headings {}
                foreach fld [${t}Fields] {
                        set fld [string range $fld 1 end]
                        lappend fields $fld
                        lappend headings [string totitle $fld]
                }
                set f [ttk::frame $gui(mainBook).f$t]
                {*}[gubProc [gub "V S\nS
                        .V0 -columns {$fields} -show headings -height 20 -selectmode browse
                        .S1 -orient horizontal
                        ^S0 V0 ; =S1 V0
                        :V0 ; :S0 -sticky ns ; :S1 -sticky ew
                        |. ; -.
                        /V0 $t
                "]]
                $gui(mainBook) add [widget $f] -text $t -sticky nsew

                set font [ttk::style lookup [$gui($t) cget -style] -font]
                foreach fld $fields hdg $headings {
                        $gui($t) heading $fld -command [list $ns:SortBy $gui($t) $fld 0] -text $hdg
                        $gui($t) column $fld -width [font measure $font $hdg]
                }
                foreach fld $fields { set lens($fld) 0 }
                foreach q [$t -name *] {
                        $gui($t) insert {} end -values $q
                        foreach fld $fields val $q {
                                if {[set len [string length $val]] > $lens($fld)} { set lens($fld) [incr len 2] }
                        }
                }
                foreach fld $fields { $gui($t) column $fld -width [font measure $font [string repeat x $lens($fld)]] }
        }

        set M [menu $w.mMain -tearoff 0]
        foreach menu {file help} items {{Exit} {About}} commands [list [list exit] [list $ns:about]] {
                $M add cascade -label [string totitle $menu] -menu [set mm [menu $M.$menu -tearoff 0]]
                foreach item $items command $commands { $mm add command -label $item -command $command }
        }

        bind $W <Control-q> exit; bind $W <Control-Q> exit

        $W configure -menu $M

        wm title $W $cfg(fullname)
}
###



#
# From the Tk widget demo "A multi-column list of countries"
# Code to do the sorting of the tree contents when clicked on
#
proc SortBy {tree col direction} {
        # Build something we can sort
        set data {}
        foreach row [$tree children {}] {
                lappend data [list [$tree set $row $col] $row]
        }

        set dir [expr {$direction ? "-decreasing" : "-increasing"}]
        set r -1

        # Now reshuffle the rows into the sorted order
        foreach info [lsort -dictionary -index 0 $dir $data] {
                $tree move [lindex $info 1] {} [incr r]
        }

        # Switch the heading so that it will sort in the opposite direction
        $tree heading $col -command [list [namespace current]::SortBy $tree $col [expr {!$direction}]]
}
###



#
#
#
proc about {} {
        variable cfg
        catch {destroy .q}
        wm group [toplevel .q] .
        {*}[gubProc [gub "L\nL\nL\nL\nB
                .L0 -text {$cfg(fullname)}
                .L1 -text {Netinfo Browser}
                .L2 -text {$cfg(author)}
                .L3 -text {$cfg(when)}
                .B0 -text Ok -command {destroy .q}
                /B0 ok
        " aboot] widget aboot]
        widget .q
        wm title .q "$cfg(fullname) - About"
        ::tk::PlaceWindow .q widget .
        variable aboot
        focus $aboot(ok)
        unset aboot
}
###



#
#
#
proc depend {} {
        package require Tk
        foreach p {gub netinfo} {
                package require $p
                namespace import ::${p}::*
        }
}
###



#
#
#
proc setup {} {
        variable cfg

        set cfg(NS)                [namespace current]

        set cfg(name)                TkNib
        set cfg(ver)                0.1
        set cfg(author)                "Stuart Cassoff"
        set cfg(when)                "Winter 2009"

        set cfg(fullname)        $cfg(name)\ $cfg(ver)

        set cfg(tables)                [list protocol service network host]
}
###



#
setup; depend; gui
#


}; # End of tknib namespace

# EOF