Skip to content

Commit

Permalink
Merge pull request #278 from sm-shaw/145
Browse files Browse the repository at this point in the history 
Add CLI to Web Service with SQLite repository for output, timing and transactions
  • Loading branch information
@abondvt89
abondvt89 committed Oct 19, 2021
2 parents c8e987e + 6af22d9 commit a86e7f0
Show file tree
Hide file tree
Showing 11 changed files with 1,408 additions and 601 deletions.
2 changes: 1 addition & 1 deletion hammerdbcli
View file
Original file line number Diff line number Diff line change
Expand Up @@ -62,7 +62,7 @@ for { set modcount 0 } { $modcount < [llength $modulelist] } { incr modcount } {
}
}

append loadlist { genvu.tcl gentpcc.tcl gentpch.tcl gengen.tcl genxml.tcl genmodes.tcl gentccmn.tcl gentccli.tcl geninitcli.tcl gencli.tcl genstep.tcl }
append loadlist { genvu.tcl gentpcc.tcl gentpch.tcl gengen.tcl genxml.tcl genmodes.tcl gentccmn.tcl gentccli.tcl geninitcli.tcl gencli.tcl genhelp.tcl genstep.tcl }
for { set loadcount 0 } { $loadcount < [llength $loadlist] } { incr loadcount } {
set f [lindex $loadlist $loadcount]
set loadtext $f
Expand Down
31 changes: 28 additions & 3 deletions hammerdbws
View file
Original file line number Diff line number Diff line change
Expand Up @@ -32,7 +32,26 @@ puts "Type \"help\" for a list of commands"
set UserDefaultDir [ file dirname [ info script ] ]
::tcl::tm::path add "$UserDefaultDir/modules"

append modulelist { Thread msgcat sqlite3 xml wapp huddle }
namespace eval autostart {
set autostartap "false"
if {$argc == 0} { ; } else {
if {$argc != 2 || [lindex $argv 0] != "auto" } {
puts {Usage: hammerdbws [ auto [ script_to_autoload.tcl ] ]}
exit
} else {
set autostartap "true"
set autoloadscript [lindex $argv 1]
if { [ file exists $autoloadscript ] && [ file isfile $autoloadscript ] && [ file extension $autoloadscript ] eq ".tcl" } {
;# autostart selected and tcl file exists
} else {
puts {Usage: hammerdbws [ auto [ script_to_autoload.tcl ] ]}
exit
}
}
}
}

append modulelist { Thread msgcat sqlite3 xml comm tclreadline task wapp rest huddle }
for { set modcount 0 } { $modcount < [llength $modulelist] } { incr modcount } {
set m [lindex $modulelist $modcount]
set loadtext $m
Expand All @@ -43,7 +62,7 @@ for { set modcount 0 } { $modcount < [llength $modulelist] } { incr modcount } {
}
}

append loadlist { genvu.tcl gentpcc.tcl gentpch.tcl gengen.tcl genxml.tcl geninitws.tcl genws.tcl }
append loadlist { genvu.tcl gentpcc.tcl gentpch.tcl gengen.tcl genxml.tcl gentccmn.tcl gentcws.tcl geninitws.tcl genws.tcl genhelp.tcl }
for { set loadcount 0 } { $loadcount < [llength $loadlist] } { incr loadcount } {
set f [lindex $loadlist $loadcount]
set loadtext $f
Expand All @@ -61,4 +80,10 @@ for { set dbsrccount 0 } { $dbsrccount < [llength $dbsrclist] } { incr dbsrccoun
puts stderr "Error loading database source files/$f"
}
}
start_webservice
if { $autostart::autostartap == "true" } {
start_webservice -nowait
source $autostart::autoloadscript
} else {
start_webservice -nowait
TclReadLine::interactws
}
4 changes: 2 additions & 2 deletions hammerdbws.bat
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
@echo off
COLOR 07
set path=.\bin;%PATH%
START tclsh86t hammerdbws
CALL tclsh86t hammerdbws %1 %2
exit

65 changes: 45 additions & 20 deletions modules/rest-1.3.1.tm → modules/rest-1.4.tm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,16 +3,14 @@
# A framework for RESTful web services
#
# Copyright (c) 2009 Aaron Faupell
#
# RCS: @(#) $Id: rest.tcl,v 1.7 2009/10/14 16:28:18 afaupell Exp $

package require Tcl 8.5
package require http 2.7
package require json
#package require tdom
#package require base64

package provide rest 1.3.1
package provide rest 1.4

namespace eval ::rest {
namespace export create_interface parameters parse_opts save \
Expand Down Expand Up @@ -74,7 +72,7 @@ proc ::rest::simple {url query args} {
} else {
set error_body 0
}

set result [::rest::_call {} $headers $url $query $body $error_body]

# if a format was specified then convert the data, but dont do any auto formatting
Expand All @@ -92,11 +90,33 @@ interp alias {} ::rest::patch {} ::rest::simple
interp alias {} ::rest::post {} ::rest::simple
interp alias {} ::rest::put {} ::rest::simple

proc ::rest::CheckLevel {loc} {
#if called with autoload script frame level needs to be -2 at first command
#if called from prompt frame level needs to be -4
#This proc checks first call and hard codes frame level
#Incorrect level gives unable to determine rest::simple method
global flevel
if {![info exists flevel]} {
if {[dict get $loc cmd] eq {source $autostart::autoloadscript}} {
set flevel -2
} else {
set flevel -4
}
}
return $flevel
}

proc ::rest::DetermineMethod {cv} {
global flevel
upvar 1 $cv config
if {[dict exists $config method]} return

set loc [info frame -2]
if { ![info exists flevel] } {
set loc [info frame -4]
set loclev [ ::rest::CheckLevel $loc ]
set loc [info frame $loclev]
} else {
set loc [info frame $flevel]
}
if {![dict exists $loc cmd]} {
return -code error "Unable to determine rest::simple method in the current context ([dict get $loc type]). Please specify it explicitly."
}
Expand All @@ -109,7 +129,7 @@ proc ::rest::DetermineMethod {cv} {
# TODO: Quoted literal.
regexp {^([^ ]+).*$} $cmd -> cmd
}
set cmd [namespace tail $cmd]
set cmd [namespace tail $cmd]
if {$cmd eq "simple"} { set cmd get }
if {$cmd ni {get delete head post put patch}} {
return -code error "Unable to determine rest::simple method, found \"$cmd\". Please specify it explicitly."
Expand All @@ -134,7 +154,7 @@ proc ::rest::DetermineMethod {cv} {
#
proc ::rest::create_interface {name} {
upvar $name in

# check if any defined calls have https urls and automatically load and register tls
#if {[catch {package present tls}]} {
# foreach x [array names in] {
Expand All @@ -160,7 +180,7 @@ proc ::rest::create_interface {name} {
if {[dict exists $config content-type]} {
dict set config headers content-type [dict get $config content-type]
}

lappend proc "set config \{$config\}"
lappend proc "set headers \{\}"

Expand Down Expand Up @@ -192,8 +212,13 @@ proc ::rest::create_interface {name} {
} elseif {[string match mime_multi* [lindex [dict get $config body] 0]]} {
lappend proc {if {$body == ""} { return -code error "wrong # args: should be \"[lindex [info level 0] 0] ?options? string\"" }}
lappend proc {set b [::rest::mime_multipart body $body]}
lappend proc {dict set config headers content-type "multipart/related; boundary=$b"}
}
if {[regexp {/(.+)$} [lindex [dict get $config body] 0] dummy match]} {
set content_type "multipart/$match"
} else {
set content_type "multipart/related"
}
lappend proc "dict set config headers content-type \"$content_type; boundary=\$b\""
}
}
if {[dict exists $config error-body]} {
set error_body [dict get $config error-body]
Expand Down Expand Up @@ -226,9 +251,9 @@ proc ::rest::create_interface {name} {
if {[dict exists $config auth] && [lindex [dict get $config auth] 0] == "sign"} {
lappend proc "set query \[::${name}::[lindex [dict get $config auth] 1] \$query]"
}

lappend proc {set query [::http::formatQuery {*}$query]}

# if this is an async call (has defined a callback)
# then end the main proc here by returning the http token
# the rest of the normal result processing will be put in a _callback_NAME
Expand All @@ -242,7 +267,7 @@ proc ::rest::create_interface {name} {
} else {
lappend proc {set result [::rest::_call {} $headers $url $query $body $error_body]}
}

# process results
_transform $name $call $config proc pre_transform result
if {[dict exists $config result]} {
Expand Down Expand Up @@ -275,9 +300,9 @@ proc ::rest::create_interface {name} {
variable static_args
set static_args $args
}

set ::${name}::static_args {}

# print the contents of all the dynamic generated procs
if {0} {
foreach x [info commands ::${name}::*] {
Expand Down Expand Up @@ -373,7 +398,7 @@ package require tls
::http::register https 443 [list ::tls::socket]
}
}

puts $fh "namespace eval ::$name \{\}\n"
foreach x {_call _callback parse_opts _addopts substitute _check_result \
format_auto format_raw format_xml format_json format_discard \
Expand Down Expand Up @@ -436,7 +461,7 @@ proc ::rest::_call {callback headers url query body error_body} {
#puts "_call [list $callback $headers $url $query $body $error_body]"
# get the settings from the calling proc
upvar config config

set method GET
if {[dict exists $config method]} { set method [string toupper [dict get $config method]] }

Expand Down Expand Up @@ -595,7 +620,7 @@ proc ::rest::parse_opts {static required optional options} {
break
}
set opt [string range $opt 1 end]

if {[set i [lsearch $optional $opt:*]] > -1} {
lappend query $opt [lindex $args 1]
set args [lreplace $args 0 1]
Expand All @@ -613,7 +638,7 @@ proc ::rest::parse_opts {static required optional options} {
return -code error "bad option \"$opt\""
}
}

foreach opt $optional {
if {[set i [lsearch -regexp $static ^-?$opt$]] >= 0} {
lappend query $opt [lindex $static [expr {$i+1}]]
Expand Down
5 changes: 5 additions & 0 deletions modules/tclreadline-1.2.tm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -776,6 +776,11 @@ proc TclReadLine::restore {} {
rename ::_unknown ::unknown
}

proc TclReadLine::interactws {} {
variable PROMPT "hammerws>"
TclReadLine::interact
}

proc TclReadLine::interact {} {
rename ::unknown ::_unknown
rename TclReadLine::unknown ::unknown
Expand Down
Loading

0 comments on commit a86e7f0

Please sign in to comment.