scriptlib updates - add initial lua,php scripts for stderr/stdout testing

2 years ago · 7ca3e6a2a7
12 changed files with 281 additions and 0 deletions
--- a/scriptlib/code/freq1.tcl
+++ b/scriptlib/code/freq1.tcl
@ -0,0 +1,100 @@
 package require shellfilter
 interp alias {} a+ {} shellfilter::ansi::+
 #lassign $argv head
 set args [lassign $::argv target]
 puts stdout "::argv  '$::argv'"
 puts stdout "target:'$target' args:'$args'"
 if {![string length $target]} {
    set target stdout
 }
 if {([llength $args] % 2) != 0} {
    puts stderr "Usage [info script] \[targetfile|stderr|stdout\] -format html|ansi"
    flush stderr
    error 1
 }
 set defaults [dict create \
    -format ansi\
    ]
 set opts [dict merge $defaults $args]
 set format [string tolower [dict get $opts -format]]
 set known_formats [list "ansi" "html"]
 foreach f $format {
    if {$f ni $known_formats} {
        puts stderr "Unrecognized -format $f"
        flush stderr
        error 2
    }
 }
 while { [gets stdin line] >= 0 } {
    lappend fileLines $line
    foreach word [regexp -all -inline {[A-Za-z0-9]+} $line] {
        dict incr wordcount [string tolower $word]
    }
 }
 if {$target in {stdout stderr}} {
    set fp $target
 } else {
    set fp [open "$target" w]
 }
 if {"html" in $format} {
    puts $fp "<html>"
    puts $fp "<head><title>onlies</title></head>"
    puts $fp "<body>"
    foreach line $fileLines {
        set text "<pre>"
        set strLength [string length $line]
        for {set i 0} {$i < $strLength} {} {
            if {![string is alnum [string index $line $i]]} {
                append text [string index $line $i]
                incr i
            } else {
                set word [regexp -inline {[A-Za-z0-9]+} [string range $line $i end]]
                if {[dict exists $wordcount $word] && [dict get $wordcount $word] == 1} {
                    append text "<span style=background-color:yellow>" $word "</span>"
                } else {
                    append text $word
                }
                incr i [string length $word]
            }
        }
        append text "</pre>"
        puts $fp $text
    }
    puts $fp "</body>"
    puts $fp "</html>"
 } 
 if {"ansi" in $format} {
    set highlight [a+ yellow bold]
    foreach line $fileLines {
        set text ""
        set strLength [string length $line]
        for {set i 0} {$i < $strLength} {} {
            if {![string is alnum [string index $line $i]]} {
                append text [string index $line $i]
                incr i
            } else {
                set word [regexp -inline {[A-Za-z0-9]+} [string range $line $i end]]
                if {[dict exists $wordcount $word] && [dict get $wordcount $word] == 1} {
                    append text "$highlight" $word "[a+]"
                } else {
                    append text $word
                }
                incr i [string length $word]
            }
        }
        puts $fp $text
    }
 }
 if {$target ni {stdout stderr}} {
    close $fp
 }
--- a/scriptlib/error.tcl
+++ b/scriptlib/error.tcl
@ -0,0 +1,5 @@
 puts stdout "1 (stdout) test of error in scriptlib tcl script"
 puts stderr "2 (stderr) error line will be run next - followed by a dashed line on stdout"
 error "This is the error"
 puts stdout "-----------------------------"
