Please suggest what else this script needs:)
Code: Select all
########### yhoo.tcl ver. 0.1 by SpiKe^^ ########## 08Apr2023 ###########
#### public yhoo.tcl command ####
# command syntax: !yh <symbol>
# example: !yh csl
# .q gm
######################################################
namespace eval yhoo { variable yh
package require Tcl 8.5
package require http
package require tls
setudef flag yhoo ;# <= Use .chanset #chan +yhoo to enable this script by channel.
################### begin settings ###################
# set active channel(s) for this script (or set empty to only use .chanset #ch +yhoo)
# or use: set yh(chan) "*" to make the script active in all bot channels.
# note: the channels set here can not be disabled by using .chanset #ch -yhoo
set yh(chan) "*"
# Command Char(s) to use for public binds
# Examples: "!" or "."
# Or a Space Separated List: "! . ?"
set yh(cmdchars) "! ."
# set public Stock/Futures/Crypto Quote Command(s): #
# This command shows current price & change, plus recent stats. #
set yh(cmds_q) "q quote yh"
# set public Custom Command Triggers: () #
set yh(cust_cmds) {
gold au go GC=F
silver ag si sil silv SI=F
crude cr cru crud crudeoil CL=F
eur eurusd eur/usd EURUSD=X
gbp gbpusd gbp/usd GBPUSD=X
usdjpy usd/jpy JPY=X
bitcoin btc btcusd BTC-USD
ethereum eth ethusd ETH-USD
dogecoin doge dog dogeusd DOGE-USD
s&p500 s&p snp500 snp ^GSPC
dow dow30 dowjones ^DJI
} ;# End of: set yh(cust_cmds) #
# script logo (placed before almost every line sent to the channel)
set yh(logo) "\00306\[yhoo\]\003 "
############ end settings ############ end settings ############
################################################################
#############################
::http::register https 443 {::tls::socket -autoservername true}
##############
proc bindpubm {nk uh hn ch tx} { variable yh
set c [slower $ch]
if {![channel get $ch yhoo] && ("*" ni $yh(chan)) && ($c ni $yh(chan))} {
return 0
}
set tls [lassign [split [set tx [strim $tx]]] cmd arg1]
set cm [string range $cmd 1 end]
if {[set x [lsearch -nocase -inline $yh(cust_cmds) "* $cm *"]] ne ""} {
set custln [split [string trim $x]]
set arg1 [lindex $custln end]
set cm [lindex $yh(cmds_q) 0] ; set cmd "[string index $cmd 0]${cm}"
}
set allcmds [concat $yh(cmds_q) $yh(cmds_fq)]
if {[lsearch -nocase $allcmds $cm] == -1} { return 0 }
set sym [supper $arg1]
if {$arg1 eq "" || [string length $arg1]>10 || [regexp {[^0-9A-Z^.=-]} $sym]} {
set say "$yh(logo)Command syntax: \002$cmd <symbol>\002"
puthelp "PRIVMSG $ch :$say example: \002$cmd csl\002"
return 0
}
if {[matchstr "*=F" $sym]} { set doing "f"
} elseif {[matchstr "^*" $sym]} { set doing "i"
} elseif {[matchstr "*=X" $sym]} { set doing "x"
} else { set doing "" }
set fq [::http::formatQuery p $sym]
set pr "https://" ; set la "" ; set ar "finance." ; set do "yahoo.com"
set addr "${pr}${la}${ar}${do}" ;#https://finance.yahoo.com ;#https://au.finance.yahoo.com
set address "${addr}/quote/[lindex [split $fq =] 1]?${fq}"
#######################################
set uagent "Mozilla/5.0 (X11; Linux i686; rv:2.0.1) Gecko/20100101 Firefox/4.0.1"
set emap [list "\n" " | "]
foreach try {1 2} { ::http::config -useragent $uagent
if {[catch {::http::geturl $address -timeout 7500} tok]} {
set err "1 ::http::geturl error: [string map $emap $tok]"
} elseif {[::http::status $tok] ne "ok"} {
set err "2 TCP error: [::http::status $tok]"
} else { set ncode [::http::ncode $tok]
if {($try == 1 && $ncode ni {200 302}) || ($try == 2 && $ncode != 200)} {
set err "3 HTTP error: [::http::code $tok]"
}
}
if {$try == 1 && [info exists ncode] && $ncode == 302} {
upvar #0 $tok state
if {[dict exists $state(meta) location]} {
set loc [dict get $state(meta) location]
if {[matchstr /lookup* $loc]} { set address "${addr}$loc"
::http::cleanup $tok ; unset tok ; unset ncode
continue
}
set err "5 Redirect error: state(meta) 'location' not as expected ( $loc )."
} else {
set err "4 Redirect error: Unable to find 'location' in state(meta)."
}
}
break
}
if {[info exists err]} { putlog "$yh(logo) [string range $err 2 end]"
if {[string index $err 0] > 1} { ::http::cleanup $tok }
puthelp "PRIVMSG $ch :$yh(logo)Unable to get the requested data. Try again later."
return 0
}
##########################################
set html [::http::data $tok] ; ::http::cleanup $tok
#set open [open scripts/yhoo.html.txt w]; puts $open $html; close $open
#putlog "wrote file: scripts/yhoo.html.txt"
set html [split $html "\n"]
if {$try == 1 && $doing eq ""} {
if {[matchstr "*cryptocurrency*" [lindex $html 0]]} { set doing "c" }
}
set html [lrange $html 4 36]
if {$try == 2} { set similarto "" ; set allcount "" ; set simdict {}
set html [join $html {}]
if {[regexp {\"lookup-page\"(.*?)</tbody></table>} $html - html]} {
regexp {<h2 [^<]+<span>(.*?)</span></h2>(.*)$} $html - similarto html
regexp {\"/lookup/all[^<]+<span>(.*?)</span></a></li>(.*)$} $html - allcount html
set similarto [lindex [split $similarto] end]
set allcount [lindex [split $allcount "()"] 1]
if {$similarto eq "" || $allcount eq ""} {
puthelp "PRIVMSG $ch :$yh(logo)Unable to get the requested data."
return 0
}
set re {<td class=\"data-col0[^>]+>[^>]+>(.*?)</a></td>[^>]+>(.*?)</td>(.*)$}
while {[dict size $simdict] < 5} {
if {![regexp $re $html - ssym sname html]} { break }
dict set simdict $ssym $sname
}
set say "$yh(logo)Symbol Lookup >"
if {[set dsize [dict size $simdict]] == 0} {
puthelp "PRIVMSG $ch :$say Found no symbols similar to: \002${sym}\002"
return 0
}
if {$dsize == 1} { append say " Found one symbol similar to '${sym}':"
puthelp "PRIVMSG $ch :$say \002${ssym}\002 $sname"
return 0
}
if {$dsize <= 3} { append say " Found $dsize symbols similar to '${sym}':"
} else { append say " Found $allcount symbols similar to '${sym}'." }
if {$allcount > 5} { append say " Showing the first 5:"
} elseif {$allcount > 3} { append say " Showing all of them:" }
dict for {sy co} $simdict { append say " \002${sy}\002 $co" }
puthelp "PRIVMSG $ch :$say"
} else { puthelp "PRIVMSG $ch :$yh(logo)Unable to get the similar symbol list."
putlog "$yh(logo) Html source error: Unable to find the similar symbol list."
}
return 0
}
##########################################
set company "" ; set xinfo "" ; set sp { }
set fnd 0
foreach hline $html {
if {![matchstr "$sp<*" $hline] && ![matchstr "$sp \;*" $hline]} { continue }
set hline [string trimleft $hline]
if {$fnd == 0 && [matchstr "[string repeat </div> 7]<div *" $hline]} {
regexp {<h1 class=\"D\(ib\) Fz\(18px\)\">(.*?)</h1>(.*)$} $hline - company hline
regexp {^</div>[^>]+><span>(.*?)</span>(.*)$} $hline - xinfo hline
if {$company eq "" || $xinfo eq ""} {
puthelp "PRIVMSG $ch :$yh(logo)Invalid Company Symbol: \002${sym}\002"
return 0
}
set qmap [list %nk $nk %ch $ch %co $company %xi $xinfo] ; set fnd 1
set ils {lastprice change percent notice prevclose prevc_txt open open_txt bid bid_txt}
lappend ils ask ask_txt dayrange dayra_txt 52weeks 52wee_txt volume volum_txt
lappend ils avgvolume avgvo_txt marketcap marke_txt 5year 5year_txt peratio perat_txt
lappend ils epsratio epsra_txt
# crypto only #
lappend ils startdate start_txt algorithm algor_txt cirsupply cirsu_txt
lappend ils maxsupply maxsu_txt vol24hr vol24_txt volall volal_txt
# futures only #
lappend ils prevsett prevs_txt datesett dates_txt lprice lpric_txt
# ETF (exchange-traded funds) only #
lappend ils netassets netas_txt nav nav_txt yield yield_txt
foreach vname $ils { set $vname "" }
regexp {regularMarketPrice[^>]+>(.*?)</fin-str(.*)$} $hline - lastprice hline
regexp {regularMarketChange[^>]+><[^>]+>(.*?)</span(.*)$} $hline - change hline
regexp {rMarketChangePercent[^>]+><[^>]+>(.*?)</span(.*)$} $hline - percent hline
regexp {quote-market-notice[^>]+><span>(.*?)</span>(.*)$} $hline - notice hline
if {[matchstr "-*" $change]} {
set change "\00304$change\003" ; set percent "\00304$percent\003"
} elseif {[matchstr "+*" $change]} {
set change "\00303$change\003" ; set percent "\00303$percent\003"
} else { set change "\00312$change\003" ; set percent "\00312$percent\003" }
set notice [string map [list " " " "] $notice]
lappend qmap %la $lastprice %lc $change %lp $percent %ln $notice
foreach vname {postprice preprice pchange ppercent pn_txt pn_time pnotice} {
set $vname ""
}
set re {MarketPrice[^>]+>(.*?)</fin-streame(.*)$}
if {[regexp pre$re $hline - preprice hline]} {
set tm preMarket ; lappend pmap %pm $preprice
} elseif {[regexp post$re $hline - postprice hline]} {
set tm postMarket ; lappend pmap %pm $postprice
}
if {[info exists pmap]} {
regexp "${tm}Change\"\[^<\]+<\[^>\]+>(.*?)</span>(.*)\$" $hline - pchange hline
regexp "${tm}ChangePercent\[^<\]+<\[^>\]+>(.*?)</span>(.*)\$" $hline - ppercent hline
regexp {^</fi[^<]+</span><br/><[^<]+<span>(.*?)</span>(.*)$} $hline - pn_txt hline
regexp "${tm}Time\"\[^>\]+>(.*?)</fin-streamer>(.*)\$" $hline - pn_time hline
if {[matchstr "-*" $pchange]} { set p1 "\00304" ; set pe "\003"
set pchange "\00304$pchange\003" ; set ppercent "\00304$ppercent\003"
} elseif {[matchstr "+*" $pchange]} { set p1 "\00303" ; set pe "\003"
set pchange "\00303$pchange\003" ; set ppercent "\00303$ppercent\003"
} else { set p1 "\00312" ; set pe "\003"
set pchange "\00312$pchange\003" ; set ppercent "\00312$ppercent\003" }
set pnotice "$pn_txt $pn_time"
lappend pmap %pc $pchange %pp $ppercent %px $pn_txt %pt $pn_time %pn $pnotice
lappend pmap %p1 $p1 %pe $pe
}
} elseif {$fnd == 1 && [matchstr ";</script></div></div></div></div><scr*" $hline]} {
set re {summary-table\"><table[^<]+<tbody>(.*?)</tbody></table></div>(.*)$}
if {[regexp left-$re $hline - rs hline]} { append rows $rs }
if {[regexp right-$re $hline - rs hline]} { append rows $rs }
if {[info exists rows]} { set cnt 0
while {[regexp {^<tr (.*?)></tr>(.*)$} $rows - rw rows]} { incr cnt
if {[regexp {<span>(.*?)</span></td><td.*?data-test=(.*)</td$} $rw - lang val]} {
set val [join [lassign [split $val ">"] name] ">"]
set name [string trim $name "\""]
if {[matchstr "<fin-str*" $val]} {
regexp {^<[^>]+>(.*)</fin-streamer>$} $val - val
} elseif {[matchstr "<span>*" $val]} {
set val [string map [list </span> "" <span> ""] $val]
}
set got 0
#### crypto only ####
if {$doing eq "c"} {
switch $name {
"START_DATE-value" { lappend qmap %sd $val %sx $lang
set startdate $val ; set start_txt $lang ; set got 1 }
"ALGORITHM-value" { lappend qmap %al $val %ax $lang
set algorithm $val ; set algor_txt $lang ; set got 2 }
"CIRCULATING_SUPPLY-value" { lappend qmap %is $val %ix $lang
set cirsupply $val ; set cirsu_txt $lang ; set got 3 }
"MAX_SUPPLY-value" { lappend qmap %xs $val %xx $lang
set maxsupply $val ; set maxsu_txt $lang ; set got 4 }
"TD_VOLUME_24HR-value" { lappend qmap %td $val %tx $lang
set vol24hr $val ; set vol24_txt $lang ; set got 5 }
"TD_VOLUME_24HR_ALLCURRENCY-value" { lappend qmap %rr $val %rx $lang
set volall $val ; set volal_txt $lang ; set got 6 }
}
if {$cnt >= 12 && $got > 0} { break }
#### futures only ####
} elseif {$doing eq "f"} {
switch $name {
"PREV_SETTLEMENT_DATE-value" { lappend qmap %rs $val %rx $lang
set prevsett $val ; set prevs_txt $lang ; set got 1 }
"SETTLEMENT_DATE-value" { lappend qmap %sd $val %sx $lang
set datesett $val ; set dates_txt $lang ; set got 2 }
"LAST_PRICE-value" { lappend qmap %tp $val %tx $lang
set lprice $val ; set lpric_txt $lang ; set got 3 }
}
if {$cnt >= 8 && $got > 0} { break }
#### ETF (exchange-traded funds) only ####
} elseif {$doing eq "e"} {
switch $name {
"NAV-value" { lappend qmap %na $val %nx $lang
set nav $val ; set nav_txt $lang ; set got 1 }
"TD_YIELD-value" { lappend qmap %yd $val %yx $lang
set yield $val ; set yield_txt $lang ; set got 2 }
}
if {$cnt >= 12 && $got > 0} { break }
}
if {$got > 0} { continue }
switch $name {
"PREV_CLOSE-value" { lappend qmap %cl $val %cx $lang
set prevclose $val ; set prevc_txt $lang }
"OPEN-value" { lappend qmap %op $val %ox $lang
set open $val ; set open_txt $lang }
"BID-value" { lappend qmap %bi $val %bx $lang
set bid $val ; set bid_txt $lang }
"ASK-value" { lappend qmap %as $val %ax $lang
set ask $val ; set ask_txt $lang }
"DAYS_RANGE-value" { lappend qmap %dr $val %dx $lang
set dayrange $val ; set dayra_txt $lang }
"FIFTY_TWO_WK_RANGE-value" { lappend qmap %wr $val %wx $lang
set 52weeks $val ; set 52wee_txt $lang }
"TD_VOLUME-value" { lappend qmap %vo $val %vx $lang
set volume $val ; set volum_txt $lang }
"AVERAGE_VOLUME_3MONTH-value" { lappend qmap %gv $val %gx $lang
set avgvolume $val ; set avgvo_txt $lang }
"MARKET_CAP-value" { lappend qmap %mc $val %mx $lang
set marketcap $val ; set marke_txt $lang
if {$doing eq ""} { set doing s }
}
"NET_ASSETS-value" { lappend qmap %ss $val %sx $lang
set netassets $val ; set netas_txt $lang
if {$doing eq ""} { set doing e }
}
"BETA_5Y-value" { lappend qmap %5y $val %5x $lang
set 5year $val ; set 5year_txt $lang }
"PE_RATIO-value" { lappend qmap %ra $val %rx $lang
set peratio $val ; set perat_txt $lang }
"EPS_RATIO-value" { lappend qmap %er $val %ex $lang
set epsratio $val ; set epsra_txt $lang }
}
}
if {$cnt >= 12} { break }
}
}
set fnd 2 ; break
}
}
#################################################################
set hmap [list "'" "'" "'" "'" "&" "&" """ "\""]
########## data substitution codes ##########
###############################################
# %nk = nick ex. GreedyHamster
# %ch = channel ex. #MarketHub
# %co = company name ex. Apollo Minerals Limited (AON.AX)
# %xi = exchange info ex. ASX - ASX Delayed price. Currency in AUD
# %la = last price ex. 108.66
# %lc = price change ex. -0.08
# %lp = change percent ex. (-0.07%)
# %ln = market notice ex. As of 10:17AM AEDT. Market open.
# %pm = post/pre market ex. 108.62 (these 6 exist if is post or pre)
# %pc = post/pre change ex. -0.04
# %pp = post/pre percent ex. (-0.03%)
# %pn = post/pre notice ex. After hours: 07:59PM EST
# %px = post/pre text ex. After hours: |OR| Pre-Market:
# %pt = post/pre time ex. 07:59PM EST
# %p1 = change color ex. \00304
# %pe = end color ex. \003
# %cl = previous close ex. 108.74
# %cx ex. Previous Close
# %op = open ex. 108.74
# %ox ex. Open
# %bi = bid ex. 108.66 x 36400
# %bx ex. Bid
# %as = ask ex. 108.69 x 7100
# %ax ex. Ask
# %dr = day's range ex. 108.38 - 109.15
# %dx ex. Day's Range
# %wr = 52-week range ex. 86.98 - 109.20
# %wx ex. 52 Week Range
# %vo = volume ex. 3,747,153
# %vx ex. Volume
# %gv = avg. volume ex. 2,190,023
# %gx ex. Avg. Volume
# %mc = market cap ex. 183.463B
# %mx ex. Market Cap
# %5y = 5y monthly ex. 2.36
# %5x ex. Beta (5Y Monthly)
# %ra = pe ratio ex. 5.48
# %rx ex. PE Ratio (TTM)
# %er = eps ratio ex. 8.36
# %ex ex. EPS (TTM)
#### crypto only ####
# %sd = start date ex. 2010-07-13
# %sx ex. Start Date
# %al = algorithm ex. N/A
# %ax ex. Algorithm
# %is = circ. supply ex. 19.34M
# %ix ex. Circulating Supply
# %xs = max supply ex. N/A
# %xx ex. Max Supply
# %td = today volume ex. 16.23B
# %tx ex. Volume (24hr)
# %rr = vol. all curr. ex. 16.23B
# %rx ex. Volume (24hr) All Currencies
#### futures only ####
# %rs = prev settlement ex. N/A
# %rx ex. Pre. Settlement
# %sd = settlement date ex. 2023-05-26
# %sx ex. Settlement Date
# %tp = last price ex. 25.09
# %tx ex. Last Price
###############################################
#################################################################
set s "$yh(logo)%co %xi. \002%la %lc %lp\002 %ln"
if {[info exists pmap]} { set tm " %p1\002\[\[\002%pe%px "
append s [string map $pmap "$tm\002%pm %pc %pp\002 At: %pt%p1\002\]\]\002%pe"]
}
lappend say $s
if {$doing eq "c"} { ;## crypto (second line) ##
set s "%cx: \002%cl\002 %ox: \002%op\002 %dx: \002%dr\002 "
append s "%wx: \002%wr\002 %mx: \002%mc\002 %vx: \002%vo\002"
} elseif {$doing eq "f"} { ;## future (second line) ##
set s "%tx: \002%tp\002 %sx: \002%sd\002 %ox: \002%op\002 %bx: \002%bi\002"
append s " %ax: \002%as\002 %dx: \002%dr\002 %vx: \002%vo\002"
} elseif {$doing eq "i"} { ;## index (second line) ##
set s "%cx: \002%cl\002 %ox: \002%op\002 %vx: \002%vo\002 "
append s "%dx: \002%dr\002 %wx: \002%wr\002 %gx: \002%gv\002"
} elseif {$doing eq "x"} { ;## exchange rate (second line) ##
set s "%cx: \002%cl\002 %ox: \002%op\002 %bx: \002%bi\002 "
append s "%ax: \002%as\002 %dx: \002%dr\002 %wx: \002%wr\002"
} else {
set s "%cx: \002%cl\002 %ox: \002%op\002 %bx: \002%bi\002 "
append s "%ax: \002%as\002 %dx: \002%dr\002 %vx: \002%vo\002 "
if {$doing eq "e"} { append s "%yx: \002%yd\002" ;# if is "e" (ETF) #
} else { append s "%mx: \002%mc\002" } ;# else is "s" (stocks) #
}
lappend say $s
foreach ln $say {
set ln [string map $qmap $ln] ; set ln [string map $hmap $ln]
putserv "PRIVMSG $ch :$ln"
}
return 0
} ;# end: proc bindpubm #
##############
#############################
proc strim {str} {
return [regsub -all -- {\s{2,}} [string trim $str] { }]
}
proc sdigit {str} { return [string is digit -strict $str] }
proc slower {str} { return [string tolower $str] }
proc supper {str} { return [string toupper $str] }
#############################
# unused setting variables #
set yh(companylist_filename) "scripts/yhoo.companylist.txt"
set yh(cmds_fq) ""
proc onsource {} { variable yh
set yh(chan) [split [slower [strim $yh(chan)]]]
set yh(companylist_filename) [strim $yh(companylist_filename)]
set yh(companydict) [dict create]
if {[file exists $yh(companylist_filename)]} {
set open [open $yh(companylist_filename) r]
set yh(companydict) [read -nonewline $open] ; close $open
}
foreach x {cmdchars cmds_q cmds_fq} {
set yh($x) [split [strim $yh($x)]]
}
foreach ybind [binds [namespace current]::bindpubm] {
lassign $ybind t f n h p ; unbind $t $f $n $p
}
foreach char $yh(cmdchars) {
bind pubm * "?%~\\${char}*" [namespace current]::bindpubm
}
set tmpls [split [slower [string trim $yh(cust_cmds)]] "\n"] ; set newls {}
foreach ln $tmpls { set ln [strim $ln]
if {[llength [split $ln]] < 2} { continue }
lappend newls " $ln "
}
set yh(cust_cmds) $newls
}
onsource
putlog "Loaded yhoo.tcl version 0.1 08Apr2023"
} ;## end of: namespace eval yhoo ##
Eggdrop community