convert.tcl
#### convert.tcl v1.0.1 ########################################################
################################################################################
## Written by: ##
## KuNgFo0 (http://www.eggfaq.com/). ##
## ##
## Modified by: ##
## Brian Schmidt aka. brianMan. ##
################################################################################
#### Readme / Help #############################################################
################################################################################
## This script is ripped from KuNgFoO's ib.tcl v3.19 (infobot) script. ##
## ##
## The script converts between a number of various units, for more speficic ##
## information on which untis you should please refer to the source of this ##
## script. ##
## ##
## Usage: ##
## To have the .conv[ert] commands available on a channel you need to set ##
## the channel flag +convert from the console/partyline . ##
## ``.chanset #channel +convert´´ ##
## ##
## Channel Commands (available only if channel is +convert): ##
## .conv[ert] to ##
## Example: ##
## ``.conv 20 C to F´´ ##
## Converts 20 degrees Celcius to it's Fahrenheit equivilant. ##
################################################################################
#### Changelog #################################################################
################################################################################
## v1.0.1 ##
## * Minor code cleanup ##
## ##
## v1.0.0 ##
## + Initial release. ##
## * Changed the default trigger ``botname, conv[ert]´´ to ``.con[vert]´´ ##
## + Added the possibility to control which channels could use the commands ##
## with the channel flag ``+/-convert´´ ##
################################################################################
bind pub - .conv pub_conv
bind pub - .convert pub_conv
bind msg - conv msg_conv
bind msg - convert msg_conv
# Set the name of the channelflag used to tell whether the convert command is
# enabled or not for that specific channel.
set conv_channel_flag "convert"
setudef flag $conv_channel_flag
# Set the next line as the exec command to run the 'units' command from the shell
# Note: Not all systems will have this installed
# Set to "" to disable
set conv_units_exec "units -v"
# Conversion formulas - each array is for its own dimension (length, volume, etc).
# Each unit is converted to a standard type by multiplying the value by the factors
# below. It is then converted from the standard type to any other unit by
# dividing the factors. The standard unit used must be the same for everything in
# each dimension, and can be anything as long as they are the same. I used the root
# metric units for most things (meters, liters, grams, etc).
# Note: All strings are matched as regular expressions
# * Prefix with (?c) for units that should be case sensitive
# * Prefix with (.*?) for metric units
# * Append (?:s) for units with an optional plural ending, etc
# * Only use multiplication and division in the formulas, no addition or subtraction
# * It's a very good idea to have all the formulas return values in decimal form
# ("1" doesn't matter, though)
# Syntax:
# name abbreviation factor
set conv_unit(length) {
(.*?)meter(?:s)? (.*?)m 1
inch(?:es)? in {2.54 / 100}
foot|feet ft {2.54 / 100 * 12}
mile(?:s)? mi {2.54 / 100 * 12 * 5280}
}
set conv_unit(volume) {
(.*?)liter(?:s)? (.*?)L 1
pint(?:s)? pt {3.785 / 8}
quart(?:s)? qt {3.785 / 4}
gallon(?:s)? gal 3.785
}
set conv_unit(weight) {
(.*?)gram(?:s)? (.*?)g 1
ounce(?:s)? oz 28.35
pound(?:s)? lbs 453.59
ton(?:s)? T {453.59 * 2000}
}
set conv_unit(work) {
(.*?)joule(?:s)? (.*?)J 1
(.*?)watt-?second(?:s)? (.*?)w-?s 1
(.*?)watt-?hour(?:s)? (.*?)w-?hrs 3600.0
britishthermalunit(?:s)? btu 1055.056
calorie(?:s)? cal 4.1868
foot-?pound(?:s)? ft-?lbs 1.356
electron-?volt(?:s)? eV 1.6021917E-19
}
set conv_unit(power) {
(.*?)watt(?:s)? (.*?)w 1
volt-?amp(?:s)? va 1
horsepower hp 746
}
set conv_unit(time) {
(.*?)second(?:s)? (.*?)s(?:ec(?:s)?)? 1
minute(?:s)? min(?:s)? 60.0
hour(?:s)? h(?:r(?:s)?)? {60.0 * 60}
day(?:s)? {} {60.0 * 60 * 24}
week(?:s)? wk(?:s)? {60.0 * 60 * 24 * 7}
year(?:s)? yr(?:s)? {60.0 * 60 * 24 * 365}
decade(?:s)? {} {60.0 * 60 * 24 * 365 * 10}
century|centuries {} {60.0 * 60 * 24 * 365 * 100}
}
set conv_unit(binary) {
option metric 2
(.*?)byte(?:s)? (.*?)b 1
(.*?)bit(?:s)? {} {1.0 / 8}
}
# Misc conversion formulas - these are types that cannot
# be converted by regular multiplication/division of factors.
# The principle is the same as the formulas above, however
# the arrays are broken down into *_from and *_to variables.
# Note: $value is used as the value being converted.
set conv_misc_from(num) {
option metric 0
integer|int {} {[scan $value "%d"]}
long {} {[scan $value "%u"]}
decimal|dec|float|double {} {[scan $value "%f"]}
octal|oct {} {[scan $value "%o"]}
hexadecimal|hex {} {[scan $value "%x"]}
binary|bin {} {[bin2int $value]}
ip {} {[ip2long $value]}
rgb {} {[rgb2int $value]}
}
set conv_misc_to(num) {
option metric 0
integer|int {} {[format "%d" [conv_int $value]]}
long {} {[format "%u" [conv_int $value]]}
decimal|dec|float|double {} {[format "%f" $value]}
octal|oct {} {[format "%o" [conv_int $value]]}
hexadecimal|hex {} {[format "%X" [conv_int $value]]}
binary|bin {} {[int2bin [conv_int $value]]}
ip {} {[long2ip [conv_int $value]]}
rgb {} {[int2rgb [conv_int $value]]}
}
set conv_misc_from(temperature) {
option metric 0
fahrenheit F {($value - 32) * 5 / 9.0}
kelvin K {$value - 273.15}
celsius|centigrade C {$value}
}
set conv_misc_to(temperature) {
option metric 0
fahrenheit F {(9 / 5.0 * $value) + 32}
kelvin K {$value + 273.15}
celsius|centigrade C {$value}
}
# Conversion strings to specificially ignore (that conflict with expr)
set conv_ignore {
e abs acos asin
atan atan2 ceil
cos cosh double
exp floor fmod
hypot int log
log10 pow rand
round sin sinh
sqrt srand tan
tanh
}
# Metric conversion factors
# Note: Abbreviations are case sensitive here
# Syntax:
# mame abbreviation factor
set conv_metric {
Yotta Y 24
Zetta Z 21
Exa E 18
Peta P 15
Tera T 12
Giga G 9
Mega M 6
Kilo k 3
Hecto h 2
Deca dk 1
Deci d -1
Centi c -2
Milli m -3
Micro µ -6
Nano n -9
Pico p -12
Femto f -15
Atto a -18
Zepto z -21
Yocto y -24
}
proc xrange {xr xr1 xr2} {
return [join [lrange [split $xr] $xr1 $xr2]]
}
proc anymatch {string1 string2} {
foreach string $string2 {
if {[lsearch -exact [string tolower $string1] [string tolower $string]] != -1} {
return 1
}
}
return 0
}
proc conv_fixtopic {arg} {
regsub -all {[\\\{\}\[\]\"]} $arg {} arg ; # Bad characters
regsub -all {(\s)+} $arg {\1} arg ; # Double whitespace
regsub -all {^\s*|\s*$} $arg {} arg ; # Whitespace at ends
return $arg
}
proc conv_fixdata {arg output} {
global botnick
if {[string index $output 0] != "#"} {
regsub -all -nocase {$output's} $arg "your" arg
}
regsub -all -nocase {$botnick's} $arg "my" arg
return $arg
}
proc conv_msg {targets arg} {
foreach target $targets {
puthelp "PRIVMSG $target :[conv_fixdata $arg $target]"
}
}
proc conv_fixexpr {exp} {
global ib_const
set exp [conv_fixtopic $exp]
foreach i [array names ib_const] {
regsub -all "\%$i" $exp $ib_const($i) exp
}
return $exp
}
# Begin conversion code
proc int2bin {int} {
return [format "%s.%s.%s.%s" \
[byte2bin [expr ($int >> 24) & 0xff]] \
[byte2bin [expr ($int >> 16) & 0xff]] \
[byte2bin [expr ($int >> 8) & 0xff]] \
[byte2bin [expr $int & 0xff]]]
}
proc byte2bin {byte} {
set result ""
for {set i 0} {$i < 8} {incr i} {
append result [expr ($byte & 128) >> 7]
set byte [expr $byte << 1]
}
return $result
}
proc bin2int {bin} {
set result 0
for {set i 0} {$i < [string length $bin]} {incr i} {
if {([set digit [string index $bin $i]] == 0) || ($digit == 1)} {
set result [expr $result << 1 | $digit]
} elseif {$digit == "."} {
#ignore
} else {
set result ""
}
}
return $result
}
proc ip2long {ip} {
if {[scan $ip "%d.%d.%d.%d" a b c d] == 4} {
foreach i "$a $b $c $d" {
if {($i > 255) || ($i < 0)} {
return ""
}
}
set long [expr $a << 24 | $b << 16 | $c << 8 | $d]
if {$long < 0} {
set long [expr pow(2, 32) + $long]
}
return $long
} else {
return ""
}
}
proc long2ip {long} {
return [format "%d.%d.%d.%d" \
[expr ($long >> 24) & 0xff] \
[expr ($long >> 16) & 0xff] \
[expr ($long >> 8) & 0xff] \
[expr $long & 0xff]]
}
proc rgb2int {rgb} {
if {[scan $rgb "%d.%d.%d" red green blue] == 3} { return [expr $red << 16 | $green << 8 | $blue << 0] } \
else { return "" }
}
proc int2rgb {long} {
return [format "%d.%d.%d" \
[expr ($long >> 16) & 0xff] \
[expr ($long >> 8) & 0xff] \
[expr $long & 0xff]]
}
# expr's abs() and int() can't handle large unsigned integers,
# these functions are just to get around this
proc conv_int {value} {
return [lindex [split $value "."] 0]
}
proc conv_abs {value} {
return [string trimleft $value "-"]
}
proc conv_absint {value} {
return [conv_int [conv_abs $value]]
}
proc conv_units {value type1 type2} {
global conv_units_exec
regsub -all {'} [conv_fixtopic $type1] {} type1
regsub -all {'} [conv_fixtopic $type2] {} type2
if {[catch {exec bash -c "$conv_units_exec '$value $type1' '$type2'"} output]} {
error $output
}
foreach line [split $output \n] {
if {[regexp -- {^\s*([^=]+=.+)$} $line tmp result]} {
return $result
}
}
error "unknown response from units command"
}
proc conv_scan {var_formula var_unit index} {
global conv_ignore conv_unit
upvar 1 $var_formula formula $var_unit unit
set string {([a-z]+(-[a-z]+)?)}
if {[regexp -nocase -start $index -- $string $formula a unit]} {
if {[lsearch -exact $conv_ignore $unit] != -1} {
# Ignore this unit and search for the next unit
regexp -nocase -start $index -indices $string -- $formula a index
return [conv_scan "formula" "unit" [expr [lindex $index 1] + 1]]
} else {
# Found unit, return ok
return 1
}
}
# No more units found
return 0
}
# $var will be either unit, misc_from, or misc_to
proc conv {value unit var lists} {
global conv_$var
upvar 1 list uplist
if {![info exists uplist]} {
set uplist ""
}
set type [expr {($var == "unit") || ($var == "misc_from") ? "*" : "/"}]
# First we check full names, then abbreviations
foreach method {name abbv} {
foreach list $lists {
# Default options
set option_absint 0
set option_metric 1
foreach {name abbv formula} [set conv_$var\($list)] {
if {$name == "option"} {
set option_$abbv $formula
} elseif {[regexp -nocase -- "^([set $method])\$" $unit a b prefix]} {
set uplist $list
if {([catch {expr $formula} value]) || ($value == "")} {
error "evaluating expression for '$unit'"
}
if {$option_absint} {
set value [conv_absint $value]
}
if {($option_metric) && ($prefix != "") && ([catch {expr [conv_metric $prefix $method $option_metric] $type $value} value])} {
error "evaluating metric conversion for '$unit'"
}
return $value
}
}
}
}
error "unknown conversion type '$unit'"
}
# $method will be either "name" or "abbv"
# $option will be either 1 or 2
proc conv_metric {prefix method option} {
global conv_metric
foreach {name abbv factor} $conv_metric {
if {(($method == "name") && ([string equal -nocase $name $prefix])) || (($method == "abbv") && ([string equal $abbv $prefix]))} {
if {$option == 1} {
return [expr pow(10, $factor)] ; # Regular metric
} elseif {$option == 2} {
return [expr pow(2, ($factor / 3 * 10))] ; # Binary conversion
}
}
}
error "unknown metric prefix"
}
# End conversion code
# Begin Public binds code
proc msg_conv {nick uhost hand arg} {
global botnick
pub_conv $nick $uhost $hand "" $arg
}
proc pub_conv {nick uhost hand chan arg} {
global botnick value global conv_channel_flag
global conv_units_exec conv_unit conv_misc_from conv_misc_to
if {(![isbotnick $nick]) && (![matchattr $hand +b])} {
if {(![string match "$chan" ""]) && (![channel get $chan $conv_channel_flag])} {
return 0 ; # If command comes from a channel, and that channel doesn't have +convert then ignore
}
set isuser [expr {[matchattr $hand - $chan] || [matchattr $hand -]}] ; # Note that $chan might be "", so we must handle both cases
if {([validchan $chan]) && ($isuser)} {
set output1 $chan ; # The bot sends the text to the channel for users
} else {
set output1 $nick ; # Non-users get privmsg'd
}
if {[set i [string last ">" $arg]] == -1} {
set output2 $output1 ; # By default, output2 (~stdout~) goes to output1 (~stderr~)
} else {
# Output has been redirected
if {(!$isuser) || ([set output2 [string trim [string range $arg [expr $i + 1] end] " "]] == "")} {
set output2 $output1 ; # Error (User doesn't have access, or output was ""), so we go back to the default
}
set arg [string trim [string range $arg 0 [expr $i - 1]] " "]
}
set remainder [xrange $arg 0 end]
if {(([scan $remainder "%s from %s to %s" value type1 type2] != 3) || ([anymatch [list $value $type1 $type2] {from to}])) && \
(([scan $remainder "%s from %s %s" value type1 type2] != 3) || ([anymatch [list $value $type1 $type2] {from to}])) && \
(([scan $remainder "%s %s to %s" value type1 type2] != 3) || ([anymatch [list $value $type1 $type2] {from to}])) && \
(([scan $remainder "%s %s %s" value type1 type2] != 3) || ([anymatch [list $value $type1 $type2] {from to}])) && \
((([info exists value]) && ([unset value] == "")) || 1) && \
(([scan $remainder "from %s to %s" type1 type2] != 2) || ([anymatch [list $type1 $type2] {from to}])) && \
(([scan $remainder "from %s %s" type1 type2] != 2) || ([anymatch [list $type1 $type2] {from to}])) && \
(([scan $remainder "%s to %s" type1 type2] != 2) || ([anymatch [list $type1 $type2] {from to}])) && \
(([scan $remainder "%s %s" type1 type2] != 2) || ([anymatch [list $type1 $type2] {from to}]))} {
conv_msg $output1 "error parsing sentence"
} else {
if {![info exists value]} {
set value 1
}
if {![catch {conv $value $type1 "misc_from" [array names conv_misc_from]} type1_value]} {
if {[catch {conv $type1_value $type2 "misc_to" $list} type2_value]} {
conv_msg $output1 "error $type2_value"
} else {
conv_msg $output2 "$value $type1 = $type2_value $type2"
}
} elseif {($conv_units_exec != "") && (![catch {conv_units $value $type1 $type2} output])} {
conv_msg $output2 $output
} else {
set type1_formula $type1
set type2_formula $type2
set found 0
while 1 {
if {[conv_scan "type1_formula" "type1_unit" 0]} {
if {![conv_scan "type2_formula" "type2_unit" 0]} {
conv_msg $output1 "error unmatched type '$type1_unit'"
} elseif {[catch {conv 1 $type1_unit "unit" [array names conv_unit]} type1_value]} {
conv_msg $output1 "error $type1_value"
} elseif {![regsub -nocase $type1_unit $type1_formula $type1_value type1_formula]} {
conv_msg $output1 "error decompiling expression '$type1_unit'"
} elseif {[catch {conv 1 $type2_unit "unit" $list} type2_value]} {
conv_msg $output1 "error $type2_value"
} elseif {![regsub -nocase $type2_unit $type2_formula $type2_value type2_formula]} {
conv_msg $output1 "error decompiling expression '$type2_unit'"
} else {
incr found
continue
}
} elseif {[conv_scan "type2_formula" "type2_unit" 0]} {
conv_msg $output1 "error unmatched type '$type2_unit'"
} else {
break
} ; # At the end, so stop
return ; # We got an error somewhere, bail out
}
if {!$found} {
conv_msg $output1 "error no conversion types found"
} elseif {[catch {expr [conv_fixexpr "($value) * ($type1_formula) / ($type2_formula)"]} value2]} {
conv_msg $output1 "error evaluating expression"
} else {
conv_msg $output2 "$value $type1 = $value2 $type2"
}
}
}
}
}
# End Public binds code
# Init stuff
if {[catch {package require Tcl 8.3} error]} {
putlog "error TCL v8.3 or higher is required to run this script"
return 0
}
putlog "*** LOADED: convert.tcl"
################################################################################
## Written by: ##
## KuNgFo0 (http://www.eggfaq.com/). ##
## ##
## Modified by: ##
## Brian Schmidt aka. brianMan. ##
################################################################################
#### Readme / Help #############################################################
################################################################################
## This script is ripped from KuNgFoO's ib.tcl v3.19 (infobot) script. ##
## ##
## The script converts between a number of various units, for more speficic ##
## information on which untis you should please refer to the source of this ##
## script. ##
## ##
## Usage: ##
## To have the .conv[ert] commands available on a channel you need to set ##
## the channel flag +convert from the console/partyline . ##
## ``.chanset #channel +convert´´ ##
## ##
## Channel Commands (available only if channel is +convert): ##
## .conv[ert] to ##
## Example: ##
## ``.conv 20 C to F´´ ##
## Converts 20 degrees Celcius to it's Fahrenheit equivilant. ##
################################################################################
#### Changelog #################################################################
################################################################################
## v1.0.1 ##
## * Minor code cleanup ##
## ##
## v1.0.0 ##
## + Initial release. ##
## * Changed the default trigger ``botname, conv[ert]´´ to ``.con[vert]´´ ##
## + Added the possibility to control which channels could use the commands ##
## with the channel flag ``+/-convert´´ ##
################################################################################
bind pub - .conv pub_conv
bind pub - .convert pub_conv
bind msg - conv msg_conv
bind msg - convert msg_conv
# Set the name of the channelflag used to tell whether the convert command is
# enabled or not for that specific channel.
set conv_channel_flag "convert"
setudef flag $conv_channel_flag
# Set the next line as the exec command to run the 'units' command from the shell
# Note: Not all systems will have this installed
# Set to "" to disable
set conv_units_exec "units -v"
# Conversion formulas - each array is for its own dimension (length, volume, etc).
# Each unit is converted to a standard type by multiplying the value by the factors
# below. It is then converted from the standard type to any other unit by
# dividing the factors. The standard unit used must be the same for everything in
# each dimension, and can be anything as long as they are the same. I used the root
# metric units for most things (meters, liters, grams, etc).
# Note: All strings are matched as regular expressions
# * Prefix with (?c) for units that should be case sensitive
# * Prefix with (.*?) for metric units
# * Append (?:s) for units with an optional plural ending, etc
# * Only use multiplication and division in the formulas, no addition or subtraction
# * It's a very good idea to have all the formulas return values in decimal form
# ("1" doesn't matter, though)
# Syntax:
# name abbreviation factor
set conv_unit(length) {
(.*?)meter(?:s)? (.*?)m 1
inch(?:es)? in {2.54 / 100}
foot|feet ft {2.54 / 100 * 12}
mile(?:s)? mi {2.54 / 100 * 12 * 5280}
}
set conv_unit(volume) {
(.*?)liter(?:s)? (.*?)L 1
pint(?:s)? pt {3.785 / 8}
quart(?:s)? qt {3.785 / 4}
gallon(?:s)? gal 3.785
}
set conv_unit(weight) {
(.*?)gram(?:s)? (.*?)g 1
ounce(?:s)? oz 28.35
pound(?:s)? lbs 453.59
ton(?:s)? T {453.59 * 2000}
}
set conv_unit(work) {
(.*?)joule(?:s)? (.*?)J 1
(.*?)watt-?second(?:s)? (.*?)w-?s 1
(.*?)watt-?hour(?:s)? (.*?)w-?hrs 3600.0
britishthermalunit(?:s)? btu 1055.056
calorie(?:s)? cal 4.1868
foot-?pound(?:s)? ft-?lbs 1.356
electron-?volt(?:s)? eV 1.6021917E-19
}
set conv_unit(power) {
(.*?)watt(?:s)? (.*?)w 1
volt-?amp(?:s)? va 1
horsepower hp 746
}
set conv_unit(time) {
(.*?)second(?:s)? (.*?)s(?:ec(?:s)?)? 1
minute(?:s)? min(?:s)? 60.0
hour(?:s)? h(?:r(?:s)?)? {60.0 * 60}
day(?:s)? {} {60.0 * 60 * 24}
week(?:s)? wk(?:s)? {60.0 * 60 * 24 * 7}
year(?:s)? yr(?:s)? {60.0 * 60 * 24 * 365}
decade(?:s)? {} {60.0 * 60 * 24 * 365 * 10}
century|centuries {} {60.0 * 60 * 24 * 365 * 100}
}
set conv_unit(binary) {
option metric 2
(.*?)byte(?:s)? (.*?)b 1
(.*?)bit(?:s)? {} {1.0 / 8}
}
# Misc conversion formulas - these are types that cannot
# be converted by regular multiplication/division of factors.
# The principle is the same as the formulas above, however
# the arrays are broken down into *_from and *_to variables.
# Note: $value is used as the value being converted.
set conv_misc_from(num) {
option metric 0
integer|int {} {[scan $value "%d"]}
long {} {[scan $value "%u"]}
decimal|dec|float|double {} {[scan $value "%f"]}
octal|oct {} {[scan $value "%o"]}
hexadecimal|hex {} {[scan $value "%x"]}
binary|bin {} {[bin2int $value]}
ip {} {[ip2long $value]}
rgb {} {[rgb2int $value]}
}
set conv_misc_to(num) {
option metric 0
integer|int {} {[format "%d" [conv_int $value]]}
long {} {[format "%u" [conv_int $value]]}
decimal|dec|float|double {} {[format "%f" $value]}
octal|oct {} {[format "%o" [conv_int $value]]}
hexadecimal|hex {} {[format "%X" [conv_int $value]]}
binary|bin {} {[int2bin [conv_int $value]]}
ip {} {[long2ip [conv_int $value]]}
rgb {} {[int2rgb [conv_int $value]]}
}
set conv_misc_from(temperature) {
option metric 0
fahrenheit F {($value - 32) * 5 / 9.0}
kelvin K {$value - 273.15}
celsius|centigrade C {$value}
}
set conv_misc_to(temperature) {
option metric 0
fahrenheit F {(9 / 5.0 * $value) + 32}
kelvin K {$value + 273.15}
celsius|centigrade C {$value}
}
# Conversion strings to specificially ignore (that conflict with expr)
set conv_ignore {
e abs acos asin
atan atan2 ceil
cos cosh double
exp floor fmod
hypot int log
log10 pow rand
round sin sinh
sqrt srand tan
tanh
}
# Metric conversion factors
# Note: Abbreviations are case sensitive here
# Syntax:
# mame abbreviation factor
set conv_metric {
Yotta Y 24
Zetta Z 21
Exa E 18
Peta P 15
Tera T 12
Giga G 9
Mega M 6
Kilo k 3
Hecto h 2
Deca dk 1
Deci d -1
Centi c -2
Milli m -3
Micro µ -6
Nano n -9
Pico p -12
Femto f -15
Atto a -18
Zepto z -21
Yocto y -24
}
proc xrange {xr xr1 xr2} {
return [join [lrange [split $xr] $xr1 $xr2]]
}
proc anymatch {string1 string2} {
foreach string $string2 {
if {[lsearch -exact [string tolower $string1] [string tolower $string]] != -1} {
return 1
}
}
return 0
}
proc conv_fixtopic {arg} {
regsub -all {[\\\{\}\[\]\"]} $arg {} arg ; # Bad characters
regsub -all {(\s)+} $arg {\1} arg ; # Double whitespace
regsub -all {^\s*|\s*$} $arg {} arg ; # Whitespace at ends
return $arg
}
proc conv_fixdata {arg output} {
global botnick
if {[string index $output 0] != "#"} {
regsub -all -nocase {$output's} $arg "your" arg
}
regsub -all -nocase {$botnick's} $arg "my" arg
return $arg
}
proc conv_msg {targets arg} {
foreach target $targets {
puthelp "PRIVMSG $target :[conv_fixdata $arg $target]"
}
}
proc conv_fixexpr {exp} {
global ib_const
set exp [conv_fixtopic $exp]
foreach i [array names ib_const] {
regsub -all "\%$i" $exp $ib_const($i) exp
}
return $exp
}
# Begin conversion code
proc int2bin {int} {
return [format "%s.%s.%s.%s" \
[byte2bin [expr ($int >> 24) & 0xff]] \
[byte2bin [expr ($int >> 16) & 0xff]] \
[byte2bin [expr ($int >> 8) & 0xff]] \
[byte2bin [expr $int & 0xff]]]
}
proc byte2bin {byte} {
set result ""
for {set i 0} {$i < 8} {incr i} {
append result [expr ($byte & 128) >> 7]
set byte [expr $byte << 1]
}
return $result
}
proc bin2int {bin} {
set result 0
for {set i 0} {$i < [string length $bin]} {incr i} {
if {([set digit [string index $bin $i]] == 0) || ($digit == 1)} {
set result [expr $result << 1 | $digit]
} elseif {$digit == "."} {
#ignore
} else {
set result ""
}
}
return $result
}
proc ip2long {ip} {
if {[scan $ip "%d.%d.%d.%d" a b c d] == 4} {
foreach i "$a $b $c $d" {
if {($i > 255) || ($i < 0)} {
return ""
}
}
set long [expr $a << 24 | $b << 16 | $c << 8 | $d]
if {$long < 0} {
set long [expr pow(2, 32) + $long]
}
return $long
} else {
return ""
}
}
proc long2ip {long} {
return [format "%d.%d.%d.%d" \
[expr ($long >> 24) & 0xff] \
[expr ($long >> 16) & 0xff] \
[expr ($long >> 8) & 0xff] \
[expr $long & 0xff]]
}
proc rgb2int {rgb} {
if {[scan $rgb "%d.%d.%d" red green blue] == 3} { return [expr $red << 16 | $green << 8 | $blue << 0] } \
else { return "" }
}
proc int2rgb {long} {
return [format "%d.%d.%d" \
[expr ($long >> 16) & 0xff] \
[expr ($long >> 8) & 0xff] \
[expr $long & 0xff]]
}
# expr's abs() and int() can't handle large unsigned integers,
# these functions are just to get around this
proc conv_int {value} {
return [lindex [split $value "."] 0]
}
proc conv_abs {value} {
return [string trimleft $value "-"]
}
proc conv_absint {value} {
return [conv_int [conv_abs $value]]
}
proc conv_units {value type1 type2} {
global conv_units_exec
regsub -all {'} [conv_fixtopic $type1] {} type1
regsub -all {'} [conv_fixtopic $type2] {} type2
if {[catch {exec bash -c "$conv_units_exec '$value $type1' '$type2'"} output]} {
error $output
}
foreach line [split $output \n] {
if {[regexp -- {^\s*([^=]+=.+)$} $line tmp result]} {
return $result
}
}
error "unknown response from units command"
}
proc conv_scan {var_formula var_unit index} {
global conv_ignore conv_unit
upvar 1 $var_formula formula $var_unit unit
set string {([a-z]+(-[a-z]+)?)}
if {[regexp -nocase -start $index -- $string $formula a unit]} {
if {[lsearch -exact $conv_ignore $unit] != -1} {
# Ignore this unit and search for the next unit
regexp -nocase -start $index -indices $string -- $formula a index
return [conv_scan "formula" "unit" [expr [lindex $index 1] + 1]]
} else {
# Found unit, return ok
return 1
}
}
# No more units found
return 0
}
# $var will be either unit, misc_from, or misc_to
proc conv {value unit var lists} {
global conv_$var
upvar 1 list uplist
if {![info exists uplist]} {
set uplist ""
}
set type [expr {($var == "unit") || ($var == "misc_from") ? "*" : "/"}]
# First we check full names, then abbreviations
foreach method {name abbv} {
foreach list $lists {
# Default options
set option_absint 0
set option_metric 1
foreach {name abbv formula} [set conv_$var\($list)] {
if {$name == "option"} {
set option_$abbv $formula
} elseif {[regexp -nocase -- "^([set $method])\$" $unit a b prefix]} {
set uplist $list
if {([catch {expr $formula} value]) || ($value == "")} {
error "evaluating expression for '$unit'"
}
if {$option_absint} {
set value [conv_absint $value]
}
if {($option_metric) && ($prefix != "") && ([catch {expr [conv_metric $prefix $method $option_metric] $type $value} value])} {
error "evaluating metric conversion for '$unit'"
}
return $value
}
}
}
}
error "unknown conversion type '$unit'"
}
# $method will be either "name" or "abbv"
# $option will be either 1 or 2
proc conv_metric {prefix method option} {
global conv_metric
foreach {name abbv factor} $conv_metric {
if {(($method == "name") && ([string equal -nocase $name $prefix])) || (($method == "abbv") && ([string equal $abbv $prefix]))} {
if {$option == 1} {
return [expr pow(10, $factor)] ; # Regular metric
} elseif {$option == 2} {
return [expr pow(2, ($factor / 3 * 10))] ; # Binary conversion
}
}
}
error "unknown metric prefix"
}
# End conversion code
# Begin Public binds code
proc msg_conv {nick uhost hand arg} {
global botnick
pub_conv $nick $uhost $hand "" $arg
}
proc pub_conv {nick uhost hand chan arg} {
global botnick value global conv_channel_flag
global conv_units_exec conv_unit conv_misc_from conv_misc_to
if {(![isbotnick $nick]) && (![matchattr $hand +b])} {
if {(![string match "$chan" ""]) && (![channel get $chan $conv_channel_flag])} {
return 0 ; # If command comes from a channel, and that channel doesn't have +convert then ignore
}
set isuser [expr {[matchattr $hand - $chan] || [matchattr $hand -]}] ; # Note that $chan might be "", so we must handle both cases
if {([validchan $chan]) && ($isuser)} {
set output1 $chan ; # The bot sends the text to the channel for users
} else {
set output1 $nick ; # Non-users get privmsg'd
}
if {[set i [string last ">" $arg]] == -1} {
set output2 $output1 ; # By default, output2 (~stdout~) goes to output1 (~stderr~)
} else {
# Output has been redirected
if {(!$isuser) || ([set output2 [string trim [string range $arg [expr $i + 1] end] " "]] == "")} {
set output2 $output1 ; # Error (User doesn't have access, or output was ""), so we go back to the default
}
set arg [string trim [string range $arg 0 [expr $i - 1]] " "]
}
set remainder [xrange $arg 0 end]
if {(([scan $remainder "%s from %s to %s" value type1 type2] != 3) || ([anymatch [list $value $type1 $type2] {from to}])) && \
(([scan $remainder "%s from %s %s" value type1 type2] != 3) || ([anymatch [list $value $type1 $type2] {from to}])) && \
(([scan $remainder "%s %s to %s" value type1 type2] != 3) || ([anymatch [list $value $type1 $type2] {from to}])) && \
(([scan $remainder "%s %s %s" value type1 type2] != 3) || ([anymatch [list $value $type1 $type2] {from to}])) && \
((([info exists value]) && ([unset value] == "")) || 1) && \
(([scan $remainder "from %s to %s" type1 type2] != 2) || ([anymatch [list $type1 $type2] {from to}])) && \
(([scan $remainder "from %s %s" type1 type2] != 2) || ([anymatch [list $type1 $type2] {from to}])) && \
(([scan $remainder "%s to %s" type1 type2] != 2) || ([anymatch [list $type1 $type2] {from to}])) && \
(([scan $remainder "%s %s" type1 type2] != 2) || ([anymatch [list $type1 $type2] {from to}]))} {
conv_msg $output1 "error parsing sentence"
} else {
if {![info exists value]} {
set value 1
}
if {![catch {conv $value $type1 "misc_from" [array names conv_misc_from]} type1_value]} {
if {[catch {conv $type1_value $type2 "misc_to" $list} type2_value]} {
conv_msg $output1 "error $type2_value"
} else {
conv_msg $output2 "$value $type1 = $type2_value $type2"
}
} elseif {($conv_units_exec != "") && (![catch {conv_units $value $type1 $type2} output])} {
conv_msg $output2 $output
} else {
set type1_formula $type1
set type2_formula $type2
set found 0
while 1 {
if {[conv_scan "type1_formula" "type1_unit" 0]} {
if {![conv_scan "type2_formula" "type2_unit" 0]} {
conv_msg $output1 "error unmatched type '$type1_unit'"
} elseif {[catch {conv 1 $type1_unit "unit" [array names conv_unit]} type1_value]} {
conv_msg $output1 "error $type1_value"
} elseif {![regsub -nocase $type1_unit $type1_formula $type1_value type1_formula]} {
conv_msg $output1 "error decompiling expression '$type1_unit'"
} elseif {[catch {conv 1 $type2_unit "unit" $list} type2_value]} {
conv_msg $output1 "error $type2_value"
} elseif {![regsub -nocase $type2_unit $type2_formula $type2_value type2_formula]} {
conv_msg $output1 "error decompiling expression '$type2_unit'"
} else {
incr found
continue
}
} elseif {[conv_scan "type2_formula" "type2_unit" 0]} {
conv_msg $output1 "error unmatched type '$type2_unit'"
} else {
break
} ; # At the end, so stop
return ; # We got an error somewhere, bail out
}
if {!$found} {
conv_msg $output1 "error no conversion types found"
} elseif {[catch {expr [conv_fixexpr "($value) * ($type1_formula) / ($type2_formula)"]} value2]} {
conv_msg $output1 "error evaluating expression"
} else {
conv_msg $output2 "$value $type1 = $value2 $type2"
}
}
}
}
}
# End Public binds code
# Init stuff
if {[catch {package require Tcl 8.3} error]} {
putlog "error TCL v8.3 or higher is required to run this script"
return 0
}
putlog "*** LOADED: convert.tcl"
