if {0} { 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 package handles the queries to freedb.org namely the lscat read and query commands }
#
# (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 drive selection of # several "near matches" # unsets the _nr_entries in cdInfo # sets _entries # 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 arry # proc evaluate_code_line {token inp} {
upvar #0 $token state
set x [split $inp \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 $inp"
}} # # 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.