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} { # protocoll 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
# # # proc lscat {token} { #List the genre categories:<- .jetzt erst mal read, weil das auch mit cddbReadMultipleLines geht #-------------------------- #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 # # proc read {token} {
#Read entry from database: #------------------------- # #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.