FreeDB Access

Beware - I just wanted to share the following code, which bodges up a quick FreeDB access for reading CD tracklistings. It's not pretty, but it works.

It uses the windows application diskid.exe which reads the CDID from the disc in the drive, see DiscID

package require http

set alldata {}
set cds {}
set tracks {}
set cats {blues classical country data folk jazz newage reggae rock soundtrack misc}

proc query {} {
        global cds tracks cats alldata
        set cds ""
        set tracks ""
        set r [catch {set ret [exec discid cdaudio]}]
        if {$r!=0} {
                tk_messageBox -message "No CD in drive or other error"
                return
        }
        set did [lindex $ret 0]
        set cdtemp ""
        foreach c $cats {
                set token [::http::geturl "http://freedb.freedb.org/~cddb/cddb.cgi?cmd=cddb+read+$c+$did&hello=name+host.com+W4CDTL+1.0&proto=1"]
                upvar #0 $token state
                set data $state(body)
                if {$data==""} {tk_messageBox -message "Try again - no data"; return}
                # 210 is code for found CD
                if {[lindex $data 0]==210} {
                        lappend cdtemp $state(body)
                }
        }
        if {[llength $cdtemp]==0} {set cds "No Matches Found";return}
        set newcds ""
        foreach cd $cdtemp {
                set cd [split $cd "\n"]
                
                set lines [list]
                foreach l $cd {
                        set r [split $l ""]
                        set first [lindex $r 0]
                        
                        if {$first == "D" || $first == "T"} {
                                set l [lindex [split $l "="] 1]
                                lappend lines $l
                        }
                }
                lappend newcds $lines
                lappend cds "[lindex $lines 0] - [lindex $lines 1]"
        }


        set alldata $newcds

        update
}
set last 0
proc cdselected {} {
        global cds tracks alldata last
        set tracks ""
        
        set w [.cds curselection]
        set last $w
        set trtemp [lrange [lindex $alldata $w] 2 end]

        set num 1
        foreach tr $trtemp {
                lappend tracks "$num - $tr"
                incr num
        }

         
}

proc url x {
    #set x [regsub -all -nocase {htm} $x {ht%6D}]
    exec rundll32 url.dll,FileProtocolHandler $x &
  }

proc print {} {
        global alldata tracks last
        
        set tracks ""
        set l [lindex $alldata $last]
        set trtemp [lrange [lindex $alldata $last] 2 end]

        set num 1
        foreach tr $trtemp {
                lappend tracks "$num - $tr"
                incr num
        }
        
        # Add formatting here...
        

        set output "<html><h3>[lindex $l 1]</h3><table width=400 border=0 cellpadding=0>\n"
        foreach t $tracks {
                append output "<tr><td><font size=3>$t</font></td></tr>\n"
        }
        append output "</table><script>window.print()</script></html>"




        set fh [open w4trtemp.html w]
        puts $fh $output
        close $fh
        url w4trtemp.html
}

listbox .cds -width 50 -height 6 -listvariable cds

listbox .tracks -width 50 -height 24 -listvariable tracks

button .query -text "Query FreeDB" -command query

button .print -text "Export and Print" -command print

pack .cds .tracks .query .print -fill both -expand 1

bind .cds <<ListboxSelect>> "cdselected"

It foreachs through the available categories on freeDB using the ID provided from discID, then allows the user to choose the one they need.

Category Music