tii/tiiview.tcl

#!/usr/bin/env tclsh
# tiiview: view ii/idec messages from the local text db
# Usage: tiiview.tcl [echo_name] [filter_string] [termwidth] [dbdir]
# Created by Luxferre in 2024, released into public domain

# file read helper
proc readfile {fname} {
  set fp [open $fname r]
  fconfigure $fp -encoding utf-8
  set data [read $fp]
  close $fp
  return $data
}

# basic text reflow helper
# list in, string out
proc tiiflow {lines width} {
  set outtext {}
  foreach inl $lines {
    set l [string length $inl]
    if {$l <= $width} {
      append outtext "$inl\n"
    } else {
      set wordset ""
      set words [split $inl " "]
      foreach w $words {
        set candidate "$wordset $w"
        if {[string length $candidate] <= $width} {
          set wordset $candidate
        } else {
          append outtext "$wordset\n"
          set wordset $w
        }
      }
      append outtext "$wordset\n"
    }
  }
  return $outtext
}

# parse and pretty-print the found message
proc formatmessage {msgdata msgid globalwidth} {
  set globalline [string repeat = $globalwidth]
  set hdrline [string repeat - $globalwidth]
  set msglines [lmap s [split $msgdata "\n"] {string trimright $s}]
  # parsing according to the spec, first 7 lines are:
  # tags, echoarea, timestamp, msgfrom, msgfrom_addr, msgto, subj
  # and then an empty line and the message body follows
  set tags [split [lindex $msglines 0] "/"]
  if {[dict exists $tags repto]} {
    set replyto [dict get $tags repto]
  } else {set replyto ""}
  set echoarea [lindex $msglines 1]
  set timestamp [lindex $msglines 2]
  set msgfrom [lindex $msglines 3]
  set msgfromaddr [lindex $msglines 4]
  set msgto [lindex $msglines 5]
  set subj [lindex $msglines 6]
  set msgbody [tiiflow [lrange $msglines 8 end] $globalwidth]
  set tz ""
  set renderedts ""
  catch { # because some servers don't provide timestamps
    set renderedts [clock format $timestamp -format {%Y-%m-%d %H:%M:%S} -timezone $tz]
  }
  catch { # because pipe can be broken anytime
    puts "\[$renderedts\] ii://$msgid"
    puts "$echoarea - $msgfrom ($msgfromaddr) to $msgto"
    if {$replyto ne ""} {
      puts "Replied to: ii://$replyto"
    }
    puts "Subj: $subj"
    puts $hdrline
    puts "$msgbody$globalline\n"
  }
}

# entry point
set scriptpath [file normalize [info script]]
set appdir [file dirname $scriptpath]
# check if we're running from a starpack
if [string match *app-tiiview $appdir] {
  set appdir [file normalize [file join $appdir ".." ".." ".." ]]
}
set localdbdir [file join $appdir "tiidb"]
set echoname ""
set filterstr ""
set twidth 80
if {$argc > 0} {
  if {$argc > 1} {
    set filterstr [string trim [lindex $argv 1]]
  }
  if {$argc > 2} {
    set twidth [expr {int([lindex $argv 2])}]
  }
  if {$argc > 3} {
    set localdbdir [lindex $argv 3]
  }
  set echoname [string trim [lindex $argv 0]]
}
if {$twidth < 20} {set twidth 80}
if {$filterstr eq ""} {set filterstr "h0"}
set msgdir [file join $localdbdir "msg"]
set echodir [file join $localdbdir "echo"]
if {$echoname eq ""} { # list the echodir
  set echos [glob -tails -directory $echodir -nocomplain -types f "*.*"]
  puts [join [lsort $echos] "\n"]
} else { # fetch the actual contents
  set echofile [file join $echodir $echoname]
  if {[file exists $echofile]} {
    set msglist [split [readfile $echofile] "\n"]
    set filters [split $filterstr "/"]
    set basicmod [string trim [lindex $filters 0]]
    set filterregex {} 
    if {[llength $filters] > 1} {
      set filterregex [string trim [lindex $filters 1]]
    }
    set doreverse 0
    if {[string first r $basicmod] > -1} {set doreverse 1}
    set dotail 0
    if {[string first t $basicmod] > -1} {set dotail 1}
    set numitems 0
    if {[regexp {\d+} $basicmod foundnum]} {set numitems $foundnum}
    # perform the element filtering
    if {$numitems > 0} {
      incr numitems -1
      if {$dotail eq 1} {
        set msglist [lrange $msglist end-$numitems end]
      } else {
        set msglist [lrange $msglist 0 $numitems]
      }
    }
    if {$doreverse eq 1} {
      set msglist [lreverse $msglist]
    }
    foreach msgid $msglist { # iterate over the list after filtering
      set msgid [string trim $msgid]
      if {$msgid ne ""} {
        set msgfile [file join $msgdir $msgid]
        if {[file exists $msgfile]} {
          set msgdata [readfile $msgfile]
          set pass 1
          if {$filterregex ne {}} {
            set pass [regexp -line -nocase -- $filterregex $msgdata]
          }
          if {$pass eq 1} {formatmessage $msgdata $msgid $twidth}
        }
      }
    }
  } else {puts "This echo conference doesn't exist in the local DB!"}
}