The www.freedb.org internet data base provides information on artists, album- and songtitles of audio CDs.
This information can be used when ripping the CDs to genarate playlists etc. The query key is an discID 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 descriptor into the freedb.org database.
The discID is calculated with an additional package cddb discID. The cddb package handles the queries into freedb.org database 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=} ]]
}
#
# Query database for matching entries
#
proc query {token} {
#
protocol description
# 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
}