--- a/scriptlib/hello.lua
+++ b/scriptlib/hello.lua
@ -0,0 +1,30 @@
 #!/usr/bin/lua
 --chan configure stdout -buffering none
 io.stdout:setvbuf("no")
 --chan configure stderr -buffering none
 io.stderr:setvbuf("no")
 --puts -nonewline stderr "1 hello on stderr with crlf newline\r\n"
 io.stderr:write("1 hello on stderr from LUA with crlf newline\r\n")
 --flush stderr
 io.stderr:flush()
 --puts -nonewline stdout "2 hello on stdout with crlf newline\r\n"
 io.write("2 hello on stdout from LUA with crlf newline\r\n")
 --flush stdout
 io.stdout:flush()
 --puts -nonewline stderr "3 hello on stderr with unix newline\n"
 io.stderr:write("3 hello on stderr from LUA with unix newline\n")
 --flush stderr
 io.stderr:flush()
 --puts -nonewline stdout "4 hello on stdout with unix newline\n"
 io.write("4 hello on stdout from LUA with unix newline\n")
 --flush stdout
 io.stdout:flush()
 --puts -nonewline stderr "5 hello on stderr no line-ending"
 io.stderr:write("5 hello on stderr from LUA no line-ending")
 --flush stderr
 io.stderr:flush()
 --puts -nonewline stdout "6 hello on stdout no line-ending"
 io.stdout:write("6 hello on stdout from LUA no line-ending")
 --flush stdout
 io.stdout:flush()
--- a/scriptlib/hello.php
+++ b/scriptlib/hello.php
@ -0,0 +1,31 @@
 <?php
 //chan configure stdout -buffering none
 //chan configure stderr -buffering none
 //io.stderr:setvbuf("no")
 //puts -nonewline stderr "1 hello on stderr with crlf newline\r\n"
 fwrite(STDERR, "1 hello on stderr from PHP with crlf newline\r\n");
 //flush stderr
 //io.stderr:flush()
 //puts -nonewline stdout "2 hello on stdout with crlf newline\r\n"
 fwrite(STDOUT, "2 hello on stdout from PHP with crlf newline\r\n");
 //flush stdout
 //io.stdout:flush()
 //puts -nonewline stderr "3 hello on stderr with unix newline\n"
 fwrite(STDERR, "3 hello on stderr from PHP with unix newline\n");
 //flush stderr
 //io.stderr:flush()
 //puts -nonewline stdout "4 hello on stdout with unix newline\n"
 fwrite(STDOUT, "4 hello on stdout from PHP with unix newline\n");
 //flush stdout
 //io.stdout:flush()
 //puts -nonewline stderr "5 hello on stderr no line-ending"
 fwrite(STDERR, "5 hello on stderr from PHP no line-ending");
 //flush stderr
 //flush();
 //puts -nonewline stdout "6 hello on stdout no line-ending"
 fwrite(STDOUT, "6 hello on stdout from PHP no line-ending");
 //flush stdout
 //flush();
 //io.stdout:flush()
 ?>
--- a/scriptlib/lang/lua/hello.lua
+++ b/scriptlib/lang/lua/hello.lua
@ -0,0 +1,30 @@
 #!/usr/bin/lua
 --chan configure stdout -buffering none
 io.stdout:setvbuf("no")
 --chan configure stderr -buffering none
 io.stderr:setvbuf("no")
 --puts -nonewline stderr "1 hello on stderr with crlf newline\r\n"
 io.stderr:write("1 hello on stderr from LUA with crlf newline\r\n")
 --flush stderr
 io.stderr:flush()
 --puts -nonewline stdout "2 hello on stdout with crlf newline\r\n"
 io.write("2 hello on stdout from LUA with crlf newline\r\n")
 --flush stdout
 io.stdout:flush()
 --puts -nonewline stderr "3 hello on stderr with unix newline\n"
 io.stderr:write("3 hello on stderr from LUA with unix newline\n")
 --flush stderr
 io.stderr:flush()
 --puts -nonewline stdout "4 hello on stdout with unix newline\n"
 io.write("4 hello on stdout from LUA with unix newline\n")
 --flush stdout
 io.stdout:flush()
 --puts -nonewline stderr "5 hello on stderr no line-ending"
 io.stderr:write("5 hello on stderr from LUA no line-ending")
 --flush stderr
 io.stderr:flush()
 --puts -nonewline stdout "6 hello on stdout no line-ending"
 io.stdout:write("6 hello on stdout from LUA no line-ending")
 --flush stdout
 io.stdout:flush()
