# copyright (C) 1997-2001 Jean-Luc Fontaine (mailto:jfontain@free.fr)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu

set rcsId {$Id: pci.tcl,v 1.3 2001/01/27 15:08:19 jfontain Exp $}


package provide pci [lindex {$Revision: 1.3 $} 1]
package require network 1

namespace eval pci {

    array set data {
        updates 0
        0,label bus 0,type integer 0,message {bus number}
        1,label device 1,type integer 1,message {device (slot) number}
        2,label function 2,type integer 2,message {function number}
        3,label type 3,type ascii 3,message {device type}
        4,label description 4,type ascii 4,message {device description} 4,anchor left
        5,label information 5,type ascii 5,message {device information} 5,anchor left
        indexColumns {0 1 2}
        sort {0 increasing}
        pollTimes {60 10 20 30 120 300 600}
        switches {-r 1 --remote 1}
    }

    set file [open pci.htm]
    set data(helpText) [read $file]                                                           ;# initialize HTML help data from file
    close $file

    proc initialize {optionsName} {
        upvar $optionsName options
        variable remote
        variable data
        variable pciFile

        if {![catch {set locator $options(--remote)}]||![catch {set locator $options(-r)}]} {                   ;# remote monitoring
            foreach {remote(protocol) remote(user) remote(host)} [network::parseRemoteLocator $locator] {}
            network::checkRemoteOutputEmptiness $remote(protocol) $remote(user) $remote(host)
            set data(identifier) pci($remote(host))
            set file [open "| /usr/bin/$remote(protocol) -n -l $remote(user) $remote(host) cat /proc/version"]
            fileevent $file readable {set ::pci::remote(busy) 0}
            vwait ::pci::remote(busy)                                                                  ;# do not hang user interface
        } else {
            set file [open /proc/version]
            set pciFile [open /proc/pci]
        }
        regexp {^[\d\.]+} [lindex [gets $file] 2] version                          ;# ignore extra characters, such as in 2.2.0-pre1
        if {[info exists remote]} {
            # detect errors early (but avoid write on pipe with no readers errors by reading whole data)
            if {[catch {read $file} message]||[catch {close $file} message]} {
                error "on remote host $remote(host) as user $remote(user): $message"
            }
        } else {
            close $file
        }
        if {[package vcompare $version 2]<0} {                                                               ;# check kernel version
            error {at least a version 2 kernel is needed}
        }
    }

    set nextIndex 0

    proc update {} {
        variable remote
        variable pciFile
        variable data
        variable index
        variable nextIndex

        if {[info exists remote]} {
            if {![info exists pciFile]} {                                  ;# start data gathering process in a non blocking fashion
                if {$remote(busy)} return                                           ;# core invocation while waiting for remote data
                set remote(busy) 1
                set file [open "| /usr/bin/$remote(protocol) -n -l $remote(user) $remote(host) cat /proc/pci"]
                fileevent $file readable "set ::pci::pciFile $file; ::pci::update"   ;# do not hang GUI, allow other modules updates
                return                                                                                       ;# wait for remote data
            }                                                                                 ;# else continue below to process data
        } else {
            seek $pciFile 0                                                                         ;# rewind before retrieving data
        }
        gets $pciFile                                                                                            ;# skip header line
        set lines {}
        while {[gets $pciFile line]>=0} {
            lappend lines $line
        }
        if {[info exists remote]} {                                                 ;# closing is necessary since seek does not work
            read $pciFile                                    ;# avoid write on pipe with no readers errors by reading remaining data
            if {[catch {close $pciFile} message]} {                                      ;# communication error can be detected here
                flashMessage "pci error: $message"
                set lines {}                                                                   ;# consider data corrupted as a whole
            }
            unset pciFile
            set remote(busy) 0
        }
        set entryLineIndex -1
        foreach line $lines {
            if {[scan $line { Bus %u, device %u, function %u} bus device function]==3} {                               ;# next entry
                set key $bus,$device,$function
                if {[catch {set index($key)} row]} {
                    set row [set index($key) $nextIndex]
                    incr nextIndex
                }
                array set data [list $row,0 $bus $row,1 $device $row,2 $function $row,5 {}]  ;# reset information cell for appending
                set current($key) {}
                set entryLineIndex 0
            } elseif {$entryLineIndex>=0} {                                                                      ;# entry data lines
                if {$entryLineIndex==0} {                                                               ;# type and description line
                    regexp {^\s*(.+?)\s*:\s*(.+?)$} $line dummy data($row,3) data($row,4)
                } else {                                                                                      ;# information line(s)
                    if {[string length $data($row,5)]>0} {                                         ;# not the first information line
                        append data($row,5) \n                                                                     ;# go to new line
                    }
                    append data($row,5) [string trim $line]
                }
                incr entryLineIndex
            }
        }
        foreach {key row} [array get index] {                                                         ;# cleanup disappeared entries
            if {[info exists current($key)]} continue
            array unset data "$row,\[0-9\]*"
            unset index($key)
        }
        incr data(updates)
    }

}
