The www.freedb.org internet data base provides information on artists, album- and songtitles on audio CDs. This information can be used when ripping the CDs to genarate playlists etc. The query key is an ID which is calculated from the track-offsets of the CD (details cf. freedb-FAQ from freedb.org). As this ID might not be unique a category (jazz, rock ...,) are added. Both information together provide the unique key into freedb.org. This ID is calculated with an additional package [cddb discID]. The cddb package handles the queries to freedb.org namely the lscat read and query commands The relevant protocol parts from the cddb-documentation (from www.freedb.org are included as comments # # (C) Joachim Heidemeier 2011 # published under the same licence terms as Tcl # package provide cddb 0.1 # # requires discid # package require discid # # # namespace eval cddb { namespace export startConn lscat read query select_match global done set done 0 # counter for autoincrement variable counter 0 # # storage for cddb_data information # variable cdInfo # # config variables for the connection # set cddb(-servers) [list freedb.freedb.org] set cddb(-port) 8880 set cddb(-clientName) {tcl_cddb_lib} set cddb(-clientVersion) 0.1 set cddb(-myHost) {} set cddb(-userName) anonymous set cddb(-EOT) {.} # # configure options, taken from http package # proc configure {args} { variable cddb set options [lsort [array names cddb -*]] set usage [join $options ", "] if {[llength $args] == 0} { set result {} foreach name $options { lappend result $name $cddb($name) } return $result } regsub -all -- - $options {} options set pat ^-([join $options |])$ if {[llength $args] == 1} { set flag [lindex $args 0] if {[regexp -- $pat $flag]} { return $cddb($flag) } else { return -code error "Unknown option $flag, must be: $usage" } } else { foreach {flag value} $args { if {[regexp -- $pat $flag]} { set cddb($flag) $value } else { return -code error "Unknown option $flag, must be: $usage" } } } } # # returns a unique name for the connection # proc autoName {{prefix conn}} { variable counter set an "$prefix$counter" incr counter return $an } # # defines a simple statemachine for the decoding # (taken from Tclers Wiki http://wiki.tcl.tk/8363, slightly modified) # this time token is linked to variable conn to avoid # state / states typos # proc Statemachine {token codeMulti states} { upvar #0 $token conn variable cddb variable cdInfo global done array set S $states proc Goto label { uplevel 1 set this $label return -code continue } set this [lindex $states 0] while 1 {eval $S($this)} rename Goto {} } # # external user driven selection of # several "near matches" # unsets the _nr_entries in cdInfo # sets _entries # needs to be replaced when using a GUI # proc select_match {token} { upvar #0 $token state global done variable cdInfo Statemachine $token {} { START { set keys [array names cdInfo -glob {_[0-9]*}] set categs [lsort [lsearch -inline -all -glob $keys *categ*]] set dtitles [lsort [lsearch -inline -all -glob $keys *dtitle*]] set discids [lsort [lsearch -inline -all -glob $keys *discid*]] set matches [llength $dtitles] puts "Found $matches possible matches. Please enter the number of the selected match, n for no selection" for {set l 0} {$l < $matches} {incr l} { puts stdout "Match No. $l discid $cdInfo([lindex $discids $l]) categ $cdInfo([lindex $categs $l]) \n\t\ dtitle $cdInfo([lindex $dtitles $l])" } Goto READ } READ { gets stdin line if {($line eq {n}) || ([string is integer -strict $line] && ($line < $matches))} { set selected $line Goto END } else { Goto REPEAT } } REPEAT { puts "Please enter the number of the selected match or n for no selection" Goto READ } END { if {$selected eq n} { puts "no match selected" } else { set cdInfo(_categ) $cdInfo([lindex $categs $selected]) set cdInfo(_discid) $cdInfo([lindex $discids $selected]) set cdInfo(_dtitle) $cdInfo([lindex $dtitles $selected]) set cdInfo(match) single } foreach {categ discid dtitle} "$categs $discids $dtitles" { unset cdInfo($categ) unset cdInfo($discid) unset cdInfo($dtitle) } break } } } # # takes a response line with code # and splits it into code and message part # the results are stored in the state array # proc evaluate_code_line {token response} { upvar #0 $token state set x [split $response \n] set lx [llength $x] if {$lx != 1} {return -code error "expected one line, received several"} if {[regexp {([0-9]{3})(.*)} $inp -> code message]} { set state(code) $code set state(message) [string trim $message] return -code ok } else { return -code error "unknown response structure! \n $response" } } # # parseTitle evaluates the response of a query # and stores the response in # cdInfo indexed by number_name # response is # one or several lines consisting of # categ discid dtitle # proc parseTitle {response} { variable cdInfo set prefix {_} set pattern {([a-z]+) ([0-9,a-f]+) (.*)} if {[llength $response] > 1} { set i 0 } else { set i "" } foreach line $response { if {[string is integer -strict $i]} { set prefix "_${i}_" incr i } regexp -- $pattern $line -> categ discid dtitle array set cdInfo [list ${prefix}categ $categ ${prefix}discid $discid ${prefix}dtitle [string trim $dtitle]] } } # # # process response # processing is done in Statemachine which handles # single or multiple lines depending on provided codelist # multiline responses are indicated in the protocol by codeMulti # return codes from the first line which always start with the numeric return code # a ReturnCode from codeMulti triggers multiline mode # the use data from the response are in token(text) /as list/ # which in the case of single line responses is equal to token(message) # proc processResponse {token {codeMulti {}}} { upvar #0 $token state global done variable cddb Statemachine $token $codeMulti { START { set conn(text) [list] set res [list] set rp [gets $conn(sock)] if {$rp != -1} { evaluate_code_line $token $rp if {[llength $codeMulti] && [lsearch -exact $codeMulti $conn(code)] > -1} { Goto MULTI } elseif {$conn(code) < 400} { set conn(text) [list $conn(message)] Goto END } else { Goto ERR ;# RC >= 400 } } else { Goto EOF ;# rp == -1 } } MULTI { set rp [gets $conn(sock)] if {$rp != -1} { if {$rp != $cddb(-EOT)} { if {$rp != {}} { lappend conn(text) $rp Goto MULTI } } else {Goto END} } else {Goto EOT} } ERR { set conn(status) commandFailed return -code continue $conn(message);# Fehlerbehandlung erfolgt in aufrufender Routine } EOF { set conn(status) EOF return -code continue EOF } END { set conn(status) success incr done break } } } # # each connection is handeled in one global array # (variable autonamed) # # startConn # setup a connection to a freedb_server # receives and evaluates server login message # and handles initial handshake # parameter serverIdx is the index of the cddb-server to access default 0 # proc startConn {{serverIdx 0} args} { # protocol description # Server sign-on banner: #---------------------- #<- code hostname CDDBP server version ready at date # # code: # 200 OK, read/write allowed # 201 OK, read only # 432 No connections allowed: permission denied # 433 No connections allowed: X users allowed, Y currently active # 434 No connections allowed: system load too high # hostname: # Server host name. Example: xyz.fubar.com # version: # Version number of server software. Example: v1.0PL0 # date: # Current date and time. Example: Wed Mar 13 00:41:34 1996 # if {[llength $args] > 0} { if {![expr {[llength $args] % 2}]} { configure {*}$args } else {error "uneven number of options given"} } set token [autoName] variable cddb variable responseCode global done upvar #0 $token state set state(server) [lindex $cddb(-servers) $serverIdx] set state(port) $cddb(-port) set state(sock) [socket $state(server) $state(port)] set state(exp_response) code_line set state(command) startConn set state(status) inCommand fconfigure $state(sock) -translation {auto crlf} -blocking 0 fileevent $state(sock) readable [namespace code [list processResponse $token]] vwait done set done 0 switch -exact -- $state(code) { 200 {set state(accessmode) rw} 201 {set state(accessmode) ro} 431 - 432 - 433 {return -code error $state(message)} } # #Initial client-server handshake: #-------------------------------- #Note: This handshake must occur before other cddb commands # are accepted by the server. # #Client command: #-> cddb hello username hostname clientname version # # username: # Login name of user. Example: johndoe # hostname: # Host name of client. Example: abc.fubar.com # clientname: # The name of the connecting client. Example: xmcd, cda, EasyCD, # et cetera. Do not use the name of another client which already # exists. # version: # Version number of client software. Example: v1.0PL0 # #Server response: #<- code hello and welcome username@hostname running clientname version # # code: # 200 Handshake successful # 431 Handshake not successful, closing connection # 402 Already shook hands set state(status) inCommand set message "cddb hello $cddb(-userName) $cddb(-myHost) $cddb(-clientName) $cddb(-clientVersion)" puts $state(sock) $message flush $state(sock) fileevent $state(sock) readable [namespace code [list processResponse $token]] vwait done set done 0 switch -exact -- $state(code) { 200 - 402 {set state(status) ready} 431 {return -code error $state(message)} } return $token } ;#end startConn # #List the genre categories # proc lscat {token} { # # protocol description # Client command: #-> cddb lscat # #Server response: #<- code Okay category list follows (until terminating marker) #<- category #<- category #<- (more categories...) #<- . # # code: # 210 Okay category list follows # category: # CD category. Example: rock variable cddb variable responseCode global done upvar #0 $token state set state(status) inCommand set state(lnr) 0 set code_multi [list 210] puts $state(sock) "cddb lscat" flush $state(sock) fileevent $state(sock) readable [namespace code [list processResponse $token $code_multi]] vwait done set done 0 set categList $state(text) return $categList } ;#end lscat # # Read entry from database: # proc read {token} { # # protocol description # # Client command: #-> cddb read categ discid # # categ: # CD category. Example: rock # discid: # CD disc ID number. Example: f50a3b13 # # #Server response: #<- code categ discid #<- # xmcd 2.0 CD database file #<- # ... #<- (CDDB data...) # # or #<- code categ discid No such CD entry in database. # # code: # 210 OK, CDDB database entry follows (until terminating marker) # 401 Specified CDDB entry not found. # 402 Server error. # 403 Database entry is corrupt. # 409 No handshake. # categ: # CD category. Example: rock # discid: # CD disc ID number. Example: f50a3b13 variable cdInfo variable cddb variable responseCode global done upvar #0 $token state set code_multi [list 210] set state(status) inCommand puts $state(sock) "cddb read $cdInfo(_categ) $cdInfo(_discid)" flush $state(sock) fileevent $state(sock) readable [namespace code [list processResponse $token $code_multi]] vwait done set done 0 # drop empty playorder fields set cdInfo(entry) [lrange $state(text) 0 [lsearch -exact $state(text) {PLAYORDER=} ]] } # # proc query {token} { # # #Query database for matching entries: #------------------------------------ #Client command: #-> cddb query discid ntrks off1 off2 ... nsecs# # # discid: # CD disc ID number. Example: f50a3b13 # ntrks: # Total number of tracks on CD. # off1, off2, ...: # Frame offset of the starting location of each track. # nsecs: # Total playing length of CD in seconds. # #Server response: #<- code categ discid dtitle # or #<- code close matches found #<- categ discid dtitle #<- categ discid dtitle #<- (more matches...) #<- . # code: # 200 Found exact match # 211 Found inexact matches, list follows (until terminating marker) # 202 No match found # 403 Database entry is corrupt # 409 No handshakpTe # categ: # CD category. Example: rock # discid: # CD disc ID number of the found entry. Example: f50a3b13 # dtitle: # The Disc Artist and Disc Title (The DTITLE line). For example: # Pink Floyd / The Dark Side of the Moon # the TOC data are in variable cdtoc variable cdtoc variable cddb variable cdInfo variable responseCode global done upvar #0 $token state set state(status) inCommand # # build argumentlist for query from cdtoc # set code_multi [list 211] set arglist [list $cdtoc(cddbID) $cdtoc(num_trks)] for {set i 0} {$i < $cdtoc(num_trks)} {incr i} { lappend arglist [tocList2TrackOffset $cdtoc($i)] } lappend arglist $cdtoc(total_seconds) # perform query puts $state(sock) "cddb query [join $arglist]" flush $state(sock) fileevent $state(sock) readable [namespace code [list processResponse $token $code_multi]] vwait done set done 0 switch -exact -- $state(code) { 200 {set cdInfo(match) single; parseTitle $state(text) } 211 {set cdInfo(match) multi; parseTitle $state(text) } default {return $state(message)} } };#end query };#end namespace cddb # # testprogram # cdrom device is /dev/sr0 if {1} { cddb::configure -myHost ttiger.dnsalias.net cddb::read_TOC /dev/sr0 cddb::cddbID set token [cddb::startConn] cddb::query $token if {$cddb::cdInfo(match) eq {multi}} { cddb::select_match $token } cddb::read $token parray cddb::cdInfo } Enter page contents here, upload content using the button above, or click cancel to leave it empty. <>Enter Category Here