The hotgrep Script

Modification Date: 11/04/2009

Table of Procedures

MAIN cfg client handle hotgrep html

init readWrite run statFile truncateBuffer

#!/bin/sh

exec tclsh "$0" ${1+"$@"}

set msg "      hotgrep command syntax:\n
   hotgrep filename \[rx_pattern\] \[delay in secs.\] \[server_port\]\n
   Only filename is required, refresh delay defaults to 2 seconds,
   and a server will only be set up if you spec a port.
   Remember to protect your regexp pattern with ''s to avoid shell
   expansion!
   See the script for an example client for the server version."
;## helpful hint
if { [ llength $argv ] < 1 } {
   puts stderr $msg
   exit
 }

proc cfg {cid addr port} {
     fileevent $cid readable "handle $cid"
}

proc handle {cid} {
     fconfigure $cid -blocking off
     fconfigure $cid -buffering full
     puts  $cid [ join $::buffer "\n" ]
     close $cid
     set ::buffer [ list ]
}

proc html { data } {
     regsub -all {<[Ll][Ii]>} $data {  * } data
     regsub -all {<img src=\"ball_green[^>]+>}  $data {*   } data
     regsub -all {<img src=\"ball_yellow[^>]+>} $data {**  } data
     regsub -all {<img src=\"ball_red[^>]+>}    $data {*** } data
     regsub -all {<[Ii][Mm][Gg][^>]+>} $data {* } data
     regsub -all {<[^>]+>} $data {} data
     regsub -all {\\\}} $data \} data
     regsub -all {\\\{} $data \{ data
     return $data
}

proc truncateBuffer { { limit 256 } } {
     if { ! $::server } { return }
     set length [ llength $::buffer ]
     if { $length > $limit } {
        set first [ expr { $limit - $length } ]
        set last  [ expr { $length - 1 }   ]
        set ::buffer [ lrange $::buffer $first $last ]
        lappend ::buffer \
           "<!-- HOTGREP: BUFFER TRUNCATED FROM $length LINES -->"
     }
}

proc statFile {} {
     file stat $::fname fstat
     if { $fstat(ino) != $::inode } {
        catch { close $::fid; unset ::fid }
     }
     if { ! [ info exists ::fid ] } {
        set ::fid [ open $::fname r ]
        set ::inode $fstat(ino)
        set time [ clock format [ clock seconds ] ]
        puts stderr \
           "<!-- HOTGREP: file \"$::fname\" opened as $::fid at $time -->"
     }
}

proc readWrite {} {
     set report_binary 1
     while { [ gets $::fid line ] >= 0 } {
        if { [ regexp $::rx $line ] } {
           ;## strip HTML tags
           set line [ html $line ]
           ;## strip binary data
           if { [ regexp {[\x00-\x08\x0b\x0e-\x1f]} $line ] } {
              if { $report_binary } {
                 set line "<!-- HOTGREP: BINARY DATA NOT RETURNED -->"
                 set report_binary 0
              } else {
                 continue
              }
           } else {
              set report_binary 1
           }
           if { $::server } {
              lappend ::buffer $line
           } else {
              puts stdout $line
           }
        }
     }
}

proc run { } {
     truncateBuffer
     if { [ file exists $::fname ] } {
        statFile
        readWrite
     } else {
        ;## maybe the file got nuked? Handle it!
        catch { close $::fid }
        catch { unset ::fid  }
     }
     ;## and loop
     after $::delay run
}

proc init {} {
     if { [ info exists ::fname ] } { return }
     ;## default delay = 2 seconds
     set ::delay   2000
     set ::server  0
     set ::buffer [ list ]
     set ::inode  {}
     set ::fname  {}
     set ::rx     .+
     ;## read the command line ::argv
     if { [ catch {
        set ::fname [ lindex $::argv  0 ]
        if { [ llength $::argv ] >= 2 } {
           set ::rx [ lindex $::argv  1 ]
           if { [ catch {
              regexp $::rx foo
           } err ] } {
              set err "invalid regexp: '$::rx'"
              return -code error $err
           }
        }
        if { [ llength $::argv ] >= 3 } {
           if { [ catch {
              set ::delay [ expr { [ lindex $::argv 2 ] * 1000 } ]
           } err ] } {
           return -code error "\n$err\nDid you protect your regexp?\n"
           }
        }
        ;## if a port was specified, get the number.
        if { [ llength $::argv ] == 4 } {
           set server_port [ lindex $::argv 3 ]
        }
        ;## if a port was specified, hook it up!
        if { [ info exists server_port ] } {
           set ::server 1
           set cid [ socket -server cfg $server_port ]
           puts stderr \
              "<!-- HOTGREP: socket \"$server_port\" opened as $cid -->"
        }
     } err ] } {
     return -code error $err
     }
     run
}

proc client { host port } {
     set sid [ socket $host $port ]
     fconfigure $sid -blocking off
     puts $sid {}
     flush $sid
     while { [ gets $sid line ] > 0 } { puts $line }
     close $sid
     after 3000 [ list client $host $port ]
}