--- a/scriptlib/lang/php/hello.php
+++ b/scriptlib/lang/php/hello.php
@ -0,0 +1,31 @@
 <?php
 //chan configure stdout -buffering none
 //chan configure stderr -buffering none
 //io.stderr:setvbuf("no")
 //puts -nonewline stderr "1 hello on stderr with crlf newline\r\n"
 fwrite(STDERR, "1 hello on stderr from PHP with crlf newline\r\n");
 //flush stderr
 //io.stderr:flush()
 //puts -nonewline stdout "2 hello on stdout with crlf newline\r\n"
 fwrite(STDOUT, "2 hello on stdout from PHP with crlf newline\r\n");
 //flush stdout
 //io.stdout:flush()
 //puts -nonewline stderr "3 hello on stderr with unix newline\n"
 fwrite(STDERR, "3 hello on stderr from PHP with unix newline\n");
 //flush stderr
 //io.stderr:flush()
 //puts -nonewline stdout "4 hello on stdout with unix newline\n"
 fwrite(STDOUT, "4 hello on stdout from PHP with unix newline\n");
 //flush stdout
 //io.stdout:flush()
 //puts -nonewline stderr "5 hello on stderr no line-ending"
 fwrite(STDERR, "5 hello on stderr from PHP no line-ending");
 //flush stderr
 //flush();
 //puts -nonewline stdout "6 hello on stdout no line-ending"
 fwrite(STDOUT, "6 hello on stdout from PHP no line-ending");
 //flush stdout
 //flush();
 //io.stdout:flush()
 ?>
--- a/scriptlib/lang/php/phpinfo.php
+++ b/scriptlib/lang/php/phpinfo.php
@ -0,0 +1,5 @@
 <?php
    echo phpinfo();
 ?>
--- a/scriptlib/stderr.tcl
+++ b/scriptlib/stderr.tcl
@ -0,0 +1,8 @@
 chan configure stderr -buffering none
 puts -nonewline stderr "1 hello on stderr with crlf newline\r\n"
 flush stderr
 puts -nonewline stderr "2 hello on stderr with unix newline\n"
 flush stderr
 puts -nonewline stderr "3 hello on stderr no line-ending"
 flush stderr
--- a/scriptlib/stdout.tcl
+++ b/scriptlib/stdout.tcl
@ -0,0 +1,8 @@
 chan configure stdout -buffering none
 puts -nonewline stdout "1 hello on stdout with crlf newline\r\n"
 flush stdout
 puts -nonewline stdout "2 hello on stdout with unix newline\n"
 flush stdout
 puts -nonewline stdout "3 hello on stdout no line-ending"
 flush stdout
--- a/scriptlib/tests/adhoc/aliases.tcl
+++ b/scriptlib/tests/adhoc/aliases.tcl
@ -0,0 +1,6 @@
 set sepline [string repeat - 40]
 puts stdout "testing some aliases"
 puts stdout $sepline
 puts stdout "1 ll - should show long dir listing"
 ll
 puts stdout $sepline
--- a/scriptlib/tests/adhoc/showargs.tcl
+++ b/scriptlib/tests/adhoc/showargs.tcl
@ -0,0 +1,7 @@
 #puts -nonewline stdout "info script\r\n"
 #puts stdout "[info script]"
 puts stdout "::argc"
 puts stdout $::argc
 puts stdout "::argv"
 puts stdout "$::argv"
--- a/scriptlib/wait.tcl
+++ b/scriptlib/wait.tcl
@ -0,0 +1,20 @@
 set msg "-[file tail [info script]] done-"
 if {$::argc >= 1} {
   set howlong [lindex $::argv 0]
   if {$::argc >=2} {
        set msg [lindex $::argv 1]
   }
 } else {
   set howlong 1000
 }
 puts stdout "wait: $howlong"
 set ::script_wait_var 0
 if {[string is integer -strict $howlong]} {
    after $howlong {set ::script_wait_var 1}
 }
 vwait ::script_wait_var
 puts -nonewline stderr $msg\n