egghelp.org community :: View topic

[ egghelp.org home | forum home ]

egghelp.org community
Discussion of eggdrop bots, shell accounts and tcl scripts.

FAQ

Memberlist

Usergroups

Profile

discogs.tcl

egghelp.org community Forum Index -> Script Support & Releases

View previous topic :: View next topic

Author

Message

moff
Voice

Joined: 24 Jul 2008
Posts: 27

Posted: Sun Oct 12, 2008 5:47 pm Post subject: discogs.tcl

Hi guys,

i just found the discogs.tcl script by erupt but it doesnt work properly...
i always get "nothing found"
and i think the guy who did it, is inactive...

anyone know what to do?

Code:

# Discogs.com Query Script
#
# Description: Queries Discogs.com for Music info
#
# Features: Allows you to search by artist/label/release
#
# Author: eRUPT(erupt@ruptbot.com) / Web: www.ruptbot.com
#
# Usage: call !disco [options] <search terms>
# Options: -t <search type> -c# <limit results> -i <release number> -p (Private)
# Search Types: art, rel, cat, lab
# Tips: When you find releases through the bot use the Release Number
# (Located at the end of the URL) to query for further details
# on the album.
#

#Allow guest queries to show in channel? [0=No,1=Yes]
set discogs(private) 0

#Max number of results
set discogs(MAX) 10

set discogs(ver) v0.3

###########
# History
#
# - v0.1
# First Release.
#
# - v0.1b
# Fixed exact matches that try to redirect.
#
# - v0.1c
# Fixed putnot error.
#
# - v0.2
# Rewrote search patterns for new discogs html.
#
# - v0.3
# Rewrote search patterns for new discogs html.
###########

bind pub -|- !disco pub_discogs

proc putnot {nick msg} { putserv "NOTICE $nick :$msg" }

proc get_discogs {private where nick max type args} {
global tokens
package require http
regsub -all " " $args "+" args
if {[string equal {i} $type]} {
set conn [http::geturl http://www.discogs.com/release/[lindex $args 0] -command spit_discogs]
} else {
set conn [http::geturl http://www.discogs.com/search?type=$type&q=[lindex $args 0]&btn=Search -command spit_discogs]
}
set tokens($conn) "$private $where $nick $max $type [unixtime]"
}

proc spit_discogs {token} {
global tokens testBody
set private [lindex $tokens($token) 0]
set where [lindex $tokens($token) 1]
set max [lindex $tokens($token) 3]
set type [lindex $tokens($token) 4]
set unixtime [lindex $tokens($token) 5]
unset tokens($token)
upvar #0 $token http
set testBody $http(body)
if {$http(status)=="error"} {
if {$http(error)!=""} {
putserv "$private $where :Error: $http(error)"
return 0
}
}
if {$http(status)=="timeout"} {
putserv "$private $where :Error: Timeout."
return 0
}
array set meta $http(meta)
if {[info exists meta(Location)]} {
set title [lindex [split $meta(Location) /] 2]
set entry_type [lindex [split $meta(Location) /] 1]
putserv "$private $where :(\002$entry_type\002) $title - \002http://www.discogs.com$meta(Location)\002"
return 1
}
catch {
set cnt 0
if {![string equal {i} $type]} {
regsub -all {</?b>} $http(body) {} http(body)
set dupes [list {}]
foreach index [regexp -all -indices -inline {<li><a href=[^>]+><span[^>]*>[^<]*</a>} $http(body)] {
if {$cnt==$max} { break }
set disco_entry [string range $http(body) [lindex $index 0] [lindex $index 1]]
regexp {href="([^"]+)"><span[^>]*>(.*?)</a>} $disco_entry {} url title
if {[info exists title]} { set title [string map {{+} { }} $title] } else { set title " " }
if {![info exists entry_type]} { set entry_type $type }
if {[lsearch -exact $dupes "$title $url"]==-1} {
putserv "$private $where :(\002$entry_type\002) $title - \002http://www.discogs.com$url\002"
lappend dupes "$title $url"
incr cnt
}
}
} else {
set testBody $http(body)
regsub -all {\n} $http(body) {} http(body)
foreach desc_type {Catalog# Format Country Released Genre Style} { append regex "<tr><td align=right>$desc_type:</td><td>(\[^<\]*)</td></tr>" }
regexp {<td colspan=2>.*?</td></tr></table>} $http(body) match
set match [string map {</a>- { -}} $match]
regsub -all {<[^>]*>|\n} $match {} title
foreach desc_type {Catalog# Format Country Released Genre Style} {
set regex "<tr><td align=right>$desc_type:</td><td>(\[^<\]*)</td></tr>"
if {[regexp $regex $http(body) {} current]} {
if {![string equal {} $current]} {
 if {[string equal {0} $cnt]} {
 putserv "$private $where :\002$title\002"
 incr cnt
 }
 putserv "$private $where :$desc_type: \002$current\002"
}
}
}
}
if {$cnt==0} {
putserv "$private $where :No Results"
}
} err
if {$err!=""} { putlog "Discogs Error: $err" }
}

proc pub_discogs {nick uhost hand chan arg} {
global discogs tokens
array set types {art {artists} rel {releases} cat {catno} lab {labels}}
if {[string equal {} $arg]} {
putnot $nick "Usage: !disco \[options\] <search terms>"
putnot $nick "Flags: -t <search type> -c# (limit results) -i <release number> -p (Forces private messaging)"
putnot $nick "Search Types: art, rel, cat, lab"
return 0
}
set private 0
if {$discogs(private) && [string equal {*} $hand]} { set private 1 }
if {[set index [lsearch -exact $arg -p]]!="-1"} {
set private 1
set arg [lreplace $arg $index $index]
}
set type "All"
if {[set index [lsearch -exact $arg -t]]!="-1"} {
set type $types([lindex $arg [expr $index + 1]])
set arg [lreplace $arg $index [expr $index + 1]]
}
if {[set index [lsearch -exact $arg -i]]!="-1"} {
set type "i"
set arg [lreplace $arg $index $index]
}
set max $discogs(MAX)
if {[set index [lsearch -regexp $arg {-c[0-9]+}]]!="-1"} {
regexp {[0-9]+} [lindex $arg $index] max
set arg [lreplace $arg $index $index]
}
if {$max>$discogs(MAX)} { set max $discogs(MAX) }
foreach array [array names tokens] {
if {$nick==[lindex $tokens($array) 2]} {
if {[expr [unixtime] - [lindex $tokens($array) 5]]>300} {
unset tokens($array)
} else {
putnot $nick "You already have one query open wait a couple, or better yet goto a record store."
return 0
}
}
}
if {$private} {
get_discogs NOTICE $nick $nick $max $type $arg
} else {
get_discogs PRIVMSG $chan $nick $max $type $arg
}
return 1
}

putlog "Discogs.com Query Tools for eggdrop by eRUPT(erupt@ruptbot.com) $discogs(ver)"

moff
Voice

Joined: 24 Jul 2008
Posts: 27

Posted: Sat Nov 15, 2008 9:34 pm Post subject:

im not a tcl prof but i know what to do if someone helps me are there any tcl freaks out there ?

moff
Voice

Joined: 24 Jul 2008
Posts: 27

Posted: Sun Nov 30, 2008 7:31 am Post subject:

dumb spammer

Display posts from previous:

	egghelp.org community Forum Index -> Script Support & Releases	All times are GMT - 4 Hours
Page 1 of 1

You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum