' ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- -----
'
'                "TitleCase.vbs", Jun-21-2005, v2.00
'         VBScript for MediaMonkey 2.3.1 (or above), written by Risser
'
' Purpose:
' - To update case on Artist, Album Artist, Album and Song Title fields.
'
' Notes:
' - This script writes tags then immediately updates the DB.  There is no
'   impact on the DB for tracks that are not part of the library (particularly, 
'   the tracks are not auto-added to the library)
' - If you update an Artist name or an Album name, it updates the name in the 
'   database and this change is reflected for all instances of that name, even 
'   if it wasn't one of the selected tracks.
' - It's pretty smart about the location of punctuation, roman numerals, foreign contractions 
'   (d', l', etc.), initials, cardinal numbers (1st, 40th), years (1950s, 1960's) and words with 
'   no vowels, but it's not perfect.
' - There are also two pipe-separated (|) lists of words.  One is a "little" words list, like "the", 
'   "an", "a", "of" etc.  If there's a word you'd like treated like a little word (maybe "on" or 
'   "by", or other words if your tags aren't english), add it to the list.
' - The second list is a list of "forced-case" words.  If the parser sees this word in any case, it 
'   replaces it with the word in the list, making it exactly that case.  This is good for acronyms 
'   with vowels (BTO, REM, ELO; CCR and CSN have no vowels, so they are auto-uppercased), things that 
'   need to stay lower case, or abbreviations with no vowels that should be uppercase, like Dr, Mr, 
'   Mrs, St, etc.  Feel free to change these lists to match your collection.
' - It treats apostrophes as a letter, so these can be included in a word.  For example, for "James 
'   Brown and the JB's", I have "JB's" and "JBs" in my forced case list.  
' - Also, on the forced case list, you can specify a final piece of punctuation.  Thus, I have "w/", 
'   which will lowercase "w/", but leave "W" alone to be uppercase.  Also, I have "silence]" which 
'   will force that configuration to be lowercase (for tracks that are all silence), but will treat 
'   "Silence" normally.
'
' ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- -----

Option Explicit

Dim littleWordString
littleWordString = "a|an|and|at|de|del|di|du|e|el|en|et|for|from|la|le|in" & _
           "|n|'n|n'|'n'|o'|'o'|of|or|por|the|to|un|une|und|with|y"
Dim forceCapString
forceCapString = "AC|EBN|OZN|MCs|MC's|DJs|DJ's|JBs|JB's|10cc|Mr|Mrs|Dr|Jr|Sr|Pt|St.|St"& _ 
           "|vs|ft|feat|aka|vol|w/|ABC|ABCs|AC/|ASCII|ASCIII|ATV|BTO|ELO|ELP|EMI|DuShon" & _
               "|FYC|INXS|MacArthur|OMC|OMD|OMPS|PSI|PTA|REM|REO|Sgt|UB40|UK|USA|USMC|UTFO|" & _
               "silence]|T's|OK|USSR"

Dim res
Dim alphaNum, whiteSpace, isMc, vowels, romanNumerals, cardinal, isForeignPref
Set alphaNum = new regExp
Set whiteSpace = new regExp
Set isMc = new regExp
Set vowels = new regExp
Set romanNumerals = new RegExp
Set cardinal = new RegExp
Set isForeignPref = new RegExp
alphaNum.ignoreCase = True
alphaNum.pattern = "['`ŽA-Za-z0-9" & ChrW(192) & "-" & ChrW(65276) & "]"
whiteSpace.pattern = "^[\s,&]+$"  'include comma, ampersand, because we don't want to cap after these
isMc.ignoreCase = True
isMc.pattern = "^(O['`]|MC)"  ' handle O'Brien and McHenry
isForeignPref.ignoreCase = True
isForeignPref.pattern = "^([dl]|dell)['`]"  ' handle l', d' and dell'
vowels.ignoreCase = True
vowels.pattern = "[AEIOUY" & ChrW(192) & "-" & ChrW(601) & "]"
romanNumerals.ignoreCase = True
romanNumerals.pattern = "^M*(C(M|D)|D?C{0,3})(X(C|L)|L?X{0,3})(I(X|V)|V?I{0,3})$"
cardinal.ignoreCase = True
cardinal.pattern = "^\d*(1st|2nd|3rd|[0-9]th|[0-9]['`]?s)$" 'also handles years, like 1950s
Dim littleWordList
littleWordList = Split(littleWordString,"|")
Dim forceCapList
forceCapList = Split(forceCapString,"|")
Public holdArtist, holdAlbum, holdTitle, holdAlbumArtist
Set holdArtist = CreateObject("Scripting.Dictionary")
Set holdAlbum = CreateObject("Scripting.Dictionary")
Set holdTitle = CreateObject("Scripting.Dictionary")
Set holdAlbumArtist = CreateObject("Scripting.Dictionary")

Const mmAnchorRight = 4
Const mmAnchorBottom = 8
Const mmAlignTop = 1
Const mmAlignBottom = 2
Const mmAlignClient = 5
Const mmListDropdown = 2
Const mmFormScreenCenter = 4
Public styleOn

Function Style()
  styleOn = Not styleOn
  If styleOn Then
    Style = ""
  Else
    Style = " class=""Dark"""
  End If
End Function

Function rdQS(UnquotedString)
  rdQS = "'" & Replace(UnquotedString, "'", "''") & "'"
End Function

Function uppercase(s)
  If Left(s,1) = "'" And Len(s) > 1 Then
    uppercase = Left(s,1)&UCase(Mid(s,2,1))&LCase(Mid(s,3))
  Else
    uppercase = UCase(Mid(s,1,1))&LCase(Mid(s,2))
  End If
End Function

Function fixUp(s, prevChars, nextChar)
  Dim forceIndex, littleIndex, i
  Dim capMe, allCaps, foreignPref
  Dim upcased, littleUpped, forceUpped
  forceIndex = -1
  littleIndex = -1
  capMe = false
  allCaps = false
  upcased = UCase(s)
  foreignPref = isForeignPref.test(s)
  
  For i = 0 to UBound(forceCapList)
    forceUpped = UCase(forceCapList(i))
    If UCase(forceCapList(i)) = upcased Or forceUpped = upcased & nextChar Then
      forceIndex = i
      Exit For
    End If
  Next 'i
  For i = 0 to UBound(littleWordList)
    littleUpped = UCase(littleWordList(i))
    If littleUpped = upcased Or littleUpped = upcased & nextChar Then
      littleIndex = i
      Exit For
    End If
  Next 'i
  If forceIndex >= 0 Then
    s = forceCapList(forceIndex)
  Else
    If Len(s) = 1 And nextChar = "." Then
    ' if it's a single character followed by a period (an initial), caps it
      allCaps = True
    ElseIf Not vowels.test(s) And Not cardinal.test(s) Then
    ' if it's all consonants, no vowels, and not a cardinal number, caps it
      allCaps = True
    ElseIf romanNumerals.test(s) And UCase(s) <> "MIX" And UCase(s) <> "MI" And UCase(s) <> "DI" Then
    ' if it's roman numerals (and not 'mix' or 'di' which are valid roman numerals), caps it
      allCaps = True
    ElseIf prevChars = "" Or (nextChar = "" And Not foreignPref) Then
    'if it's the first or last word, cap it
      capMe = True
    ElseIf Not whiteSpace.test(prevChars) Or (nextChar <> "" And InStr(")}]",nextChar)) Then
    ' if it follows a punctuation mark (with or without spaces) or if it's before a close-bracket, cap it
      capMe = True
    ElseIf littleIndex < 0 And Not foreignPref Then
    ' if it's not on the 'little word' list, cap it
      capMe = True
    End If
    If allCaps Then
      s = UCase(s)
    ElseIf capMe Then
      s = uppercase(s)
    Else
      s = LCase(s)
    End If
    If isMc.Test(s) And Len(s) > 2 Then
    ' if it's Mc or O', cap the 3rd character (this assumes no names like McA)
      s = Mid(s,1,2)&UCase(Mid(s,3,1))&LCase(Mid(s,4))
    End If
    If foreignPref Then
    ' if it's l', d' or dell', lowercase the first letter and uppercase the first letter after the apostrophe
      Dim pos
      pos = InStr(s,"'")
      If pos < 1 Then
        pos = InStr(s,"`")
      End If
      If pos > 0 And pos < Len(s) Then
        s = Mid(s,1,pos)&UCase(Mid(s,pos+1,1))&LCase(Mid(s,pos+2))
      End If
    End If
  End If
  fixUp = s
