FreeDB

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 https://wiki.tcl-lang.org/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 [email protected] 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 theNameofMyHost
    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
 }