a table script

Football · Post by **Football** » Tue Feb 17, 2009 2:07 pm

A TCL script that when someone types !Table it will private message him with the table that appears in this link: http://www.skysports.com/football/leagu ... 60,00.html

but also an option to see only parts from the table like !Table 1-4 to see Top 4 teams, !Table 7-10 Teams placed 7-10th in the table, and etc.. anyone please?

tomekk · Post by **tomekk** » Wed Feb 18, 2009 5:01 pm

try:

Code: Select all

# Author: tomekk
# e-mail:  tomekk/@/oswiecim/./eu/./org
# home page: http://tomekk.oswiecim.eu.org/
#
# Version 0.1
#
# This file is Copyrighted under the GNU Public License.
# http://www.gnu.org/copyleft/gpl.html

# !table channels 
set table_chans {#channel1 #channel2}

#######################################################################
bind pub -|- !table show_table

package require http

proc get_table { } {
	set http_uagent "Opera/9.61 (Windows i686; U; en) Presto/2.1.1"
	set http_token [http::config -useragent $http_uagent]
	if {[catch {set http_token [::http::geturl "http://www.skysports.com/football/league/0,19540,11660,00.html" -timeout 10000]}]} {
		return "error"
	} {
		return [http::data $http_token]
	}
}

proc show_table { nick uhost hand chan arg } {
	global table_chans

	if {[lsearch $table_chans $chan] == -1} {
                return
        }

	set poss [lindex [split $arg] 0]

	if {$poss != ""} {
		if {[regexp {^[0-9]+$} $poss]} {
			set start_pos $poss
			set end_pos $poss

			if {($start_pos > 20) || ($end_pos > 20)} {
				putquick "PRIVMSG $nick :max is 20, sorry"
				return
			}
		}

		if {[regexp {^[0-9]+\-[0-9]+$} $poss]} {
			set split_pos [split $poss "-"]
	        	set start_pos [lindex $split_pos 0]
			set end_pos [lindex $split_pos 1]

			if {($start_pos > 20) || ($end_pos > 20)} {
				 putquick "PRIVMSG $nick :max is 20, sorry"
				 return
			}
		}
	} {
		set start_pos 1
		set end_pos 20
	}

	if {$start_pos > $end_pos} {
		putquick "PRIVMSG $nick :first argument must be lower than second ie. 1-20, not 20-1"
		return
	}

	set all [get_table]

	if {$all == "error"} {
		putquick "PRIVMSG $nick :problem with connection, try again later, sorry"
		return
	}

	regsub -all "\n" $all "" all
	regsub -all "\t" $all "" all

	# some number before team name
	regsub -all -nocase {<tr(\s+|[a-zA-Z=\"\- ]+)>\s+<td>(\d+|\-\d+)<\/td>} $all "" all
	
	# team points
	regsub -all -nocase {<td>(\d+|\-\d+)<\/td>} $all {<pkt>\1</pkt>} all

	# team name, 1st tag
	regsub -all -nocase {<td><a\s+href=\"\/football\/team\/0,\d+,\d+,00\.html\">} $all "<team_title>" all

	# <team> team name here </team>
	regsub -all -nocase {<team_title>([a-zA-Z ]+)</a></td>} $all {<team>\1</team>} all

	# new line marks
	regsub -all "<team>" $all "\n<team>" all
	regsub -all "<\/team>" $all "<team>\n" all

	regsub -all "<pkt>" $all "\n<pkt>" all
	regsub -all "<\/pkt>" $all "<pkt>\n" all

	set team_pos 1
	set team_idx 0
	set team_list [list]

	putquick "PRIVMSG $nick :Pos | Team | P | W | D | L | F | A | GD | PTS"
	putquick "PRIVMSG $nick :---------------------------------------------"

	# "clean" team names, points
	foreach a [split $all "\n"] {
		if {[string match *<team>* $a]} {
			regsub -all "<team>" $a "" a
			regsub -all "<\/team>" $a "" a
			lappend team_list $a
			incr team_idx 1
		}

		if {[string match *<pkt>* $a]} {
			regsub -all "<pkt>" $a "" a
                	regsub -all "<\/pkt>" $a "" a
			lappend team_list $a
			incr team_idx 1
		}

		if {$team_idx == 9} {
			if {($team_pos >= $start_pos) && ($team_pos <= $end_pos)} {
				putquick "PRIVMSG $nick :$team_pos|[join $team_list "|"]"
			}
			set team_list [list]
			set team_idx 0
			incr team_pos 1
		}
	}
}

putlog "football-table.tcl ver 0.1 by tomekk loaded"

!table - will show all positions 1-20
!table 2 - will show only second position
!table 4-6 - will show positions from 4 to 6

Felix2003 · Post by **Felix2003** » Wed Feb 18, 2009 11:04 pm

this works perfectly thank you

Football · Post by **Football** » Thu Feb 19, 2009 6:22 am

hi tomekk, thank you very much for dedecating the time and effort in building that script, I haven't checked it yet, but it will be very very useful thank you very much! I was wondering if you might be interested in building a few more tcl script challenges I need?

Football · Post by **Football** » Thu Feb 19, 2009 3:08 pm

hey tomekk is it possible for you to add an option that if you type !Table <team> like !Table Arsenal, it will give it's details just like if you type !table 1 or etc?

Felix2003 · Post by **Felix2003** » Thu Feb 19, 2009 6:38 pm

hello tomekk hope tyou dont mind but i had a fiddle with your script

Code: Select all

# Author: tomekk
# e-mail:  tomekk/@/oswiecim/./eu/./org
# home page: http://tomekk.oswiecim.eu.org/
#
# Version 0.1
#
# This file is Copyrighted under the GNU Public License.
# http://www.gnu.org/copyleft/gpl.html

# !table channels
set table_chans {#chan #chan2}

#######################################################################
bind pub -|- !table show_table

package require http

proc get_table { } {
   set http_uagent "Opera/9.61 (Windows i686; U; en) Presto/2.1.1"
   set http_token [http::config -useragent $http_uagent]
   if {[catch {set http_token [::http::geturl "http://www.skysports.com/football/league/0,19540,11660,00.html" -timeout 10000]}]} {
      return "error"
   } {
      return [http::data $http_token]
   }
}

proc show_table { nick uhost hand chan arg } {
   global table_chans

   if {[lsearch $table_chans $chan] == -1} {
                return
        }

   set poss [lindex [split $arg] 0]

   if {$poss != ""} {
      if {[regexp {^[0-9]+$} $poss]} {
         set start_pos $poss
         set end_pos $poss

         if {($start_pos > 20) || ($end_pos > 20)} {
            putquick "PRIVMSG $nick :Sorry $nick The max is 20"
            return
         }
      }

      if {[regexp {^[0-9]+\-[0-9]+$} $poss]} {
         set split_pos [split $poss "-"]
              set start_pos [lindex $split_pos 0]
         set end_pos [lindex $split_pos 1]

         if {($start_pos > 20) || ($end_pos > 20)} {
             putquick "PRIVMSG $nick :Sorry $nick The max is 20"
             return
         }
      }
   } {
      set start_pos 1
      set end_pos 20
   }

   if {$start_pos > $end_pos} {
      putquick "PRIVMSG $nick :Sorry $nick The first argument must be lower than second ie. 1-20, not 20-1"
      return
   }

   set all [get_table]

   if {$all == "error"} {
      putquick "PRIVMSG $nick :Sorry $nick Theres a small problem with connection, try again later, Thanks :-)"
      return
   }

   regsub -all "\n" $all "" all
   regsub -all "\t" $all "" all

   # some number before team name
   regsub -all -nocase {<tr(\s+|[a-zA-Z=\"\- ]+)>\s+<td>(\d+|\-\d+)<\/td>} $all " " all
   
   # team points
   regsub -all -nocase {<td>(\d+|\-\d+)<\/td>} $all {<pkt>\1</pkt>} all

   # team name, 1st tag
   regsub -all -nocase {<td><a\s+href=\"\/football\/team\/0,\d+,\d+,00\.html\">} $all "<team_title> " all

   # <team> team name here </team>
   regsub -all -nocase {<team_title>([a-zA-Z ]+)</a></td>} $all {<team>\1</team>} all

   # new line marks
   regsub -all "<team>" $all "\n <team> " all
   regsub -all "<\/team>" $all "<team>\n" all

   regsub -all "<pkt>" $all "\n <pkt> " all
   regsub -all "<\/pkt>" $all " <pkt> \n" all

   set team_pos 1
   set team_idx 0
   set team_list [list]

   putquick "PRIVMSG $nick :Pos | Team | P | W | D | L | F | A | GD | PTS"
   putquick "PRIVMSG $nick :---------------------------------------------"

   # "clean" team names, points
   foreach a [split $all "\n"] {
      if {[string match *<team>* $a]} {
         regsub -all "<team>" $a "" a
         regsub -all "<\/team>" $a "" a
         lappend team_list $a
         incr team_idx 1
      }

      if {[string match *<pkt>* $a]} {
         regsub -all "<pkt>" $a "" a
                   regsub -all "<\/pkt>" $a "" a
         lappend team_list $a
         incr team_idx 1
      }

      if {$team_idx == 9} {
         if {($team_pos >= $start_pos) && ($team_pos <= $end_pos)} {
            putquick "PRIVMSG $nick :$team_pos|[join $team_list "|"]"
            putquick "PRIVMSG $nick :---------------------------------------------"
         }
         set team_list [list]
         set team_idx 0
         incr team_pos 1
      }
   }
}

putlog "football-table.tcl ver 0.1 by tomekk loaded"

this now displays

[10:32:23pm] <FelixBot> Pos | Team | P | W | D | L | F | A | GD | PTS
[10:32:23pm] <FelixBot> ---------------------------------------------
[10:32:23pm] <FelixBot> 10| Fulham| 24 | 7 | 9 | 8 | 22 | 22 | 0 | 30
[10:32:23pm] <FelixBot> ---------------------------------------------
[10:32:25pm] <FelixBot> 11| Sunderland| 25 | 8 | 6 | 11 | 27 | 33 | -6 | 30
[10:32:27pm] <FelixBot> ---------------------------------------------
[10:32:29pm] <FelixBot> 12| Hull City| 25 | 7 | 8 | 10 | 31 | 46 | -15 | 29
[10:32:31pm] <FelixBot> 13| Newcastle United| 25 | 6 | 9 | 10 | 33 | 42 | -9 | 27
[10:32:33pm] <FelixBot> 14| Bolton Wanderers| 25 | 8 | 3 | 14 | 27 | 37 | -10 | 27
[10:32:35pm] <FelixBot> 15| Portsmouth| 25 | 7 | 6 | 12 | 27 | 41 | -14 | 27

instead of

[10:19:23pm] <FelixBot> Pos | Team | P | W | D | L | F | A | GD | PTS
[10:19:23pm] <FelixBot> ---------------------------------------------
[10:19:23pm] <FelixBot> 10|Fulham|24|7|9|8|22|22|0|30
[10:19:23pm] <FelixBot> 11|Sunderland|25|8|6|11|27|33|-6|30
[10:19:24pm] <FelixBot> 12|Hull City|25|7|8|10|31|46|-15|29
[10:19:26pm] <FelixBot> 13|Newcastle United|25|6|9|10|33|42|-9|27
[10:19:28pm] <FelixBot> 14|Bolton Wanderers|25|8|3|14|27|37|-10|27
[10:19:30pm] <FelixBot> 15|Portsmouth|25|7|6|12|27|41|-14|27

which i think makes it look more cleaner and easier to understand the only problem is i cant get --------------------------------------------- to display after every line on the table any ideas?

tomekk · Post by **tomekk** » Fri Feb 20, 2009 6:54 am

It can be a problem with IRC server.
Some flood protect or something.

With "---------------------" - not working.
If I add to the end of this line random number (ie. [expr rand() * 1000]) - its working but the line looks like "------------------------- 320.23453345"

I tried to change putquick to puthelp/putserv but nothing.
Even with "aaaaaaaa" or something, its not working too.

speechles · Post by **speechles** » Fri Feb 20, 2009 7:01 am

What your experiencing is the eggdrop queue mechanism at work.

eggdrop.conf wrote:# Allow identical messages in the server queue?
set double-server 0

As you fill the putquick queue, your adding to it faster than it can display what your adding. So after you get to the 2nd line of hyphens, the rest aren't added because that 2nd line is already there containing the same thing and hasn't been displayed yet. All eggdrop queues have this behavior.

tomekk · Post by **tomekk** » Fri Feb 20, 2009 7:13 am

and we got a solution

Football · Post by **Football** » Fri Feb 20, 2009 7:48 am

hi tomekk, is it possible for you to add an option that if you type !Table <team> like !Table Arsenal, it will give it's details just like if you type !table 1 or etc?

DaRkOoO · Post by **DaRkOoO** » Fri Feb 20, 2009 8:08 am

Is it posible to make something like this for livescore.com?

tomekk · Post by **tomekk** » Fri Feb 20, 2009 9:22 am

@Football

ver 0.2, searching by name added,
all previous functions are working too:

Code: Select all

# Author: tomekk
# e-mail:  tomekk/@/oswiecim/./eu/./org
# home page: http://tomekk.oswiecim.eu.org/
#
# Version 0.2
#
# This file is Copyrighted under the GNU Public License.
# http://www.gnu.org/copyleft/gpl.html

# !table channels 
set table_chans {#channel1 #channel2}

#######################################################################
bind pub -|- !table show_table

package require http

proc get_table { } {
	set http_uagent "Opera/9.61 (Windows i686; U; en) Presto/2.1.1"
	set http_token [http::config -useragent $http_uagent]
	if {[catch {set http_token [::http::geturl "http://www.skysports.com/football/league/0,19540,11660,00.html" -timeout 10000]}]} {
		return "error"
	} {
		return [http::data $http_token]
	}
}

proc show_table { nick uhost hand chan arg } {
	global table_chans

	if {[lsearch $table_chans $chan] == -1} {
                return
        }

	set poss [lindex [split $arg] 0]
	set pos_mode 0
	set arg_team_name ""

	if {$poss != ""} {
		if {[regexp {^[a-zA-Z ]+$} $arg]} {
			set pos_mode 1
			set arg_team_name $arg
		}

		if {[regexp {^[0-9]+$} $poss]} {
			set start_pos $poss
			set end_pos $poss

			if {($start_pos > 20) || ($end_pos > 20)} {
				putquick "PRIVMSG $nick :max is 20, sorry"
				return
			}
		}

		if {[regexp {^[0-9]+\-[0-9]+$} $poss]} {
			set split_pos [split $poss "-"]
	        	set start_pos [lindex $split_pos 0]
			set end_pos [lindex $split_pos 1]

			if {($start_pos > 20) || ($end_pos > 20)} {
				 putquick "PRIVMSG $nick :max is 20, sorry"
				 return
			}
		}
	} {
		set start_pos 1
		set end_pos 20
	}

	if {$pos_mode == 0} {
		if {$start_pos > $end_pos} {
			putquick "PRIVMSG $nick :first argument must be lower than second ie. 1-20, not 20-1"
			return
		}
	}

	set all [get_table]

	if {$all == "error"} {
		putquick "PRIVMSG $nick :problem with connection, try again later, sorry"
		return
	}

	regsub -all "\n" $all "" all
	regsub -all "\t" $all "" all

	# some number before team name
	regsub -all -nocase {<tr(\s+|[a-zA-Z=\"\- ]+)>\s+<td>(\d+|\-\d+)<\/td>} $all "" all
	
	# team points
	regsub -all -nocase {<td>(\d+|\-\d+)<\/td>} $all {<pkt>\1</pkt>} all

	# team name, 1st tag
	regsub -all -nocase {<td><a\s+href=\"\/football\/team\/0,\d+,\d+,00\.html\">} $all "<team_title>" all

	# <team> team name here </team>
	regsub -all -nocase {<team_title>([a-zA-Z ]+)</a></td>} $all {<team>\1</team>} all

	# new line marks
	regsub -all "<team>" $all "\n<team>" all
	regsub -all "<\/team>" $all "<\/team>\n" all

	regsub -all "<pkt>" $all "\n<pkt>" all
	regsub -all "<\/pkt>" $all "<\/pkt>\n" all

	set team_pos 1
	set team_idx 0
	set team_list [list]

	putquick "PRIVMSG $nick :Pos | Team | P | W | D | L | F | A | GD | PTS"
	putquick "PRIVMSG $nick :---------------------------------------------"

	# "clean" team names, points
	foreach a [split $all "\n"] {
		if {[string match *<team>* $a]} {
			regsub -all "<team>" $a "" a
			regsub -all "<\/team>" $a "" a
			lappend team_list $a
			incr team_idx 1
		}

		if {[string match *<pkt>* $a]} {
			regsub -all "<pkt>" $a "" a
                	regsub -all "<\/pkt>" $a "" a
			lappend team_list $a
			incr team_idx 1
		}

		if {$team_idx == 9} {
			if {$pos_mode == 0} {
				if {($team_pos >= $start_pos) && ($team_pos <= $end_pos)} {
					putquick "PRIVMSG $nick :$team_pos|[join $team_list "|"]"
				}
			} {
				set team_name [lindex $team_list 0]
				if {[string match -nocase *$arg_team_name* $team_name]} {
					putquick "PRIVMSG $nick :$team_pos|[join $team_list "|"]"
				}
			}

			set team_list [list]
			set team_idx 0
			incr team_pos 1
		}
	}
}

putlog "football-table.tcl ver 0.2 by tomekk loaded"

@DaRkOoO
I think yeah. Post at forum and maybe someone will write it for You

Football · Post by **Football** » Fri Feb 20, 2009 9:48 am

great tomekk, thank you very much

the users of my room are very much pleased with this script and it is very useful! so that's a good feedback for you!

feel free to check out my 2nd post 'Lineup script' it's something like this, maybe it won't be too different from this for you if you wish like helping me more

HowlinPsycho · Post by **HowlinPsycho** » Mon Mar 02, 2009 3:04 pm

Any chance this script can expand to getting info from other countries leagues too?

tomekk · Post by **tomekk** » Tue Mar 03, 2009 8:03 am

It can work only when "page" looks the same, otherwise you have to find someone who will write script.