End Function

Function updateCase(s)
  Dim currentWord, result, fixed, theChar, lastNonWordChars
  Dim forceIndex
  Dim i
  currentWord = ""
  result = ""
  lastNonWordChars = ""
  
  For i = 1 to Len(s)
    theChar = Mid(s,i,1)
    If alphaNum.test(theChar) Then
      currentWord = currentWord & theChar
    Else
      If currentWord <> "" Then
        fixed = fixUp(currentWord,lastNonWordChars,theChar)
        If Right(fixed,1) = theChar Then 'handle stuff like w/
          fixed = Left(fixed,Len(fixed)-1)
          lastNonWordChars = ""
        Else
          lastNonWordChars = theChar
        End If
        result = result & fixed
        currentWord = ""
      Else
        lastNonWordChars = lastNonWordChars & theChar
      End If
      result = result & theChar
    End If
  Next 'i
  If Len(currentWord) > 0 Then
    result = result & fixUp(currentWord,lastNonWordChars,"")
  End If
  updateCase = result
End Function

Sub CloseDown
  Set holdAlbum = nothing
  Set holdAlbumArtist = nothing
  Set holdArtist = nothing
  Set holdTitle = nothing
  SDB.Objects("CaseThingy") = Nothing
  SDB.Objects("holdArtist") = Nothing
  SDB.Objects("holdAlbumArtist") = Nothing
  SDB.Objects("holdAlbum") = Nothing
  SDB.Objects("holdTitle") = Nothing
End Sub

Sub OnCancel(Btn)
  CloseDown
End Sub

Sub OnOK(Btn)
  Set holdAlbum = SDB.Objects("holdAlbum")
  Set holdAlbumArtist = SDB.Objects("holdAlbumArtist")
  Set holdArtist = SDB.Objects("holdArtist")
  Set holdTitle = SDB.Objects("holdTitle")

  Dim itm, str, sql
  Dim items, albumNames, artistNames
  Set items = CreateObject("Scripting.Dictionary")
  Set albumNames = CreateObject("Scripting.Dictionary")
  Set artistNames = CreateObject("Scripting.Dictionary")

  For Each itm In holdArtist
    str = holdArtist.item(itm)
    If Not items.exists(itm) Then
      items.add itm, itm
    End If
    itm.artistName = str
    If Not artistNames.exists(str) Then
      sql = "UPDATE Artists SET Artist = " & rdQS(str) & " WHERE Artists.Artist= " & rdQS(Itm.ArtistName)
      SDB.database.execSQL(sql)
      ' This will affect ALL instances of this artist, including album artist, and on other tracks.
      artistNames.add str, str
    End If
  Next 'itm
  
  For Each itm In holdAlbumArtist
    str = holdAlbumArtist.item(itm)
    If Not items.exists(itm) Then
      items.add itm, itm
    End If
    itm.albumArtistName = str
    If Not artistNames.exists(str) Then
      sql = "UPDATE Artists SET Artist = " & rdQS(str) & " WHERE Artists.Artist= " & rdQS(Itm.albumArtistName)
      SDB.database.execSQL(sql)
      artistNames.add str, str
    End If
  Next 'itm
  
  For Each itm In holdAlbum
    str = holdAlbum.item(itm)
    If Not items.exists(itm) Then
      items.add itm, itm
    End If
    itm.albumName = str
    If Not albumNames.exists(str) Then
      sql = "UPDATE Albums SET Album = " & rdQS(str) & " WHERE Albums.Album= " & rdQS(Itm.AlbumName)
      SDB.database.execSQL(sql)
      ' This will affect ALL instances of this album, including other tracks.
      albumNames.add str, str
    End If
  Next 'itm
  
  For Each itm In holdTitle
    str = holdTitle.item(itm)
    If Not items.exists(itm) Then
      items.add itm, itm
    End If
    itm.title = str
  Next 'itm
  
  Dim list
  Set list = SDB.NewSongList
  For Each itm In items
    list.Add( itm)
  Next
  
  list.UpdateAll
  
  Set items = nothing
  CloseDown
