View Options

	diff --git a/Wearg/ServersLog.tcl b/Wearg/ServersLog.tcl
	index 935ee81..a9ff5aa 100644
	--- a/Wearg/ServersLog.tcl
	+++ b/Wearg/ServersLog.tcl
	@@ -1,43 +1,70 @@
	package require rest

	bind pub - .+log pub:log
	bind dcc - +log dcc:log

	+bind pubm - "#* \[\] " pubm:log
	+
	+proc pubm:log {nick uhost handle chan text} {
	+ regexp "\\\[(.)\\\] (.)" $text match component entry
	+
	+ if {[is_known_component $component]} {
	+ add_to_servers_log $emitter "$network $source" $component $entry
	+ putcmdlog "<<$nick>> !$handle! .+log $text"
	+ } {
	+ putserv "PRIVMSG $chan :$nick, if you wish to log that, confirm with .+log $text"
	+ }
	+}
	+
	proc pub:log {nick uhost handle chan arg} {
	set callback [get_putbymode_chan_callback $chan $nick]
	handle_send_to_servers_log [resolve_nick $nick] $chan $arg $callback
	}

	proc dcc:log {handle idx arg} {
	global username
	handle_send_to_servers_log $handle $username $arg "dcc $idx"
	}

	+proc is_known_component {candidate} {
	+ # If "Dwellers" is a known component, are known:
	+ # - Dwellers
	+ # - Dwellers/DevCentral
	+
	+ foreach component [registry get serverslog.knowncomponents] {
	+ if {[regexp ^${component}(/.+)?$ $candidate]} {
	+ return 1
	+ }
	+ }
	+
	+ return 0
	+}
	+
	proc handle_send_to_servers_log {emitter source arg callback} {
	global network

	#Parse [component] entry
	if {[regexp "\\\[(.)\\\] (.)" $arg match component entry]} {
	add_to_servers_log $emitter "$network $source" $component $entry
	return 1
	} {
	putbymode $callback "use the format \[component\] message"
	return 0
	}
	}

	proc add_to_servers_log {emitter source component entry} {
	set request [dict2json "
	date [iso8601date]
	emitter $emitter
	source {$source}
	component $component
	entry {$entry}
	"]

	rest::simple https://api.nasqueron.org/servers-log/ {} {
	method PUT
	content-type application/json
	format json
	} $request
	}
	diff --git a/tests/ServersLog.test b/tests/ServersLog.test
	new file mode 100644
	index 0000000..635da1d
	--- /dev/null
	+++ b/tests/ServersLog.test
	@@ -0,0 +1,48 @@
	+package require tcltest
	+namespace import ::tcltest::*
	+
	+###
	+### Init
	+###
	+
	+# Tested code
	+source init.tcl
	+source $dir/Wearg/ServersLog.tcl
	+
	+###
	+### Mocks
	+###
	+
	+proc registry {command key {value ""}} {
	+ if {$command == "get" && $key == "serverslog.knowncomponents"} {
	+ return "Alpha Beta"
	+ }
	+
	+ error "Unexpected registry call: $command $key $value"
	+}
	+
	+###
	+### Tests
	+###
	+
	+test is_known_component_when_known {} -body {
	+ is_known_component Alpha
	+} -result 1
	+
	+test is_known_component_when_known_parent {} -body {
	+ is_known_component Beta/Delta
	+} -result 1
	+
	+test is_known_component_with_trailing_slash {} -body {
	+ is_known_component Beta/
	+} -result 0
	+
	+test is_known_component_when_unknown {} -body {
	+ is_known_component Gamma
	+} -result 0
	+
	+###
	+### Cleanup
	+###
	+
	+cleanupTests

File Metadata

Mime Type: text/x-diff
Expires: Sun, Nov 24, 23:56 (14 h, 7 m)
Storage Engine: blob
Storage Format: Raw Data
Storage Handle: 2259228
Default Alt Text: (3 KB)

No OneTemporary
Actions

View Options

File Metadata

Event Timeline

No OneTemporaryActions

View Options

File Metadata

Event Timeline

No OneTemporary
Actions