Meliorator

#!/usr/bin/tclsh

# SM-PACKAGE - irc://irc.freenode.net:6667/Meliorator
# Copyright (C) 2007  Meliorator

# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
# MA  02110-1301, USA.

package require http 2.5

proc Search search {
 set ::Wait ""
 if [catch {::http::geturl "http://www.tvrage.com/search.php?search=[::http::formatQuery $search]" -command [list SearchParse $search]} err] { puts $err }
}

proc SearchParse {search token} {

 set data [::http::data $token]; ::http::cleanup $token

 for {set i [expr [llength [set getname [split $search]]] -1]} {$i >= 0} {incr i -1} {
  set getname [lrange $getname 0 $i]

  foreach {. url title} [regexp -all -inline {(?:</td></tr>.*href='(http://[^']+)' ?>([^<>]+)</a>){1,1}?} $data] {
   set chkname [string map {? * . * " " * - * _ * ( * ) * + * , * ' * : * ! * + * * * ^ * $ * [ * ] * \{ * \} * \" *} [join $getname]]
   set chktitle [string map {? * . * " " * - * _ * ( * ) * + * , * ' * : * ! * + * * * ^ * $ * [ * ] * \{ * \} * \" *} $title]

   if {[string match -noc *$chkname* $title] || [string match -noc $chktitle $search]} {

    puts "Search_Url:$url Search_Title:$title"

    if [catch {set token [::http::geturl $url]} err] { puts $err }

    puts Here?

    unset ::Wait
    return
   }
  }
 }
}

proc Wait {} {  if [info exists ::Wait] { after 1000 Wait; vwait ::Wait } }

if {$tcl_interactive == 0} { Search $argv; Wait }