# CETK epic function/support script 0.9

unload cetk.functions
package cetk.functions

# General alias management.
#
alias alias.t {
	if ([$0] == aliasctl(alias match $0)) {
		@ :foo = loadinfo()
		xecho -banner -nolog -- WARNING: line $[-5]shift(foo) of $shift(foo) clobbers $0 from package $aliasctl(alias getpackage $0)
	}
	@ :alias = [$1-]
	@ :alias = [$0] && (J =~ [bitchx*] || [$1-] !~ [*\${t}*]) ? alias : sar(g/\${t}/$0/$alias)
	@ :rand  = rand(0)
	@ :saila = sar(g/\$/${rand}/$sar(g/*/_/$alias))
	@ :alias#= (saila =~ [*\;*] || saila =~ [*${rand}\\[$jot(0 9) _\\]*] || [$1] =~ [\(*]) ? [] : [ \$*\;]
	alias $0 $alias
}
alias alias.e alias.t $0 if (functioncall())\{return \$$1\($2- \$*\)\}\{$1-\ \$*\}
alias alias.pipel1 (args) alias.pipeln $shift(args) 0,1 $args
alias alias.pipeln (args) @:fn=shift(args),:ln=split(, $shift(args));alias.t $fn (args) @:fd=exec\($args\),:fdw=shift(fd),:fdr=shift(fd),:x=close($shift(fd)),:x=write($fdw $args),:x=close($fdw),:ret=readfdline\(\$fdr $ln\),close($fdr)\;if (functioncall()){return $ret}{xecho -banner -nolog -- $ret}
alias alias.pipew1 (args) alias.pipewn $shift(args) 0,1 $args
alias alias.pipewf (args) alias.t $shift(args) (args) @:fdr=exec\($args\),:x=close($pop(fdr)),:fdw=shift(fdr)\;fe args arg {@write($fdw $arg),arg=read($fdr)}\;@:x=close($fdw),:x=close($fdr)\;if (functioncall()){return $args}{xecho -banner -nolog -- $args}
alias alias.pipewn (args) @:fn=shift(args),:ln=split(, $shift(args));alias.t $fn (args) @:fdr=exec\($args\),:fdw=shift(fdr),:x=close($pop(fdr))\;fe args arg {@write($fdw $arg)}\;@:x=close($fdw),:ret=readfdline\(\$fdr $ln\),:x=close($fdr)\;if (functioncall()){return $ret}{xecho -banner -nolog -- $ret}
alias set if (getsets($0)) {//set $*} {xecho -banner -nolog -- WARNING: No such set $0}

# More general script management.
#
alias load {
	fe ($*) file {
		if (file =~ [-*]) {
			push :args $file
			continue
		}
		@ :path = which($file $getset(load_path))
		@ :time = stat($path)
		@ :time = word(11 $time)
		@ :path = encode($path)
		@ :args = args ? args : loaded[$path][a]
		if (time == loaded[$path][t] && args == loaded[$path][a]) {
			xecho -banner $repeat($loaded  )| $file $args
		} else {
			@ loaded[$path][t] = time
			@ loaded[$path][a] = args
			@ aliasctl(assign setpackage loaded.${path}.t -)
			@ aliasctl(assign setpackage loaded.${path}.a -)
			@ aliasctl(assign setpackage loaded -)
			xecho -banner $repeat(${loaded++}  )\\ $file $args
			//load $args $file
			xecho -banner $repeat(${--loaded}  )/ $file $args
			@ aliasctl(assign setpackage loaded -)
		}
	}
}
alias reload {foreach loaded file {load $decode($file)}}
alias addctcp (ctcp uwords 1, desc dwords 1, code) {
	fe ($split(, $ctcp)) ctcp {
		on -ctcp_request "% % $ctcp *" $code
		@ clientinfo[$encode($toupper($ctcp))] = desc
	}
}
on ?ctcp_request "% % clientinfo *" {
	if (2<cloak) {
		return 1
	} elsif ([$3-]) {
		@ :sn = servernick()
		foreach clientinfo foo {
			unless (rmatch($decode($foo) $3-)) {continue}
			q1cmd 5 9 ctcp.reply $0 $2 /ctcp $sn $decode($foo) : $clientinfo[$foo]
		}
		return 1
	} else {
		foreach clientinfo foo {push :clientinfo $decode($foo)}
		while (:len = indextoword(400 $clientinfo)) {
			q1cmd 5 9 ctcp.reply $0 $2 $splice(:clientinfo 0 $len)
		}
		q1cmd 5 9 ctcp.reply $0 $2 $clientinfo : Use CLIENTINFO * for all descriptions.
	}
}

# CTCP management commands.
fe (request msg reply notice) x y {alias.t ctcp.$x $y \$0 $chr(1)\$toupper($1) \$2-$chr(1)}
alias.t ctcp.notice (uh,nick,msg) {
	if (uh == userhost($nick)) {
		notice $nick $msg
	} else {
		defer qcmd
	}
}

# General one liners.
#
alias.t userchannels @:ret=[];fe ($mychannels()) chan {fe ($*) nick {if (onchannel($nick $chan)){@push(ret $chan)}}};return $suq($ret)
alias.t utimen (utime default $utime()) return $unsplit(. $shift(utime) $pad(-6 0 $shift(utime)))
alias.t utimeu (utime default $utime()) return $unsplit(_ $utime())
alias.t decode.mirc fe ($exec(uudecode -o -)) in out err {break};@close($err),write($in begin-base64 640 -),write($in $*),close($in),function_return=readfdall($out),close($out)
alias.t decodew decodewj ca
alias.t decodewj (dj,...) return $decode($unsplit("$dj" $*))
alias.t decodews decodewjs ca
alias.t decodewjs (dj,ds,...) return $decode($unsplit("$dj" $split("$ds" $*)))
alias.t dread 
alias.t encodel return $encode($tolower($*))
alias.t encodehl return ${255&hash_32bit($0)}.$encode($tolower($0))
alias.t encodew (ret) fe ret ret {@ret=encode($ret)};return $ret
alias.t setset @:foo=strip(- $0);@:bar=getset($foo);@function_return=@bar?[$foo $bar]:[-$foo];^set $*
alias.pipel1 md5l md5sum
alias.pipew1 md5w md5sum
alias.pipel1 sha1l sha1sum
alias.pipew1 sha1w sha1sum
alias.pipeln bcalc 0,99 bcalc
alias.pipeln mdc 0,99 dc

alias.t datetime {
	fe ($exec(date $*)) fd {
		push function_return $read($fd)
		@ close($fd)
	}
}

alias.t nickuserhost (nicks) {
	if (30<#nicks) {
		return $${t}($splice(nicks 0 ${#nicks / 2})) $${t}($nicks)
	}
	@ :sn = servernum()
	@ :omu = serverctl(get $sn maxuserhost), serverctl(set $sn maxuserhost 0)
	@ :unk = userhost(,)
	@ :uh = userhost($nicks)
	@ :uh1 = copattern($unk uh nicks)
	@ :uh1 = uh1 ? uh($uh1) : []
	@ serverctl(set $sn maxuserhost $omu)
	fe uh foo {
		@ foo = [$shift(nicks)!${foo == unk ? shift(uh1) : foo}]
	}
	return $uh
}
stack push alias alias.tt
alias.t alias.tt {
	fe (chanusers chops nochops chhops nochhops chvoices chnovoices) foo {
		alias.t $sar(g/FUNC/$foo/$*)
	}
}
alias.tt FUNCa eval return \$sort\(\$uniq\($replace(\$FUNC(xxx) xxx ${numwords($*)?pattern("\\[$*\\]" $mychannels()):mychannels()})\)\)
stack pop alias alias.tt
#alias.t isip4 (args) fe args foo {@foo=foo=~[*?.*?.*?.*?]&&foo!~[*.*.*.*.*]&&[]==strip(.0123456789 $foo)};return $args
alias.t isip6 (args) fe args foo {@foo=foo=~[*?:*?:*?:*?]&&foo!~[*:*:*:*:*:*:*:*:*]&&[]==strip(.:0123456789abcdef $foo)};return $args
alias.t isip4 (args) {
	@ :reg = regcomp(^[0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\$)
	fe args arg {
		@ :arg = !regexec($reg $arg)
	}
	@ regfree($reg)
	return $args
}
stack push alias alias.jot2expand
alias.t alias.jot2expand (args) {
	alias.t $args
	@ sar(gr/jot./expand./args)
	@ sar(gr/jot($base $mask)/[\$base \$mask]/args)
	alias.t $args
}
alias.jot2expand jot.cidr (args) {
	@ :oxd = xdebug(new_math)
	xdebug new_math
	fe args arg {
		@ arg = split(/ $arg/32)
		@ :base = iptolong($shift(arg))
		@ :mask = 0+0xffffffff >> shift(arg)
		#@ :mask |= mask+1
		@ :base &=~mask
		@ :mask |= base
		@ arg = jot($base $mask)
	}
	fe args arg {@ arg = longtoip($arg)}
	xdebug $oxd
	if (functioncall()) {
		return $args
	} else {
		echo $args
	}
}
stack pop alias alias.jot2expand
alias.t jot.ip (args) {
	fe args arg {
		@ arg = iptolong($arg)
	}
	fe args arg0 arg1 {
		@ arg0 = jot($arg0 $arg1), arg1 = []
	}
	fe args arg {
		@ arg = longtoip($arg)
	}
	if (functioncall()) {
		return $args
	} else {
		echo $args
	}
}
alias.t nuhmask (nm,um,hm,args) {
	while (isnumber(b10 $args)) {shift $args}
	@ :uc = jotc(azAZ09)
	@ :ip4 = [([0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)]
	@ :ip6 = [\($ip4|[0-9a-f]?[0-9a-f]?[0-9a-f]?[0-9a-f]?\)]
	@ :ip6 = [$ip6:$ip6:$ip6:$ip6\(:$ip6\(:$ip6\(:$ip6\(:$ip6\)?\)?\)?\)?]
	@ :reg4 = regcomp(^$ip4\$)
	@ :reg6 = regcomp(^$ip6\$)
	fe args arg {
		@ :nick = before(1 ! $arg)
		@ :user = after(1 ! $arg)
		@ :user = before(-1 @ $user)
		@ :host = after(-1 @ $arg)
		@ :nick = 0 == nm ? nick : [*]
		@ :user = 0 == um ? user : 1 == um && index($uc $user) ? left(1 $user)##[*] : [*]
		if (!hm) {
		} elsif (!regexec($reg4 $host)) {
			@ :host = abs($hm) > count(. $host) ? [*] : [$before(${0-hm} . $host).*]
		} elsif (!regexec($reg6 $host)) {
			@ :host = abs($hm) > count(: $host) ? [*] : [$before(${0-hm} : $host):*]
		} else {
			@ :host = abs($hm) > count(. $host) ? [*] : [*.$after($hm . $host)]
		}
		@ :arg = [$nick!$user@$host]
	}
	@ regfree($reg6)
	@ regfree($reg4)
	return $args
}
alias.t readfdlineall (fd, ar default "readfdlineall", sep, ...) {
	@ delarray($ar)
	until (eof($fd)) {
		@setitem($ar $numitems($ar) $read($fd))
	}
	@ function_return = listarray($ar $sep)
	@ delarray($ar)
}
alias.t readfdall (fd,...) {
	until (eof($fd)) {
		@function_return#=read($fd ${2**++:max})
	}
}
alias.t readfdline (fd,args) {
	fe args foo bar {
		if (eof($fd)) {
			@ foo = bar = []
			break
		} else {
			@ fskip($fd $foo), bar = repeat($bar x ), foo = []
			fe bar bar {
				@ bar = read($fd)
			}
		}
	}
	return $args
}
alias.t readline (args) {
	unless (#args%2) {
		push args 1
	}
	@ :files = glob($shift(args))
	fe files file {
		@ :reading = 0
		@ :fd = open($file r)
		if (functioncall()) {
			@ file = readfdline($fd $args)
		} else {
			while (!eof($fd)&&#args) {
				@ :line = 1 + shift(args)
				while (--line) {
					@ :read = read($fd)
					if (eof($fd)) {
						break
					} elsif (reading) {
						xecho -banner -nolog -- $read
					}
				}
				@ reading = !reading
			}
		}
		@ close($fd)
	}
	return $files
}
alias.t getopts (var, pref, string, ...) {
	while (:option = getopt(:optopt :optarg "$string" $*)) {
		switch ($option) {
			(-) {echo * option "$optopt" is missing an argument}
			(!) {push :unknown -$optopt}
			(*) {
				^assign -$pref$optopt
				push :optopts $encode(push $pref$optopt ${optarg?optarg:1})
			}
		}
	}
	push :optarg $:unknown
	return fe \($optopts $encode(eval @$var=decode\($encode($optarg)\))\) cmd {$decode($cmd)}
}

# Timer extensions.
#
alias.t timer.r {timer -rep -1 $*}
alias.t timer.date (date qwords 1, args) {timer ${datetime(+%s -d $date) - time()} $args}
alias.t timer.dump {
	echo $strftime(%F %T) $attr.bold($timerctl(refnums))
	fe ($timerctl(refnums)) ref {
		@ :print = [repeats interval server window command subargs]
		fe print print {
			@ :print = [$attr.bold($print) $timerctl(get $ref $print)]
		}
		echo $strftime($word(0 $timerctl(get $ref timeout)) %F %T) $ref $print
	}
}

# Word generation.
#
alias.t word.dict (args) {
	@ :n = isnumber(b10 $args) ? shift(args) : 1
	@ :ret = repeat($n  .)
	@ :dict = args ? shift(args) : [/usr/share/dict/words]
	fe ret foo {
		@ foo = randread($dict)
	}
	if (functioncall()) {
		return $ret
	} else {
		xecho -banner -- $ret
	}
}
alias.t word.permute (args) {
	@ :len = isnumber(b10 $args) ? shift(args) : numwords($args)
	@ :chars = args ? shift(args) : chr($jot($ascii(az)))
	if (0 < --len) {
		@ :args = args ? args : chars
		@ :wordl = ${t}($len $args)
		fec chars char {
			@ :words = wordl
			fe words word {
				@ word = [$char$word]
			}
			@ char = [$words ]
		}
	} else {
		@ chars = chr($unsplit(" 32 " $ascii($chars)))
	}
	if (functioncall()) {
		return $chars
	} else {
		echo $chars
	}
}
alias.t word.rand (args) {
	@ :num = isnumber(b10 $args) ? shift(args) : 1
	@ :len = isnumber(b10 $args) ? shift(args) : rand(9)
	@ :chars = args ? shift(args) : jotc(az)
	@ :clen = strlen($chars)
	@ :ret = repeat($num $repeat($len ,) )
	fe ret word {
		fec word chr {
			@ chr = mid($rand($clen) 1 $chars)
		}
	}
	if (functioncall()) {
		return $ret
	} else {
		echo $ret
	}
}
alias.t word.randsel {
	if (functioncall()) {
		return $word($rand($#) $*)
	} else {
		echo $word($rand($#) $*)
	}
}
alias.t word.gen (args) {
	@ :num = isnumber(b10 $args) ? shift(args) : 1
	@ :ret = repeat($num  .)
	fe ret ret {
		@ :last = ret = []
		do {
			@ :rn=[]
			@ :rand = 1 + rand($wordgen[$last])
			foreach wordgen[$last] this {
				if (rand<=(rn+=wordgen[$last][$this])) {break}
			}
			@ ret#= last = this
		} while (last != [])
		@ ret = decode($ret)
	}
	if (functioncall()) {
		return $ret
	} else {
		xecho -banner -- $ret
	}
}
alias.t word.gen.seed {
	fe ($*) word {
		@ :last = []
		fec ($encode($word)) foo0 foo1 {
			@ ++wordgen[$last][$foo0$foo1]
			@ ++wordgen[$last]
			@ last = foo0##foo1
		}
		@ ++wordgen[$last][]
		@ ++wordgen[$last]
	}
}