Earliest release date from Discogs
Posted: Tue Sep 01, 2009 10:07 pm
***Update***
The newest version (2.0) by wxdude can be found in the thread http://www.mediamonkey.com/forum/viewto ... =2&t=66766
Hello!
After many initial runs, here is the 'release' version 1.000 of my EarliestDateDock script. It is a dockable panel that automatically grabs the earliest release date of the currently playing song, displaying the search results. It also auto-saves the date if it finds a match. You can always select another match from the returned list if the auto selection is incorrect. I was looking for a script like this for a long time...after reading many posts and downloading many promising scripts, I decided to make my own.
NOTE: You will need to enter your discogs API key in the panel before it will work properly.
Give it a try and let me know what you think!
Here is a link to the installer:
See link above for the latest...
And here is the code:
Let me know what you think...
*Edit History*
April 1, 2010: Version 1.01
The newest version (2.0) by wxdude can be found in the thread http://www.mediamonkey.com/forum/viewto ... =2&t=66766
Hello!
After many initial runs, here is the 'release' version 1.000 of my EarliestDateDock script. It is a dockable panel that automatically grabs the earliest release date of the currently playing song, displaying the search results. It also auto-saves the date if it finds a match. You can always select another match from the returned list if the auto selection is incorrect. I was looking for a script like this for a long time...after reading many posts and downloading many promising scripts, I decided to make my own.
NOTE: You will need to enter your discogs API key in the panel before it will work properly.
Give it a try and let me know what you think!
Here is a link to the installer:
See link above for the latest...
And here is the code:
Code: Select all
'This script will display a dockable window that shows the searched release dates from discogs,
'will automatically select and save the earliest exact match to date only
'
'made by yhsiuqs
'email to ubersquishy at gmail dot com
Public Const iMatchesPerSong = 7
Public APIKey
Public XMLdoc, XMLdoc2
Public SrchTxt, SrchType
Public aSongMatchLinks
'
' the first fields in the last Publicension is an integer showing the heirarchy of the release year
'
' 1 = earliest release year from all results, is an exact match
' 2 = earliest release year from all results, not an exact match
' 3 = earliest release year from exact matches
' 4 = earliest release year from non-exact matches
' 5 = later release, is an exact match
' 6 = later release, is not an exact match
'
Public aList
Public xTemp,xData
Public fMain,bStartStop,bApply,lvMain,cOptions,lProgress
Public oRelease
Public aTrackList
Public iArrayIndex1
Public iArrayIndex2
Public aReleaseLinks()
Public bRunFlag
Public fProgress
Public bChecked
Public Sep, Mnu, Pnl, LblAPI, Edt, LblCurrent, lMatches, lCurrent, iExact, iFuzzy
Public rButtons()
Sub OnStartup
Dim x,i
set i = SDB.IniFile
Set UI = SDB.UI
Set Pnl = UI.NewDockablePersistentPanel("DateFixer")
if Pnl.IsNew then
Pnl.DockedTo = 2
Pnl.Common.Width = 250
end if
Pnl.Caption = "Date Fixer"
Script.RegisterEvent Pnl, "OnClose", "PnlClose"
redim rButtons(iMatchesPerSong)
Set LblAPI = UI.NewLabel(Pnl)
LblAPI.Autosize = false
LblAPI.Caption = "Discogs API Key"
LblAPI.Alignment = 2 'centered
LblAPI.Common.SetRect 10, 10, Pnl.Common.Width-20, 15
LblAPI.Common.Anchors = 15 '1+2+4+8
Set Edt = UI.NewEdit(Pnl)
Edt.Common.SetRect 10, 25, Pnl.Common.Width-20, 15
Edt.Common.Anchors = 15 '1+2+4+8
Script.RegisterEvent Edt, "OnChange", "EdtSave"
if i.ValueExists("EarliestDateDock","APIKey") then
Edt.Text = i.StringValue("EarliestDateDock","APIKey")
else
Edt.Text = "Key"
end if
Set lCurrent = UI.NewLabel(Pnl)
lCurrent.Autosize = false
lCurrent.Alignment = 2 'centered
lCurrent.Caption = "Current Info"
lCurrent.Common.SetRect 10, 50, Pnl.Common.Width-20, 20
lCurrent.Common.Anchors = 15 '1+2+4+8
Set LblCurrent = UI.NewLabel(Pnl)
LblCurrent.Autosize = false
LblCurrent.Alignment = 2 'centered
LblCurrent.Common.SetRect 10, 70, Pnl.Common.Width-20, 20
LblCurrent.Common.Anchors = 15 '1+2+4+8
Set lMatches = UI.NewLabel(Pnl)
lMatches.Autosize = false
lMatches.Alignment = 2 'centered
lMatches.Caption = "Search Results"
lMatches.Common.SetRect 10, 100, Pnl.Common.Width-20, 20
lMatches.Common.Anchors = 15 '1+2+4+8
for x = 1 to imatchespersong
set rbuttons(x-1) = UI.NewRadioButton(Pnl)
rbuttons(x-1).Common.SetRect 10,120+(x-1)*20,Pnl.Common.Width-20, 20
rbuttons(x-1).Caption = ""
rbuttons(x-1).Checked = False
rbuttons(x-1).Common.Visible = False
rbuttons(x-1).Common.ControlName = cstr("r" & x)
Script.RegisterEvent rbuttons(x-1).common, "OnClick", "EvalButtons"
next
' Add menu item that shows panel after it is closed
Set Sep = SDB.UI.AddMenuItemSep(SDB.UI.Menu_View,0,0)
Set Mnu = SDB.UI.AddMenuItem(SDB.UI.Menu_View,0,0)
Mnu.Caption = "Date Fixer"
Mnu.Checked = Pnl.Common.Visible
Script.RegisterEvent Mnu, "OnClick", "ShowPanel"
Script.RegisterEvent SDB, "OnPlay", "SearchCurrent"
End Sub
Sub ShowPanel(Item)
Pnl.Common.Visible = not Pnl.Common.Visible
Mnu.Checked = Pnl.Common.Visible
End Sub
Sub PnlClose( Item)
Mnu.Checked = false
End Sub
Sub SearchCurrent
LookupYear
End Sub
Sub LookupYear()
dim u,v, w, x, y, z
Set UI = SDB.UI
Set XMLdoc = CreateObject("Microsoft.XMLDOM")
XMLdoc.async = "false"
Set XMLdoc2 = CreateObject("Microsoft.XMLDOM")
XMLdoc2.async = "false"
u = 0
APIKey = Edt.Text
Set xdata = SDB.Player.CurrentSong
srchtxt = xdata.artistname & " - " & xdata.title
iExact = ""
iFuzzy = ""
for x = 1 to imatchespersong
rbuttons(x-1).Caption = ""
rbuttons(x-1).Checked = False
rbuttons(x-1).Common.Visible = False
next
if cint(xdata.year) > 0 then
LblCurrent.Caption = srchtxt & ", " & xdata.year
else
LblCurrent.Caption = srchtxt & ", no date"
end if
if len(APIKey) > 5 then
if XMLdoc.load("http://www.discogs.com/search?type=all&q=" & SrchTxt & "&f=xml&api_key=" & APIKey) then 'there is search results
set asongmatchlinks = xmldoc.getElementsByTagName("uri")
if asongmatchlinks.length >= imatchespersong then
u = imatchespersong
elseif asongmatchlinks.length > 0 then
u = asongmatchlinks.length
else
u = 0
end if
if u > 0 then
redim areleaselinks(u)
redim atemp(u,4)
for y = 0 to (u - 1) 'load release links into array
areleaselinks(y) = mid(asongmatchlinks(y).childnodes(0).nodevalue, instr(asongmatchlinks(y).childnodes(0).nodevalue ,"/release/")+9)
next
for y = 0 to (u - 1)
if XMLdoc2.load("http://www.discogs.com/release/" & areleaselinks(y) & "?f=xml&api_key=" & APIKey) then
if cint(XMLdoc2.selectSingleNode("/resp").attributes.item(2).value) > 5000 then 'maxumimum Discogs searches have been performed for today
LblCurrent.Caption = "You have reached the maximum allowable searches from Discogs. Please try again in 24 hours."
exit sub
end if
set oRelease = XMLdoc2.selectSingleNode("/resp/release")
atemp(y,1) = oRelease.selectSingleNode("artists/artist/name").text 'artist
Set aTrackList = oRelease.selectNodes("tracklist/track")
soriginal = ucase(xdata.title)
for each z in aTrackList
slookup = ucase(z.selectsinglenode("title").text)
if slookup = soriginal then 'exact match
atemp(y,2) = z.selectsinglenode("title").text
exit for
elseif instr(1,slookup,soriginal) <> 0 or instr(1,soriginal,slookup) <> 0 then 'title is found in the song title
atemp(y,2) = z.selectsinglenode("title").text
end if
next
if atemp(y,2) <> vbnullstring then 'found a match
on error resume next
z = 0
z = oRelease.selectsinglenode("released").text
if z <> 0 then
atemp(y,3) = left(oRelease.selectsinglenode("released").text,4) 'release year
else
atemp(y,3) = vbnullstring
end if
on error goto 0
if instr(1,ucase(atemp(y,1)),ucase(xdata.artistname)) <> 0 or instr(1,ucase(xdata.artistname),ucase(atemp(y,1))) <> 0 then 'matched artist and title
atemp(y,0) = 5 'show it's an exact match
else
atemp(y,0) = 6 'the data is in question
end if
rbuttons(y).Common.Visible = True
if atemp(y,3) <> vbnullstring then
rbuttons(y).Caption = atemp(y,1) & " - " & atemp(y,2) & ", " & atemp(y,3)
else
rbuttons(y).Caption = atemp(y,1) & " - " & atemp(y,2) & ", no date"
end if
end if
end if
next
z = (-1) 'set earliest compare index for exact matches
v = (-1) 'set index for non exact matches
for y = 0 to (u - 1)
if atemp(y,3) <> vbnullstring and isnumeric(atemp(y,3)) then 'there is a year found
if atemp(y,0) = 5 then 'exact match
if z = (-1) then 'haven't found an earlier release year in exact matches
if len(xdata.year) > 1 then
if cint(atemp(y,3)) < cint(xdata.year) then 'it's earlier than the current date
atemp(y,0) = 3
z = y
end if
else 'no year currently
atemp(y,0) = 3
z = y
end if
elseif cint(atemp(y,3)) < cint(atemp(z,3)) then 'it's an earlier release date
atemp(y,0) = 3
atemp(z,0) = 5
z = y
end if
else 'non exact
if v = (-1) then 'haven't found an earlier release year in non exact matches
if len(xdata.year) > 1 then
if cint(atemp(y,3)) < cint(xdata.year) then 'it's earlier than the current date
atemp(y,0) = 4
v = y
end if
else
atemp(y,0) = 4
v = y
end if
else
if cint(atemp(y,3)) < cint(atemp(v,3)) then 'it's an earlier release date
atemp(y,0) = 4
atemp(v,0) = 6
v = y
end if
end if
end if
end if
next
if z <> (-1) and v <> (-1) then 'both exact and non exact have dates
if cint(atemp(z,3)) <= cint(atemp(v,3)) then 'exact match is earlier or same release year
pnl.common.childcontrol("r" & z+1).checked = true
else 'non exact is earliest
pnl.common.childcontrol("r" & v+1).checked = true
end if
else
if z <> (-1) then 'there is an exact match
pnl.common.childcontrol("r" & z+1).checked = true
elseif v <> (-1) then 'there is a non exact match, but not an exact match
pnl.common.childcontrol("r" & v+1).checked = true
else 'no matches
end if
end if
EvalResults
end if
end if
else
LblCurrent.Caption = "Please enter a valid discogs API key."
end if
End Sub
Sub EvalResults
Dim x
for x = 1 to imatchespersong
if rbuttons(x-1).common.visible = true then
if pnl.common.childcontrol("r" & x).checked = true then
if right(rbuttons(x-1).caption,4) <> "date" then 'there is a date
xdata.year = cint(right(rbuttons(x-1).caption,4))
end if
exit for
end if
end if
next
xdata.custom5 = "Date Corrected"
xdata.updateDB
End Sub
Sub EvalButtons(r)
if right(r.caption,4) <> "date" then 'there is a date
xdata.year = cint(right(r.caption,4))
xdata.custom5 = "Date Corrected"
xdata.updateDB
end if
End Sub
Sub EdtSave(e)
dim i
set i = SDB.IniFile
i.StringValue("EarliestDateDock","APIKey") = e.Text
End Sub
*Edit History*
April 1, 2010: Version 1.01
- Changed the script to save the discogs API key after close