End Sub

Function MapXML(original)
  Dim hold
  hold = Replace(original, "&", "&amp;")
  hold = Replace(hold, "  ", "&nbsp; ")
  hold = Replace(hold, "<", "&lt;")
  hold = Replace(hold, ">", "&gt;")
  hold = Replace(hold, """", "&quot;")
  Dim i
  i=1
  While i<=Len(hold)
    If (AscW(Mid(hold, i, 1))>127) Then
      hold = Mid(hold, 1, i-1)+"&#"+CStr(AscW(Mid(hold, i, 1)))+";"+Mid(hold, i+1)
    End If
    i=i+1
  WEnd
  MapXML = hold
End Function

Function MapField(fld)
  If fld="" Then
    MapField = "&nbsp;"
  Else
    MapField = MapXML(fld)
  End If
End Function

Function outField (fixed, normal)
  If fixed = normal Then
    outField = "<td>" & MapField(normal) & "</td>" & vbcrlf
  Else
    outField = "<td class=""highlight"" title=""" & SDB.Localize("Old Value: ") & Chr(13) & MapXML(normal) & """>" & MapField(fixed) & "</td>" & vbcrlf
  End If
End Function

Sub TitleCase
  Dim UI, Form, Foot, Btn, Btn2, WB, HTML
  
  Dim trackList
  Dim writeChanges
  dim DlgWidth

  Set trackList = SDB.CurrentSongList

  If trackList.count=0 Then
    res = SDB.MessageBox( SDB.Localize("Select tracks to be updated"), mtError, Array(mbOk))
    Exit Sub
  End If

  Set UI = SDB.UI

  DlgWidth = 500

  ' Create the window to be shown
  Set Form = UI.NewForm
  Form.Common.SetRect 50, 50, DlgWidth, 400
  Form.Common.MinWidth = 200
  Form.Common.MinHeight = 150
  Form.FormPosition = mmFormScreenCenter
  Form.Caption = SDB.Localize("Case Checker")
  Form.StayOnTop = True

  ' Create a web browser component
  Set WB = UI.NewActiveX(Form, "Shell.Explorer")
  WB.Common.Align = mmAlignClient      ' Fill all client rectangle
  WB.Common.ControlName = "WB"

  ' Create a panel at the bottom of the window
  Set Foot = UI.NewPanel(Form)
  Foot.Common.Align = mmAlignBottom
  Foot.Common.Height = 35

  ' Create a button that saves the report
  Set Btn2 = UI.NewButton(Foot)
  Btn2.Caption = SDB.Localize("OK")
  Btn2.Common.SetRect DlgWidth - 205, 6, 85, 25
  Btn2.Common.Anchors = mmAnchorRight + mmAnchorBottom
  Btn2.UseScript = Script.ScriptPath
  Btn2.OnClickFunc = "OnOK"
  Btn2.Default = true

  ' Create a button that closes the window
  Set Btn = UI.NewButton(Foot)
  Btn.Caption = SDB.Localize("Cancel")
  Btn.Common.SetRect DlgWidth - 105, 6, 85, 25
  Btn.Common.Anchors = mmAnchorRight + mmAnchorBottom
  Btn.UseScript = Script.ScriptPath
  Btn.OnClickFunc = "OnCancel"
  Btn.Cancel = true

  Form.SavePositionName = "CaseWindow"
  Form.Common.Visible = True                ' Only show the form, don't wait for user input
  SDB.Objects("CaseThingy") = Form  ' Save reference to the form somewhere, otherwise it would simply disappear


  HTML = "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.0 Transitional//EN"">" & vbcrlf
  HTML = HTML & "<html>" & vbcrlf
  HTML = HTML & "  <head>" & vbcrlf
  HTML = HTML & "    <title>" & SDB.Localize("Case Checker") & "</title>" & vbcrlf
  HTML = HTML & "  </head>" & vbcrlf

  HTML = HTML & "<STYLE TYPE=text/css>" & vbcrlf
  HTML = HTML & "body{font-family:'Verdana',sans-serif; background-color:#FFFFFF; font-size:9pt; color:#000000;}" & vbcrlf
  HTML = HTML & "H1{font-family:'Verdana',sans-serif; font-size:13pt; font-weight:bold; color:#AAAAAA; text-align:left}" & vbcrlf
  HTML = HTML & "P{font-family:'Verdana',sans-serif; font-size:8pt; color:#000000;}" & vbcrlf
  HTML = HTML & "TH{font-family:'Verdana',sans-serif; font-size:9pt; font-weight:bold; color:#000000; border-color:#000000; border-style: solid; border-left-width:0px; border-right-width:0px; border-top-width:0px; border-bottom-width:3px;}" & vbcrlf
  HTML = HTML & "TD{font-family:'Verdana',sans-serif; font-size:8pt; color:#000000; border-color:#000000; border-style: solid; border-left-width:0px; border-right-width:0px; border-top-width:0px; border-bottom-width:1px;}" & vbcrlf
  HTML = HTML & "TD.highlight{font-family:'Verdana',sans-serif; font-size:8pt; background-color:#FFFF77; color:#000000; border-color:#000000; border-style: solid; border-left-width:0px; border-right-width:0px; border-top-width:0px; border-bottom-width:1px;}" & vbcrlf
  HTML = HTML & "TR.dark{background-color:#EEEEEE}" & vbcrlf
  HTML = HTML & "TR.aleft TH{text-align:left}" & vbcrlf
  HTML = HTML & "</STYLE>" & vbcrlf

  HTML = HTML & "  <body>" & vbcrlf
  HTML = HTML & "    <H1>" & SDB.Localize("Recommended changes to capitalization:") & "</H1>" & vbcrlf
  HTML = HTML & "    <table border=""0"" cellspacing=""0"" cellpadding=""4"" width=""100%"">" & vbcrlf
  HTML = HTML & "      <tr class=""aleft"">" & vbcrlf
  HTML = HTML & "        <th>" & SDB.Localize("Artist") & "</th>" & vbcrlf
  HTML = HTML & "        <th>" & SDB.Localize("Title") & "</th>" & vbcrlf
  HTML = HTML & "        <th>" & SDB.Localize("Album") & "</th>" & vbcrlf
  HTML = HTML & "        <th>" & SDB.Localize("Album Artist") & "</th>" & vbcrlf
  HTML = HTML & "      </tr>" & vbcrlf

  Dim i, itm
  Dim artist, album, title, albumArtist
  for i=0 to trackList.count-1
    HTML = HTML & "      <tr" & Style() & ">" & vbcrlf

    Set itm = trackList.Item(i)
    artist = updateCase(itm.artistName)
    title = updateCase(itm.title)
    album = updateCase(itm.albumName)
    albumArtist = updateCase(itm.albumArtistName)
    
    HTML = HTML & outField(artist, itm.artistName)
    HTML = HTML & outField(title, itm.title)
    HTML = HTML & outField(album, itm.albumName)
    HTML = HTML & outField(albumArtist, itm.albumArtistName)
    If artist <> "" And artist <> itm.artistName Then
      holdArtist.add itm, artist
    End If
    If albumArtist <> "" And albumArtist <> itm.albumArtistName Then
      holdAlbumArtist.add itm, albumArtist
    End If
    If title <> "" And title <> itm.title Then
      holdTitle.add itm, title
    End If
    If album <> "" And album <> itm.albumName Then
      holdAlbum.add itm, album
    End If
    HTML = HTML & "      </tr>" & vbcrlf
    
  next 'i
  
  HTML = HTML & "    </table>" & vbcrlf
  HTML = HTML & "  </body>" & vbcrlf
  HTML = HTML & "</html>" & vbcrlf
  WB.SetHTMLDocument( HTML)

  SDB.Objects("holdArtist") = holdArtist
  SDB.Objects("holdAlbumArtist") = holdAlbumArtist
  SDB.Objects("holdAlbum") = holdAlbum
  SDB.Objects("holdTitle") = holdTitle
End Sub