invalid command name "snack::sound"
while executing
"snack::sound -debug 0"
(in namespace eval "::request::id3Tag" script line 261)
invoked from within
"namespace eval id3Tag {
variable ID3_2_3_types
variable ID3_2_2_types
variable ID3_2_2_retain
variable ID3_2_3_retain
variable ID3ReadO..."
(in namespace eval "::request" script line 50)
invoked from within
"namespace eval ::request $script"
("::try" body line 12)
OUTPUT BUFFER:
#------------------------------------------------------------------------------
# id3Tag 1.0
#
# ID3 Lookup functions for snackAmp Player in Tcl/Tk
#
# Copyright (C) 2001 Tom Wilkason
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
#
# Please send any comments/bug reports to
# tom.wilkason@cox.net (Tom Wilkason)
#
set [file rootname [file tail [info script]]]_History {
$Header: /cvsroot/snackamp/snackamp/lib/id3.tcl,v 1.84 2008/12/21 23:13:56 wilkason Exp $
}
interp alias {} toNative {} encoding convertto
interp alias {} fromNative {} encoding convertfrom
interp alias {} toUnicode {} encoding convertto unicode
interp alias {} fromUnicode {} encoding convertfrom unicode
##
# User API: read: id3Label
# write: id3V1Modify
#
set todo {
id3Tag stuff
- Implement 2.4 version, syncsafe and some extra fields for retention
- Handle extended headers, which are right after the main header. There is a bit
in the main header that designates one. Can just figure out its length and skip over it.
- Ability to set the language for writing comments (now ENG)
- test with known utf style tags
}
#------------------------------------------------------------------------------
# Function : id3 handling routines
# Description: Create tag list for lookup in file
# Author : Tom Wilkason
# Date : 2/6/2001
#------------------------------------------------------------------------------
namespace eval id3Tag {
variable ID3_2_3_types
variable ID3_2_2_types
variable ID3_2_2_retain
variable ID3_2_3_retain
variable ID3ReadOrder
variable ID3typesLU
variable TagIDs
variable id3v1Genres
variable id3v1ReverseLookup
variable v1Genres
variable mmMatch ""
variable rmMatch ""
variable lastGenre "Not Set"
variable TableJust
variable TableType
variable TableWidths
# TODO: make 1024 padding a setting
variable tagPadding 2048
variable ID3V12
variable ID3V2
variable ID3V1
variable ID3ReadOnly
variable ListDepth
variable preserveTime
variable preserveV2data
variable defaultEncoding
variable zeroPadTrack
variable zeroPadLookup
array set zeroPadLookup {
1 "%2.2d" 0 %d
}
##
# These are linked in externally, you may have to modifiy
#
#upvar #0 snackAmpSettings(ID3V12) ID3V12
#upvar #0 snackAmpSettings(defaultEncoding) defaultEncoding
#upvar #0 snackAmpSettings(ID3V2) ID3V2
#upvar #0 snackAmpSettings(ID3V1) ID3V1
#upvar #0 snackAmpSettings(ID3ReadOnly) ID3ReadOnly
#upvar #0 snackAmpSettings(ID3ReadOrder) ID3ReadOrder
#upvar #0 snackAmpSettings(ListDepth) ListDepth
#upvar #0 snackAmpSettings(preserveTime) preserveTime
#upvar #0 snackAmpSettings(preserveV2data) preserveV2data
#upvar #0 snackAmpSettings(zeroPadTrack) zeroPadTrack
upvar #0 MIT(ID3ReadOnly) ID3ReadOnly
upvar #0 MIT(preserveTime) preserveTime
upvar #0 MIT(preserveV2data) preserveV2data
upvar #0 MIT(zeroPadTrack) zeroPadTrack
# Includes tags up to V2.3
# This tags are retained or used
# set ID3_2_2_types_ {
# BUF "Recommended buffer size"
# CNT "Play counter"
# COM "Comments"
# CRA "Audio encryption"
# CRM "Encrypted meta frame"
# ETC "Event timing codes"
# EQU "Equalization"
# GEO "General encapsulated object"
# IPL "Involved people list"
# LNK "Linked information"
# MCI "Music CD Identifier"
# MLL "MPEG location lookup table"
# PIC "Attached picture"
# POP "Popularimeter"
# REV "Reverb"
# RVA "Relative volume adjustment"
# SLT "Synchronized lyric/text"
# TAL "Album/Movie/Show title"
# TBP "BPM (Beats Per Minute)"
# TCM "Composer"
# TCO "Content type"
# TCR "Copyright message"
# TDA "Date"
# TDY "Playlist delay"
# TEN "Encoded by"
# TFT "File type"
# TIM "Time"
# TKE "Initial key"
# TLA "Language(s)"
# TLE "Length"
# TMT "Media type"
# TOA "Original artist(s)/performer(s)"
# TOF "Original filename"
# TOL "Original Lyricist(s)/text writer(s)"
# TOR "Original release year"
# TOT "Original album/Movie/Show title"
# TP1 "Lead artist(s)/Lead performer(s)/Soloist(s)/Performing group"
# TP2 "Band/Orchestra/Accompaniment"
# TP3 "Conductor/Performer refinement"
# TP4 "Interpreted, remixed, or otherwise modified by"
# TPA "Part of a set"
# TPB "Publisher"
# TRC "ISRC (International Standard Recording Code)"
# TRD "Recording dates"
# TRK "Track number/Position in set"
# TSI "Size"
# TSS "Software/hardware and settings used for encoding"
# TT1 "Content group description"
# TT2 "Title/Songname/Content description"
# TT3 "Subtitle/Description refinement"
# TXT "Lyricist/text writer"
# TXX "User defined text information frame"
# TYE "Year"
# UFI "Unique file identifier"
# ULT "Unsychronized lyric/text transcription"
# WAF "Official audio file webpage"
# WAR "Official artist/performer webpage"
# WAS "Official audio source webpage"
# WCM "Commercial information"
# WCP "Copyright/Legal information"
# WPB "Publishers official webpage"
# WXX "User defined URL link frame"
# }
# # This tags are retained or used
# set ID3_2_3_types_ {
# AENC "Audio encryption"
# APIC "Attached picture"
# ASPI "Audio seek point index"
# COMM "Comments"
# COMR "Commercial frame"
# ENCR "Encryption method registration"
# EQU2 "Equalisation"
# EQUA "Equalization"
# ETCO "Event timing codes"
# GEOB "General encapsulated object"
# GRID "Group identification registration"
# IPLS "Involved people list"
# LINK "Linked information"
# MCDI "Music CD identifier"
# MLLT "MPEG location lookup table"
# MusicMatch "Unused"
# NCON "Unknown"
# OWNE "Ownership frame"
# PCNT "Play counter"
# POPM "Popularimeter"
# POSS "Position synchronisation frame"
# PRIV "Private frame"
# RBUF "Recommended buffer size"
# RVA2 "Relative volume adjustment"
# RVAD "Relative volume adjustment"
# RVRB "Reverb"
# SEEK "Seek"
# SIGN "Signature"
# SYLT "Synchronized lyric/text"
# SYTC "Synchronized tempo codes"
# TALB "Album/Movie/Show title"
# TBPM "BPM (beats per minute)"
# TCOM "Composer"
# TCON "Content type"
# TCOP "Copyright message"
# TDAT "Date"
# TDEN "Encoding"
# TDLY "Playlist delay"
# TDOR "Original release"
# TDRC "Recording"
# TDRL "Release"
# TDTG "Tagging"
# TENC "Encoded by"
# TEXT "Lyricist/Text writer"
# TFLT "File type"
# TIME "Time"
# TIPL "Involved people"
# TIT1 "Content group description"
# TIT2 "Title/songname/content description"
# TIT3 "Subtitle/Description refinement"
# TKEY "Initial key"
# TLAN "Language(s)"
# TLEN "Length"
# TMCL "Musician credits"
# TMED "Media type"
# TMOO "Mood"
# TOAL "Original album/movie/show title"
# TOFN "Original filename"
# TOLY "Original lyricist(s)/text writer(s)"
# TOPE "Original artist(s)/performer(s)"
# TORY "Original release year"
# TOWN "File owner/licensee"
# TPE1 "Lead performer(s)/Soloist(s)"
# TPE2 "Band/orchestra/accompaniment"
# TPE3 "Conductor/performer refinement"
# TPE4 "Interpreted, remixed, or otherwise modified by"
# TPOS "Part of a set"
# TPRO "Produced notice"
# TPUB "Publisher"
# TRCK "Track number/Position in set"
# TRDA "Recording dates"
# TRSN "Internet radio station name"
# TRSO "Internet radio station owner"
# TSIZ "Size"
# TSOA "Album sort order"
# TSOP "Performer sort order"
# TSOT "Title sort order"
# TSRC "ISRC (international standard recording code)"
# TSSE "Software/Hardware and settings used for encoding"
# TSST "Set subtitle"
# TXXX "User defined text information frame"
# TYER "Year"
# UFID "Unique file identifier"
# USER "Terms of use"
# USLT "Unsychronized lyric/text transcription"
# WCOM "Commercial information"
# WCOP "Copyright/Legal information"
# WOAF "Official audio file webpage"
# WOAR "Official artist/performer webpage"
# WOAS "Official audio source webpage"
# WORS "Official internet radio station homepage"
# WPAY "Payment"
# WPUB "Publishers official webpage"
# WXXX "User defined URL"
# }
# Know IDs we want to search for
variable v2_2_IDs [list "COM" "TAL" "TCO" "TP1" "TRK" "TT2" "TYE"]
variable v2_3_IDs [list "COMM" "TALB" "TCOM" "TCON" "TENC" "TIT2" "TMED" "TPE1" "TRCK" "TSST" "TYER" "TXXX"]
variable v2_4_IDs [list "COMM" "TALB" "TCOM" "TCON" "TENC" "TIT2" "TMED" "TPE1" "TRCK" "TSST" "TDRC" "TDOR" "TXXX"]
# TXXX should really be retained, but I don't want duplicate replay_gain subtags
# TODO: how to prevent duplicate subtags in TXXX fileds
variable ID3_2_3_retain [lsort [list "TXXX" "TSST" "TIT2" "TPE1" "TCOM" "TALB" "TYER" "TRCK" "TCON" "COMM" "APIC"]]
# Speed up access to this data, make it a real list
array set id3v1Genres {
0 "Blues" 25 "Euro-Techno" 50 "Darkwave" 75 "Polka" 100 "Humour" 125 "Dance Hall"
1 "Classic Rock" 26 "Ambient" 51 "Techno-Industrial" 76 "Retro" 101 "Speech" 126 "Goa"
2 "Country" 27 "Trip Hop" 52 "Electronic" 77 "Musical" 102 "Chanson" 127 "Drum & Bass"
3 "Dance" 28 "Vocal" 53 "Pop-Folk" 78 "Rock & Roll" 103 "Opera" 128 "Club House"
4 "Disco" 29 "Jazz+Funk" 54 "Eurodance" 79 "Hard Rock" 104 "Chamber Music" 129 "Hardcore"
5 "Funk" 30 "Fusion" 55 "Dream" 80 "Folk" 105 "Sonata" 130 "Terror"
6 "Grunge" 31 "Trance" 56 "Southern Rock" 81 "Folk/Rock" 106 "Symphony" 131 "Indie"
7 "Hip-Hop" 32 "Classical" 57 "Comedy" 82 "National Folk" 107 "Booty Bass" 132 "BritPop"
8 "Jazz" 33 "Instrumental" 58 "Cult" 83 "Swing" 108 "Primus" 133 "Negerpunk"
9 "Metal" 34 "Acid" 59 "Gangsta Rap" 84 "Fast-Fusion" 109 "Porn Groove" 134 "Polsk Punk"
10 "New Age" 35 "House" 60 "Top 40" 85 "Bebop" 110 "Satire" 135 "Beat"
11 "Oldies" 36 "Game" 61 "Christian Rap" 86 "Latin" 111 "Slow Jam" 136 "Christian Gangster"
12 "Other" 37 "Sound Clip" 62 "Pop/Punk" 87 "Revival" 112 "Club" 137 "Heavy Metal"
13 "Pop" 38 "Gospel" 63 "Jungle" 88 "Celtic" 113 "Tango" 138 "Black Metal"
14 "R&B" 39 "Noise" 64 "Native American" 89 "Blue Grass" 114 "Samba" 139 "Crossover"
15 "Rap" 40 "Alt. Rock" 65 "Cabaret" 90 "Avantegarde" 115 "Folklore" 140 "Contemporary Club"
16 "Reggae" 41 "Bass" 66 "New Wave" 91 "Gothic Rock" 116 "Ballard" 141 "Christian Rock"
17 "Rock" 42 "Soul" 67 "Psychedelic" 92 "Progressive Rock" 117 "Power Ballard" 142 "Merengue"
18 "Techno" 43 "Punk" 68 "Rave" 93 "Psychedelic Rock" 118 "Rhythmic Soul" 143 "Salsa"
19 "Industrial" 44 "Space" 69 "Showtunes" 94 "Symphonic Rock" 119 "Freestyle" 144 "Thrash Metal"
20 "Alternative" 45 "Meditative" 70 "Trailer" 95 "Slow Rock" 120 "Duet" 145 "Anime"
21 "Ska" 46 "Instrumental Pop" 71 "Lo-Fi" 96 "Big Band" 121 "Punk Rock" 146 "JPop"
22 "Death Metal" 47 "Instrumental Rock" 72 "Tribal" 97 "Chorus" 122 "Drum Solo" 147 "Synthpop"
23 "Pranks" 48 "Ethnic" 73 "Acid Punk" 98 "Easy Listening" 123 "A Cappella"
24 "Soundtrack" 49 "Gothic" 74 "Acid Jazz" 99 "Acoustic" 124 "Euro-House"
-1 "Unknown" 254 "Unknown" 255 "Unknown" None "Unknown"
}
# Order shown on editor
variable v1Parts [list "Title" "Artist" "Comp" "Album" "Year" "Note" "Track" "SubGenre" "Gain" "AlbumGain" "Genre"]
foreach {index value} [array get id3v1Genres] {
lappend v1Genres $value
set id3v1ReverseLookup($value) $index
}
set v1Genres [lsort -unique $v1Genres]
set TagIDs [list Artist Title Album Track Media Year Genre Note Comp Enc Desc]
variable oggSound [snack::sound -debug 0]
variable littleEndian [expr {$::tcl_platform(byteOrder) == "littleEndian"}]
# Byte Order Mark, needed for endian issues (UTF-16)
variable BOM
if {$littleEndian} {
set BOM "\xFF\xFE"
} else {
set BOM "\xFE\xFF"
}
}
proc id3Tag::saLog {args} {
puts "$args"
return
}
#------------------------------------------------------------------------------
# Function : id3Label
# Description: Return an appropriate ID3 Label in an array
# Additional tags are appended to the Desc field (V2 has soo many...)
# Author : Tom Wilkason
# Date : 2/7/2001
#------------------------------------------------------------------------------
proc id3Tag::id3Label {file _Array {types "V1 V2 OGG"}} {
upvar $_Array Array
# Get data V1 then V2
foreach type $types {
unset -nocomplain data
id3${type}Get $file data
if {[array size data] > 0} {
array set Array [array get data]
return 1
} ; #end if data
}
return 0
}
#----------------------------------------------------------------------------
# Read the tag(s) from the file
# bug: The last tag type written is returned to addition to the database
# The order should be in the read order to the tag type represents
# the first one read not just V2
# TODO: Handle ogg tag writes & reduce duplicate tag reads
#----------------------------------------------------------------------------
proc id3Tag::id3Modify {file _Data} {
#Trace
variable ID3V2
variable ID3V1
variable ID3OGG
variable ID3ReadOrder
set mods 0
set dirty 0
upvar $_Data Data
foreach {Type} [lflip $ID3ReadOrder] {
switch -- $Type {
V1 {
# Write to any type of file
set mode [set ID3$Type]
set AltTag V2
}
V2 {
#Only to mp3 files
if {![ismp3 $file]} {
continue
}
set mode [set ID3$Type]
set AltTag V1
}
OGG {
# only to ogg files
if {![isogg $file]} {
continue
}
set mode "Always"
set AltTag V1
}
default {
continue
}
}
##
# Check for V1 tags
#
unset -nocomplain tagData
unset -nocomplain inData
copyArrayData inData Data
# Copy incoming for valid fields
# TODO: Handle write errors
switch -glob -- $mode {
"Never" {}
"Always" {
# if tag is new, merge in alt tag data
if {![id3Tag::id3${Type}Get $file tagData]} {
# we may have already posted the alt tag the first loop,
# so reading from disk, it will be the same. So force a
# write to disk of this tag since we know it is blank.
id3Tag::id3${AltTag}Get $file tagData
id3Tag::diffData inData tagData
if {[id3${Type}Modify $file inData]} {
incr dirty
}
} elseif {[id3Tag::diffData inData tagData]} {
id3${Type}Modify $file inData
incr dirty
}
}
"*Exist*" {
if {[id3Tag::id3${Type}Get $file tagData] && [id3Tag::diffData inData tagData]} {
if {[id3${Type}Modify $file inData]} {
incr dirty
}
}
}
"*New*" {
if {[id3Tag::id3${Type}Get $file tagData]==0} {
id3Tag::diffData inData tagData
if {[id3${Type}Modify $file inData]} {
incr dirty
}
}
}
default {}
}
# Copy over any valid data fields, ignore blank tags
copyArrayData outData inData
}
# Update database if this tag had data
if {$dirty} {
unset -nocomplain Data
array set Data [array get outData]
cleanCodes Data
db::cacheFile $file Data 0
incr mods
}
return $mods
}
#------------------------------------------------------------------------------
# Remove any dangling multi-match or keep-tag entries so they
# don't get into the database
#------------------------------------------------------------------------------
proc id3Tag::cleanCodes {_data} {
variable mmMatch
variable rmMatch
upvar $_data data
foreach {key value} [array get data] {
if {$value eq $mmMatch} {
;# unset data($key) ;# generally we want to leave it along
set data($key) ""
} elseif {$value eq $rmMatch} {
set data($key) ""
}
}
}
#----------------------------------------------------------------------------
# Return the syncsafe length used for tag length
#----------------------------------------------------------------------------
proc id3Tag::syncSafeGet {block} {
binary scan $block "c1c1c1c1" a b c d
# synchsafe: 7 bits of each byte are used for a total of 28 bits (256Mb)
set length [expr {($a<<21 | $b<<14 | $c<<7 | $d) & 0xFFFFF}]
return $length
}
proc id3Tag::unsyncSafeGet {block} {
binary scan $block "c1c1c1c1" a b c d
# non sync safe length
set length [expr {(($a&0xFF)<<24 | ($b&0xFF)<<16 | ($c&0xFF)<<8 | ($d&0xFF))& 0xFFFFF}]
return $length
}
#------------------------------------------------------------------------------
# Function : ideTag::id3V2Get
# Description: Return a V2 tag from using a file name, a list of all known fields
# Author : Tom Wilkason
# Date : 3/17/2002
# todo: set data [zlib deflate cdata ?bufsize?]
#------------------------------------------------------------------------------
proc id3Tag::id3V2Get {file _data} {
#Trace
upvar $_data data
variable v2_2_IDs
variable v2_3_IDs
variable v2_4_IDs
variable id3v1Genres
set result [list]
# if already open as channel id, don't open again
if {[string length [file channel $file]]} {
set fid $file
set closeFid 0
} else {
if {[catch {open $file r} fid]} {
saLog $fid
return 0
}
fconfigure $fid -translation binary -encoding binary
set closeFid 1
}
# Have ID, get data
if {[catch {set block [read $fid 10]} result] } then {
if {$closeFid} {
close $fid
}
saLog $result
return 0
}
# set info {
# The first part of the ID3v2 tag is the 10 byte tag header, laid out
# as follows:
#
# 0-2 ID3v2/file identifier "ID3"
# 3-4 ID3v2 version $04 00 (V2.4.0)
# 5 ID3v2 flags %abcd0000
# 6-9 ID3v2 size 4 * %0xxxxxxx
#
# The first three bytes of the tag are always "ID3", to indicate that
# this is an ID3v2 tag, directly followed by the two version bytes. The
# first byte of ID3v2 version is its major version, while the second
# byte is its revision number. In this case this is ID3v2.4.0. Version or
# revision will never be $FF.
# 2.2 Tags
# Frame ID T T 2 (three characters)
# Frame size b c d
# Text encoding $xx
# ISO-8859-1 -> $00
# Unicode -> $01
# Information
# 2.3 tags
# ID3v2/file identifier "ID3" 0-2
# ID3v2 version $03 00 3-4
# ID3v2 flags %abc00000
# ID3v2 size 4 * %0xxxxxxx
#
# Frame ID T I T 2 (four characters)
# Size a b c d
# Flags $xx xx (status & encoding)
# Text encoding $xx (for fields allowing encoding)
# ISO-8859-1 -> $00
# Unicode -> $01
# Information
# 2.4 tags
# ID3v2/file identifier "ID3"
# ID3v2 version $04 00
# ID3v2 flags %abcd0000 d=footer present
# ID3v2 size 4 * %0xxxxxxx
#
# Frame ID T I T 2 (four characters)
# Size a b c d (syncsafe)
# Flags $xx xx (status & encoding)
# Text encoding $xx (for fields allowing encoding)
# ISO-8859-1 -> $00
# Unicode -> $01
# Information
# }
if {[string range $block 0 2] eq "ID3"} {
# Determine the frame length and read the rest of the id3 header
# The ID3v2 tag size is encoded with four bytes where the most
# significant bit (bit 7) is set to zero in every byte, making a total
# of 28 bits. The zeroed bits are ignored, so a 257 bytes long tag is
# represented as $00 00 02 01.
#
# The ID3v2 tag size is the size of the complete tag after
# unsychronisation, including padding, excluding the header but not
# excluding the extended header (total tag size - 10). Only 28 bits
# (representing up to 256MB) are used in the size description to avoid
# the introducuction of 'false syncsignals'.
binary scan [string range $block 3 5] "h1h1h1" majVer minVer flag
set length [syncSafeGet [string range $block 6 9]]
if {$length <= 0} {
saLog "Negative ID3V2 length of $length found for $file"
if {$closeFid} {
close $fid
}
return 0
}
# we will scan right over the extended header (works for now)
if {[catch {expr {($flag>>7)&0x1}} unsync]} then {
close $fid
saLog "$file\n$::errorInfo"
return 0
}
# see 6.1. The unsynchronisation scheme
# in http://www.id3.org/id3v2.4.0-structure.txt
# for handling
set exthead [expr {($flag>>6)&0x1}] ;#b
set exp [expr {($flag>>5)&0x1}] ;#c
set footer [expr {($flag>>4)&0x1}] ;#d (2.4 unique)
if {$exthead} {
set exthead [read $fid 6]
if {$majVer==4} {
set extlength [syncSafeGet $exthead]
} else {
set extlength [unsyncSafeGet $exthead]
}
saLog "Extended header of $extlength in $file"
read $fid $extlength
}
#set footer [expr {$flag&0x1}]
switch -- $majVer {
2 {set useTypes $v2_2_IDs}
3 {set useTypes $v2_3_IDs}
4 {set useTypes $v2_4_IDs}
default {
saLog "Tag Version 2.$majVer.$minVer is not supported for $file"
if {$closeFid} {
close $fid
}
return 0
}
}
#----------------------------------------------------------------------------
# read and trim padding, unsync if necessary, then parse the block
#----------------------------------------------------------------------------
set rawblock [read $fid $length]
# 2.3 unsync at entire tag level
# 2.4 unsync is also done on frame level (but not here), and only if frame indicates unsync
if {$unsync} {
set unsynctag {\xFF\x00}
if {[regexp -all -indices -- $unsynctag $rawblock hits]} {
saLog "unsyncs found at $hits"
# TODO: here is where we replace the \xFF\x00 with \xFF
}
}
# Need trailing null incase last character is a unicode
###id3V2ParseBlock "[string trimright $rawblock \0]\0" $useTypes $majVer tagdata
if {[catch {id3Tag::id3V2WalkBlock $rawblock $majVer tagdata} result] } then {
saLog $result
close $fid
return 0
}
#----------------------------------------------------------------------------
# Iterate through each pair and grab the appropriate data
#----------------------------------------------------------------------------
array set bstart {2 7 3 11 4 11} ;# version dependent
array set encidx {2 6 3 10 4 10} ;# version dependent
foreach {type typeData} [array get tagdata] {
set idx 1
foreach {block} $typeData {
binary scan [string index $block $encidx($majVer)] c1 benc
if {![info exists benc] || ![string is integer -strict $benc]} {
#debug "Tag $type in $file is invalid..Skipping!"
continue
}
# TODO: need to handle frame unsynchronization, like tag unsync above
set String [string range $block $bstart($majVer) end]
if {$idx>1} {append String ":"}
switch -- $type {
"APIC" {
# Parse the APIC frame and return the binary image portion
foreach {MIME Type Desc Image} [id3Tag::parseAPIC $String $benc] {break}
#debug "Found [string bytelength $Image] in $file"
set data(Image) $Image
#TODO: return image MIME (fill in if needed)
# return Type description
}
"TPE1" - "TP1" {append data(Artist) [id3Clean [id3Decode $benc $String]]}
"TIT2" - "TT2" {append data(Title) [id3Clean [id3Decode $benc $String]]}
"TALB" - "TAL" {append data(Album) [id3Clean [id3Decode $benc $String]]}
"TRCK" - "TRK" {
set data(Track) [cleanTrack [id3Clean [id3Decode $benc $String]]]
}
"TDRC" {
if {$majVer==4} {
append data(Year) [id3Clean [id3Decode $benc $String]]
}
}
"TYER" {
if {$majVer==3} {
append data(Year) [id3Clean [id3Decode $benc $String]]
}
}
"TYE" {
if {$majVer==2} {
append data(Year) [id3Clean [id3Decode $benc $String]]
}
}
"COMM" - "COM" {
# engÿþxxx\0ÿþxxxx
# First three bytes are the language, ingore it
set String [id3Decode $benc [string range $String 3 end]]
if {$idx>1} {append String ":"}
set note [string map {\0 :} [string trim $String \0]]
# HACK: Some comments are just a single 0, not sure why
if {$note eq "0"} {
append data(Note) ""
} else {
append data(Note) $note
}
}
"TCON" - "TCO" {
;# (num) indicates a V1 tag reference, so look it up
set String [id3Clean [id3Decode $benc $String]]
if {[regexp {\((.+)\)(.*)} $String -> v1 refine]} {
if {[info exists id3v1Genres($v1)]} {
set String $id3v1Genres($v1)
} else {
set String "Unknown"
}
if {[string length $refine]} {append String "-$refine"}
}
if {$idx>1} {append String ":"}
append data(Genre) $String
}
"TCOM" - "TCM" {
append data(Comp) [id3Clean [id3Decode $benc $String]]
}
"TMED" {append data(Media) [id3Clean [id3Decode $benc $String]]}
"TENC" {append data(Enc) [id3Clean [id3Decode $benc $String]]}
"TSST" {append data(SubGenre) [id3Clean [id3Decode $benc $String]]}
"TXXX" {
set txt [id3Decode $benc $String]
set txt [string map {\0 " "} $txt]
set fnt ""
set val ""
set db ""
## Support ID3 replaygain values, which is what Rockbox uses
## Only take first instance of tag since it is most important
## TODO: Some replay gain tags have a leading 0xFF in front of number that
## isn't removed. Causes string is double to fail
#REPLAYGAIN_TRACK_GAIN done
#REPLAYGAIN_ALBUM_GAIN done
#REPLAYGAIN_PEAK_GAIN todo
#REPLAYGAIN_ALBUM_PEAK todo
switch -glob -- $txt {
"replaygain_album_gain*" {
if {![info exists data(album_gain)]} {
foreach {fnt val db} [split $txt "\0 "] {break}
#utf16 still isn't working quite right, has a leading 0xff at the front
if {$benc eq "1"} {
set val [string range $val 1 end]
}
if {[string is double -strict $val]} {
set data(album_gain) $val
set data(AlbumGain) [fromDb $val]
} else {
#debug "$file Invalid album gain: '$val' '$db'"
}
}
#saLog "$fnt : $val"
}
"replaygain_track_gain*" {
if {![info exists data(track_gain)]} {
foreach {fnt val db} [split $txt "\0 "] {break}
# kludge, benc files of 1 have a leading 0xFF as first char
# can't seem to strip it off
if {$benc eq "1"} {
# binary scan [string range $val 0 0] H* car
#puts "'$car'"
set val [string range $val 1 end]
}
#set val [id3Clean $val]
if {[string is double -strict $val]} {
set data(track_gain) $val
set data(Gain) [fromDb $val]
} else {
#debug "$file Invalid track gain: '$val' '$db' [string length $val]"
}
}
#saLog "$fnt : $val"
}
default {}
}
#saLog "$idx = [id3Clean [id3Decode $benc $String]]"
}
default {}
}
incr idx
}
}
if {$closeFid} {
close $fid
}
set data(Tag) "V2.$majVer.$minVer"
return [array size data]
} else {
if {$closeFid} {
close $fid
}
return 0
}
}
# 4.15.Attached picture
#
# This frame contains a picture directly related to the audio file. Image
# format is the MIME type and subtype for the image. In the event that the
# MIME media type name is omitted, "image/" will be implied. The
# "image/png" or "image/jpeg" picture format should be used when
# interoperability is wanted. Description is a short description of the
# picture, represented as a terminated textstring. The description has a
# maximum length of 64 characters, but may be empty. There may be several
# pictures attached to one file, each in their individual "APIC" frame, but
# only one with the same content descriptor. There may only be one picture
# with the picture type declared as picture type $01 and $02 respectively.
# There is the possibility to put only a link to the image file by using the
# 'MIME type' "-->" and having a complete URL instead of picture data. The
# use of linked files should however be used sparingly since there is the
# risk of separation of files.
#
#
# Text encoding $xx [0]
# MIME type $00 [1]
# Picture type $xx [2]
# Description $00 (00) [3]
# Picture data
#
# Picture type: $00 Other
# $01 32x32 pixels 'file icon' (PNG only)
# $02 Other file icon
# $03 Cover (front)
# $04 Cover (back)
# $05 Leaflet page
# $06 Media (e.g. lable side of CD)
# $07 Lead artist/lead performer/soloist
# $08 Artist/performer
# $09 Conductor
# $0A Band/Orchestra
# $0B Composer
# $0C Lyricist/text writer
# $0D Recording Location
# $0E During recording
# $0F During performance
# $10 Movie/video screen capture
# $11 A bright coloured fish
# $12 Illustration
# $13 Band/artist logotype
# $14 Publisher/Studio logotype
#
#------------------------------------------------------------------------------
# Build an APIC string
#------------------------------------------------------------------------------
proc id3Tag::buildAPIC {String benc} {
append image $benc ;#encoding
append image "image/jpeg\0" ;#MIME Type
append image \03 ;#Picture Type of cover art
append image "Cover Art\0" ;#Description
append image $String ;#image
return $image
}
#------------------------------------------------------------------------------
# Parse an APIC string
#------------------------------------------------------------------------------
proc id3Tag::parseAPIC {String benc} {
#MIME Type
set send [string first \0 $String];
set MIME [string range $String 0 [expr {$send-1}]]
set MIME [id3Decode $benc $MIME]
#Picture Type
set Type [string range $String [expr {$send+1}] [expr {$send+1}] ]
#Description
set String [string range $String [expr {$send+2}] end ]
set send [string first \0 $String];
set Desc [string range $String 0 [expr {$send-1}] ]
set Desc [id3Decode $benc $Desc]
#Image
set String [string range $String [expr {$send+1}] end ]
#puts $MIME
#puts $Desc
return [list $MIME $Type $Desc $String]
}
#----------------------------------------------------------------------------
# Grab an APIC frame out of the file
#----------------------------------------------------------------------------
proc id3Tag::getImage {file} {
#Trace
id3Tag::id3V2Get $file Data
if {[info exists Data(Image)] && ([string length $Data(Image)] > 255)} {
return $Data(Image)
} else {
return ""
}
}
#------------------------------------------------------------------------------
# Test to pull an APIC image from one file and insert into another file
#------------------------------------------------------------------------------
proc id3Tag::ImageEmbedFolder {folder {recurse 0}} {
lappend folders $folder
if {$recurse} {
foreach {fld} [aplFolder::foldersMatchingPattern [file join $folder *] 1] {
lappend folders $fld
}
}
set folders [lsort -unique $folders]
foreach {folder} $folders {
foreach {actName valid} [albumart::covername $folder] {break}
set done 0
if {$valid} {
;# need to convert jpeg to image here and resize to some max size
foreach {mp3file} [glob -nocomplain -directory $folder *.mp3] {
if {[file writable $mp3file]} {
incr done
set eimage [id3Tag::getImage $mp3file]
if {$eimage eq ""} {
# Need to convert into jpeg data regardless of file type
# also, limit to 500 x 500 as max size
id3Tag::putImageFromFile $mp3file $actName
#debug "$mp3file now has an image"
update
} else {
#debug "$mp3file has an image already"
}
} else {
#debug "$mp3file is not writable"
}
}
#debug "$done files checked"
} else {
#debug "$folder did not have a valid cover art file"
}
}
}
#----------------------------------------------------------------------------
# Insert an ID3 APIC frame into a file from an image file (scaled)
#----------------------------------------------------------------------------
proc id3Tag::putImageFromFile {file ifile} {
#Trace
if {[file exists $file] && [file exists $ifile]} {
set fid [open $ifile r]
fconfigure $fid -translation binary -encoding binary
set data [read $fid]
close $fid
return [putImageFromData $file $data]
} else {
saLog "[me] $file or $ifile do no exist"
return 0
}
}
#----------------------------------------------------------------------------
# Insert an ID3 APIC frame into a file from raw (formatted data)
#----------------------------------------------------------------------------
proc id3Tag::putImageFromData {file data} {
#Trace
if {[file exists $file]} {
id3Tag::id3V2Get $file Data
set Data(Image) $data
id3Tag::id3V2Modify $file Data
return 1
} else {
saLog "[me] $file or $ifile do no exist"
return 0
}
}
#----------------------------------------------------------------------------
# Insert an ID3 APIC frame into a file from an image name (scaled)
#----------------------------------------------------------------------------
proc id3Tag::putImageFromImage {file imageName size} {
#Trace
package require base64
id3Tag::id3V2Get $file Data
image create photo id3Tag::scaledImage -format jpeg
tkImageTools::resize $imageName id3Tag::scaledImage $size $size
#image write $imageFile -format jpeg "should work to convert"
# TODO: Need to convert to jpeg then base64::decode data
set Data(Image) [base64::decode [$imageName data]]
#debug putImageFromImage [string bytelength $Data(Image)]
id3Tag::id3V2Modify $file Data
return 1
}
#----------------------------------------------------------------------------
# Convert a tag from either unicode or standard encoding
#----------------------------------------------------------------------------
proc id3Tag::id3Decode {mode String} {
#puts "mode $mode"
switch -- $mode {
\0 - 0 {
# $00 ISO-8859-1 [ISO-8859-1]. Terminated with $00.
set String [fromNative $String]
#puts "native"
}
\1 - 1 {
# $01 UTF-16 [UTF-16] encoded Unicode [UNICODE] with BOM. All
# strings in the same frame SHALL have the same byteorder.
# Terminated with $00 00.
set String [swapUnicode $String]
#puts "swapUnicode"
}
\2 - 2 {
# $02 UTF-16BE [UTF-16] encoded Unicode [UNICODE] without BOM.
# Terminated with $00 00.
set String [fromUnicode $String]
#puts "fromUnicode"
}
\3 - 3 {
# $03 UTF-8 [UTF-8] encoded Unicode [UNICODE]. Terminated with $00.
set String [encoding convertfrom utf-8 $String]
#puts "convertfrom utf-8"
}
}
return $String
}
#------------------------------------------------------------------------------
# If nothing else is said, strings, including numeric strings and URLs
# [URL], are represented as ISO-8859-1 [ISO-8859-1] characters in the
# range $20 - $FF. Such strings are represented in frame descriptions
# as , or if newlines are allowed. If
# nothing else is said newline character is forbidden. In ISO-8859-1 a
# newline is represented, when allowed, with $0A only.
#
# Frames that allow different types of text encoding contains a text
# encoding description byte. Possible encodings:
#
# Encode a string to unicode if required
# note the built in "unicode" is ucs-2 not utf-16 as required
# by the ID3 spec, todo: fix in the future.
# $00 ISO-8859-1 [ISO-8859-1]. Terminated with $00.
# $01 UTF-16 [UTF-16] encoded Unicode [UNICODE] with BOM. All
# strings in the same frame SHALL have the same byteorder.
# Terminated with $00 00.
# $02 UTF-16BE [UTF-16] encoded Unicode [UNICODE] without BOM.
# Terminated with $00 00.
# $03 UTF-8 [UTF-8] encoded Unicode [UNICODE]. Terminated with $00.
# Strings dependent on encoding are represented in frame descriptions
# as , or if newlines are allowed. Any empty strings of
# type $01 which are NULL-terminated may have the Unicode BOM followed
# by a Unicode NULL ($FF FE 00 00 or $FE FF 00 00).
#------------------------------------------------------------------------------
proc id3Tag::id3Encode {mode string} {
variable littleEndian
variable BOM
switch -- $mode {
\0 {return [toNative $string]}
\1 {return "$BOM[toUnicode $string]\0\0"}
\2 {return "[toUnicode $string]\0\0";#needs to be Big Endian format}
\3 {return [encoding convertto utf-8 $string]\0}
default {return $string}
}
}
#------------------------------------------------------------------------------
# Function : id3Tag::id3V2Modify
# Description: Write out the ID3V2 tag, may require rewriting the entire file
# Author : Tom Wilkason
# Date : 1/30/2004
# Notes: Will skip embedded binary data
# Won't handle compression or header extensions properly
# Should write out older version of tag
#-----------------------------------------------------------------------------
proc id3Tag::id3V2Modify {file _data} {
#Trace
variable tagPadding
variable preserveTime
variable ID3ReadOnly
variable ID3_2_3_retain
variable preserveV2data
variable defaultEncoding
variable mmMatch
variable rmMatch
set Tag ""
switch -glob -- $defaultEncoding {
"Never" {set enc \0}
"Always" {set enc \1}
"*Needed" {set enc 0}
default {set enc \0}
}
upvar $_data data
##
# We know we have changes, ready for write
#
if {![file writable $file] || $ID3ReadOnly} {
tk_messageBox -type ok -icon warning -message "You don't have write permission for $file"
return 0
}
#----------------------------------------------------------------------------
# Read existing file to get tag size
#----------------------------------------------------------------------------
if {[catch {open $file r+} fid]} {
tk_messageBox -type ok -icon warning -message "Could not open file $file for writing"
saLog "[me] Could not open file $file for writing"
return 0
}
set mtime [file mtime $file]
# Read 10 byte header
fconfigure $fid -translation binary -encoding binary -buffersize 512000 -buffering full
if {[catch {read $fid 10} block] } then {
close $fid
saLog "[me] $file $block"
return 0
}
set existingTagLen 0
if {[string range $block 0 2] == "ID3"} {
# Determine the frame length and read the rest of the id3 header
binary scan [string range $block 3 5] "h1h1h1" majVer minVer flag
set existingTagLen [syncSafeGet [string range $block 6 9]]
if {$existingTagLen <= 0} {
saLog "[me] $file has an invalid ID3V2 tag length of $existingTagLen"
close $fid
return 0
}
##
# Read the existing block if it exists and the user wants to save it
# TODO: We are only keeping 2.3+ data, do we need to save 2.2 data?
if {$preserveV2data} {
# Need trailing null incase last character is a unicode
set rawblock "[string trimright [read $fid $existingTagLen] \0]\0"
##id3V2ParseBlock $rawblock $ID3_2_3_retain 3 existingTags
if {[catch {id3Tag::id3V2WalkBlock $rawblock $majVer existingTags} result] } then {
saLog $result
close $fid
return 0
}
}
set tempNeeded 0
} else {
set tempNeeded 1
}
#----------------------------------------------------------------------------
# build up new tag from "data"
#----------------------------------------------------------------------------
foreach {field String} [array get data] {
set stLen [string length $String]
# Ignore zero len and special tag
if {$stLen==0 || $String eq $mmMatch || $String eq $rmMatch} {
continue
}
## Only TXXX flags get the encoding!
set blen [string bytelength $String] ;# used to detect possible utf/unicode string
##
# Check if we auto-convert to unicode if needed
#
if {$enc==0} {
if {$blen>$stLen} {
set uenc \1
} else {
set uenc \0
}
} else {
set uenc $enc
}
set encString [id3Encode $uenc $String]
set encSlen [string length $encString]
incr encSlen
set flags [binary format c1c1 0 0]
# Only T*** fields have encoding as second byte
switch -exact -- $field {
"Image" {
# need to build up header
set uenc \0 ;# force for raw data
set str [id3Tag::buildAPIC $String $uenc]
# string length instead of string bytelength works
append Tag "APIC" [tagLen [string length $str]] $flags $str
}
"Title" {append Tag "TIT2" [tagLen $encSlen] $flags $uenc $encString}
"SubGenre" {append Tag "TSST" [tagLen $encSlen] $flags $uenc $encString}
"Artist" {append Tag "TPE1" [tagLen $encSlen] $flags $uenc $encString}
"Comp" {append Tag "TCOM" [tagLen $encSlen] $flags $uenc $encString}
"Album" {append Tag "TALB" [tagLen $encSlen] $flags $uenc $encString}
"Year" {append Tag "TYER" [tagLen $encSlen] $flags $uenc $encString}
"Track" {append Tag "TRCK" [tagLen $encSlen] $flags $uenc $encString}
"Genre" {append Tag "TCON" [tagLen $encSlen] $flags $uenc $encString}
"album_gain" {
set encString [id3Encode $uenc "replaygain_album_gain\0$String db" ]
set encSlen [string length $encString]
incr encSlen
append Tag "TXXX" [tagLen $encSlen] $flags $uenc $encString
}
"track_gain" -
"album_gain" {
set encString [id3Encode $uenc "replaygain_$field\0$String db" ]
set encSlen [string length $encString]
incr encSlen
append Tag "TXXX" [tagLen $encSlen] $flags $uenc $encString
}
"Note" {
append Tag "COMM" [tagLen [expr {$encSlen+3}]] $flags $uenc "ENG" $encString
} ;# lang is ENG (for now)
default {
}
}
}
#----------------------------------------------------------------------------
# Append existing tags so we retain the existing data in raw format
# Skip tags we just replaced.
#----------------------------------------------------------------------------
foreach {index exvalue} [array get existingTags] {
foreach {value} $exvalue {
if {[lsearch -sorted -exact $ID3_2_3_retain $index] < 0} {
append Tag $value
#puts "Keeping $value"
} else {
#puts "Tossing $value"
}
}
}
#----------------------------------------------------------------------------
# Build the binary tag including the header
#----------------------------------------------------------------------------
seek $fid 0 start
set tagLen [string length $Tag]
#puts "[me] $file existing tag length=$existingTagLen,new tag len=$tagLen"
if {$tagLen > 0} {
set TAG "ID3"
set topad [expr {$existingTagLen-$tagLen}]
# If we are out of room, then create new padding
if {$topad < 0} {
set topad $tagPadding
# Need to create new tag, skip existing tag+header
if {$existingTagLen > 0} {
seek $fid [expr {$existingTagLen+10}]
set tempNeeded 1
#puts "$topad $existingTagLen $tagLen\n'$Tag'"
}
}
incr tagLen $topad
# tag length of 10 not included in header size
# todo: make this sync safe
set d [expr {($tagLen) & 0x7F}]
set c [expr {($tagLen>>7) & 0x7F}]
set b [expr {($tagLen>>14) & 0x7F}]
set a [expr {($tagLen>>21) & 0x7F}] ;# Ver 2.3.0 with no flags
append TAG [binary format "h1h1h1c1c1c1c1" 3 0 0 $a $b $c $d]
append TAG $Tag
append TAG [string repeat \0 $topad]
} else {
# We don't have any tag data to write, bail
close $fid
return 0
}
set data(Tag) "V2.3.0" ;# later go to 2.4.0
#----------------------------------------------------------------------------
# If we need to insert the data, make a temp file then remove the old
#----------------------------------------------------------------------------
if {$tempNeeded} {
#puts "[me] $file needs extra padding...$existingTagLen->$tagLen"
##
# Snackamp Unique, stop track if playing and resume
#
set wasPlaying [soundControl::isPlayingTrack $file playlocation]
set tfile [file join [file dirname $file] "[clock clicks].tmp"]
if {[catch {open $tfile w} ftd]} {
close $fid
saLog "[me] $tfile $ftd"
return 0
}
# Have ID, get data
fconfigure $ftd -translation binary -encoding binary -buffersize 512000 -buffering full
# Handle errors, such as if disk is full
if {[catch {
puts -nonewline $ftd $TAG
# keep music playing
while {![eof $fid]} {
fcopy $fid $ftd -size 256000 ;# hardcoded
#Update
}
} result] } then {
catch {close $ftd}
catch {close $fid}
file delete -force -- $tfile
saLog $result
return 0
} else {
close $ftd
close $fid
}
# If we have an error removing the old file, cleanup properly
if {[catch {file delete -force -- $file} result] } then {
saLog $result
file delete -force -- $tfile
return 0
} else {
catch {file rename -force -- $tfile $file}
}
##
# Snackamp Unique, resume track playing and resume
#
if {$wasPlaying} {
soundControl::resumePlayingTrack $file $playlocation
}
} else {
puts -nonewline $fid $TAG
close $fid
}
##
# Restore the old timestamp if needed
# todo: Remove this option, is doesn't work well with cataloging
if {$preserveTime} {
if {[catch {file mtime $file $mtime} result] } then {
saLog "Could not reset file time attribute for $file"
}
}
db::updateTimeTag $file
return 1
}
#----------------------------------------------------------------------------
# Return the raw tags in a file
# (either the ones we want or the ones we want to retain)
#----------------------------------------------------------------------------
proc id3Tag::id3V2ParseBlock {block validTags majVer _data} {
upvar $_data data
set length [string length $block]
##
# Scan over each one, and save away the tags in the master list
# Note: This searches the entire tag for each candidate, there
# is most likely a faster way to do this by walking the tag space.
#
foreach {type} $validTags {
set offset 0
set loopIndex 0;
# To speed up limit maxLoops to 1 (num tags to retrieve)
set maxLoops 5
while {[incr loopIndex] <= $maxLoops} {
set loc [string first $type $block $offset]
set enc -1
if {$loc >= 0} {
switch -- $majVer {
2 {
# 2.2 Tags
# Frame ID T T 2 (three characters)
# Frame size b c d
# Text encoding $xx
# ISO-8859-1 -> $00
# Unicode -> $01
# Information
binary scan [string range $block [expr {$loc+3}] [expr {$loc+6}] ] "c1c1c1c1" b c d enc
set taglen [expr {(($b&0xFF)<<16 | ($c&0xFF)<<8 | ($d&0xFF))& 0xFFFFF}]
set headlen 6
}
3 {
# 2.3 tags
# Frame ID T I T 2 (four characters)
# Size a b c d
# Flags $xx xx (status & encoding)
# Text encoding $xx (for fields allowing encoding)
# ISO-8859-1 -> $00
# Unicode -> $01
# Information
binary scan [string range $block [expr {$loc+4}] [expr {$loc+10}] ] "c1c1c1c1c1c1c1" a b c d f1 f2 enc
# syncsafe version below is for majVer = 4
#set taglen [expr {(($a&0x7F)<<21 | ($b&0x7F)<<14 | ($c&0x7F)<<7 | ($d&0x7F))& 0xFFFFF}]
set taglen [expr {(($a&0xFF)<<24 | ($b&0xFF)<<16 | ($c&0xFF)<<8 | ($d&0xFF))& 0xFFFFF}]
set headlen 10
}
4 {
# 2.4 tags
# Frame ID T I T 2 (four characters)
# Size a b c d (syncsafe size)
# Flags $xx xx (status & encoding)
# Text encoding $xx (for fields allowing encoding)
# ISO-8859-1 -> $00
# Unicode -> $01
# Information
binary scan [string range $block [expr {$loc+4}] [expr {$loc+10}] ] "c1c1c1c1c1c1c1" a b c d f1 f2 enc
# syncsafe version below is for majVer = 4
set taglen [expr {(($a&0x7F)<<21 | ($b&0x7F)<<14 | ($c&0x7F)<<7 | ($d&0x7F))& 0xFFFFF}]
set headlen 10
}
default {
saLog "Version $majVer tags not supported"
return 0
}
}
# Handle invalid lengths and encodings in the tag
# It may be a false hit on embedded tag info in the text fields
# encoding only valid on Txxx tags
if {($taglen <= 0) || ($taglen > ($length-$offset)) \
|| ([string match T* $type] && ($enc < 0 || $enc > 1))} {
set offset [expr {$loc+1}]
continue
}
##
# start of next search (front of next tag)
#
set offset [expr {$loc+$taglen+$headlen}]
##
# Either get retained or new tags
lappend data($type) [string range $block $loc [expr {$offset-1}]]
#break ;# take the first one and bail, it has the highest priority
} else {
# Not Founds
break
}
} ;# end while
}
return 1
}
#------------------------------------------------------------------------------
# Compute the binary tag length for some length
#------------------------------------------------------------------------------
proc id3Tag::tagLen {stLen} {
set d [expr {($stLen) & 0xFF}]
set c [expr {($stLen>>8) & 0xFF}]
set b [expr {($stLen>>16) & 0xFF}]
set a [expr {($stLen>>24) & 0xFF}]
set bsize [binary format c1c1c1c1 $a $b $c $d]
return $bsize
}
#------------------------------------------------------------------------------
# Return the offset to the start of music so the ID3V2 tag can
# be skipped by a streaming server
#------------------------------------------------------------------------------
proc id3Tag::id3V2Offset {fid} {
# Have ID, get data
fconfigure $fid -translation binary -encoding binary
if {[catch {read $fid 10} block] } then {
return -code error $block
}
if {[catch {seek $fid 0 start} result] } then {
return 0
}
##
# If this is an ID3 V2, need offset to start of stream
#
if {[string range $block 0 2] == "ID3"} {
# Determine the frame length and read the rest of the id3 header
set length [syncSafeGet [string range $block 6 9]]
if {$length < 0} {
return 0
} else {
incr length 10 ;# add the header
return $length
}
}
return 0
}
#------------------------------------------------------------------------------
# Function : ideTag::id3V1Get
# Description: Return a V1 tag from using a file name, a list of known fields
# Author : Tom Wilkason
# Date : 3/17/2002
#------------------------------------------------------------------------------
proc id3Tag::id3V1Get {file _data} {
variable id3v1Genres
upvar $_data data
set result [list]
if {[catch {open $file r} fid]} {
saLog "$fid ($file)"
return 0
}
fconfigure $fid -translation binary -encoding binary
##
# ID3V1.2 tags are in the last 256 bytes of the file in a fixed format
#
if {[catch {seek $fid -256 end} ec] } {
close $fid
saLog "$ec ($file)"
return 0
}
if {[catch {read $fid 256} block]} then {
close $fid
saLog "$block ($file)"
return 0
}
close $fid
binary scan $block "a3 a30 a30 a30 a15 a20 a3 a30 a30 a30 a4 a28 ccc" \
ext extTitle extArtist extAlbum extComment extGenre \
id title artist album year comment zero track genre
# Support ID3V1.2 Extensions
if {$ext eq "EXT"} {
append title $extTitle
append artist $extArtist
append album $extAlbum
append comment $extComment
}
if {$id eq "TAG"} {
# V1.1 spec allows last comment string to be the track, if not then a comment
# If a null char before a non-null Track, the use the Track otherwise append
# to the Comment
set ver "V1"
if {$zero==0 && $track!=0} {
if {[string is integer -strict $track]} {
set ver "V1.1"
set track [toUnsigned $track]
} else {
set track ""
}
} else {
# eke out the last two chars and append to comment, they were not a track
append comment [string trim [binary format c $zero] [binary format c $track]]
set track ""
}
# Move into the array
set data(Track) [cleanTrack $track]
set data(Title) [fromNative [id3Clean $title]]
set data(Artist) [fromNative [id3Clean $artist]]
set data(Album) [fromNative [id3Clean $album]]
set data(Year) [fromNative [id3Clean $year]]
set data(Note) [fromNative [id3Clean $comment]]
# Sub Genre and tag type
if {$ext eq "EXT"} {
set sg [id3Clean $extGenre]
if {[string length $sg]} {
set data(SubGenre) $sg
}
set data(Tag) "V1.2"
} else {
set data(Tag) "$ver"
}
if {![catch {set Genre $id3v1Genres($genre)}]} {
set data(Genre) $Genre
} else {
set data(Genre) $id3v1Genres(12)
}
return [array size data]
} else {
return 0
}
}
#------------------------------------------------------------------------------
# Call with existing data, return 1 if data has changed and if so tweak
# it such that multi tags are handled properly.
# Existing data should only contain existing fields
#------------------------------------------------------------------------------
proc id3Tag::diffData {_newData _exData} {
#Trace
variable v1Parts
variable mmMatch
variable rmMatch
variable ID3V12
upvar $_newData newData
upvar $_exData exData
##
# Read in current ID3 data then compare to determine if any changes were made
#
set diff 0
# Check each field
foreach {E} $v1Parts {
##
# If new data exists
#
if {[hasData newData($E)]} {
# and old doesn't
if {![hasData exData($E)]} {
# New incoming field
if {$newData($E) eq $mmMatch} {
# keep tag
set newData($E) ""
} elseif {$newData($E) eq $rmMatch} {
# Remove Tag
set diff 1
#puts "Cleared Field $E"
set newData($E) " "
} else {
set diff 1
#puts "Added Field $E"
}
} elseif {$exData($E) ne $newData($E)} {
# Both have data, but different
# For multi-match tags, either replace or discard them
# Ignore the < Match > fields, use existing data
if {$newData($E) eq $mmMatch} {
# Use existing data (not the multi-patch string)
set newData($E) $exData($E)
#puts "Keeping Tag $E $newData($E) <-$mmMatch"
} elseif {$newData($E) eq $rmMatch} {
# Remove Tag
set newData($E) " "
set diff 1
#puts "Clear Tag $E ''<-$rmMatch"
} else {
#puts "Changed Tag $E to $newData($E)<>$exData($E))"
set diff 1
}
}
} elseif {[hasData exData($E)]} {
#puts "New data is blank but old data is not for $E"
set newData($E) $exData($E)
}
}
return $diff
}
#------------------------------------------------------------------------------
# Function : id3V1Modify
# Description: Modify the ID3V1 tag of a file
# Author : Tom Wilkason
# Date : 2/7/2001
#------------------------------------------------------------------------------
proc id3Tag::id3V1Modify {file _Data} {
#Trace
upvar $_Data oData
variable v1Parts
variable id3v1Genres
variable id3v1ReverseLookup
variable mmMatch
variable lastGenre
variable ID3V12
variable ID3ReadOnly
variable preserveTime
array set Data [array get oData]
##
# Make sure all fields are accounted for
#
foreach {field} $v1Parts {
if {![info exists Data($field)]} {
set Data($field) ""
}
}
##
# We know we have changes, ready for write
#
if {![file writable $file] || $ID3ReadOnly} {
tk_messageBox -type ok -icon warning -message "You don't have write permission for $file"
return 0
}
if {[catch {open $file r+} fid]} {
tk_messageBox -type ok -icon warning -message "Could not open file $file for writing"
return 0
}
set mtime [file mtime $file]
##
# Determine tag type and seek to appropriate location
#
fconfigure $fid -translation binary -encoding binary
if {[catch {seek $fid -256 end} result] } {
close $fid
return 0
}
set block [read $fid 256]
if {[string range $block 0 2]=="EXT"} {
if {$ID3V12} {
set offset -256
} else {
set offset -128
}
} elseif {[string range $block 128 130]=="TAG"} {
set offset -128
} else {
set offset 0
}
##
# Reseek to write location
#
if {[catch {seek $fid $offset end} result] } {
close $fid
return 0
}
##
# Handle Genre, default to 12 (Other)
set genre $Data(Genre)
if {[info exists id3v1ReverseLookup($genre)]} {
set Genre $id3v1ReverseLookup($genre)
set lastGenre $genre
} else {
set Genre 12
}
##
# Handle Track, use zero (blank) if not valid, don't interpret
# octal numbers as octal
set Track [string trimleft $Data(Track) 0]
regexp {([0-9]+).*} $Track -> Track ;# only want leading number portion
if {[string is integer -strict $Track]} {
set T c
} else {
set Track "\0"
set T a
}
##
# Write either V1 or V1.2 Tags
if {$ID3V12} {
# Support ID3V1.2 Extensions
foreach {item start} {
Title 30 Artist 30 Album 30 Note 28 SubGenre 0
} {
set ext($item) [string range $Data($item) $start end]
}
set fstring "a3 a30 a30 a30 a15 a20 a3 a30 a30 a30 a4 a28 c${T} c"
set block [binary format $fstring \
EXT \
[toNative $ext(Title)] \
[toNative $ext(Artist)] \
[toNative $ext(Album)] \
$ext(Note) \
$ext(SubGenre) \
TAG \
[toNative $Data(Title)] \
[toNative $Data(Artist)] \
[toNative $Data(Album)] \
$Data(Year) \
$Data(Note) \
0 $Track $Genre]
set Data(Tag) "V1.2"
} else {
set fstring "a3 a30 a30 a30 a4 a28 c${T} c"
set block [binary format $fstring \
TAG \
[toNative $Data(Title)] \
[toNative $Data(Artist)] \
[toNative $Data(Album)] \
$Data(Year) \
$Data(Note) \
0 $Track $Genre]
set Data(Tag) "V1.1"
}
puts -nonewline $fid $block
close $fid
##
# Make sure we don't have fields we don't intend to have
# Who cares?
# foreach {field} [list size sampRate FullData Played Gain Rating Votes date Mounted LastPlay Votes Start Stop Rate Duration] {
# if {[info exists Data($field)]} {
# debug "Found unexpected field $field, [array size Data] fields"
# continue
# }
# }
##
# Restore the old timestamp if needed
if {$preserveTime} {
if {[catch {file mtime $file $mtime} result] } then {
saLog "Could not reset file time attribute for $file"
}
}
db::updateTimeTag $file
return 1
}
#----------------------------------------------------------------------------
# Validate the id3v2 tag length and make sure padding is accuratly
# accounted for.
#----------------------------------------------------------------------------
#----------------------------------------------------------------------------
# Check the V2 tag length and correct if needed/requested
#----------------------------------------------------------------------------
proc id3Tag::checkTagLength {file fix _data} {
# Have ID, get newdata
variable v2_2_IDs
variable v2_3_IDs
variable v2_4_IDs
variable id3v1Genres
upvar $_data newdata
array set fixer {0 r 1 r+}
if {[catch {open $file $fixer($fix)} fid]} {
saLog "$file: $fid"
return 0
}
fconfigure $fid -translation binary -encoding binary
if {[catch {read $fid 10} block] } then {
saLog "$file: $block"
return 0
}
##
# If this is an ID3 V2, need offset to start of stream
#
if {[string range $block 0 2] == "ID3"} {
# Determine the frame length and read the rest of the id3 header
binary scan [string range $block 3 5] "h1h1h1" majVer minVer flag
set length [syncSafeGet [string range $block 6 9]]
# Only support 2.3.0 writing
if {"$majVer.$minVer" ne "3.0"} {
close $fid
return 0
}
# 2.3 unique
switch -- $majVer {
2 {set useTypes $v2_2_IDs}
3 {set useTypes $v2_3_IDs}
4 {set useTypes $v2_4_IDs}
default {
saLog "Tag Version 2.$majVer.$minVer is not supported for $file"
if {$closeFid} {
close $fid
}
return 0
}
}
if {[catch {expr {($flag>>7)&0x1}} unsync]} then {
close $fid
saLog "$file\n$::errorInfo"
return 0
}
# 2.3 unique
set exthead [expr {($flag>>6)&0x1}]
if {$exthead} {
set exthead [read $fid 6]
set extlength [syncSafeGet $exthead]
#debug "Extended header of $extlength in $file"
read $fid $extlength
}
# specified length
## Need to walk the lengths to really verify if length is correct
if {$length <= 0} {
saLog "$file: Invalid length $length"
} else {
set block [read $fid $length]
if {$unsync} {
set unsynctag {\xFF\x00}
if {[regexp -all -indices $unsynctag $block hits]} {
#debug "unsyncs found at $hits"
}
}
unset -nocomplain newdata
unset -nocomplain oldData
# new method
foreach {newlen padding} [id3Tag::id3V2WalkBlock $block $majVer newdata] {break}
if {$newlen==0} {
puts "! $file: Zero Length"
} elseif {$newlen > $length} {
puts "> $file: Actual end ($newlen) after length ($length) delta [expr {$length-$newlen}], padding=$padding"
if {$fix} {
id3Tag::id3V2FixTagLength $fid $newlen
}
} elseif {($newlen < $length)} {
puts "< $file: Actual end ($newlen) before length ($length) delta [expr {$length-$newlen}], padding=$padding"
if {$fix} {
id3Tag::id3V2FixTagLength $fid $newlen
}
} else {
set block [read $fid 4096]
if {[string match "*Xing*" $block]} {
# puts "$file has Xing header"
}
}
}
}
close $fid
return 1
}
#------------------------------------------------------------------------------
# Diff two arrays and print the result
#------------------------------------------------------------------------------
proc id3Tag::arrayDiff {_a1 _a2} {
upvar $_a1 a1
upvar $_a2 a2
array set n1 [array get a1]
array set n2 [array get a2]
foreach {key data} [array get n1] {
if {[info exists n2($key)] && ($n1($key) eq $n2($key))} {
unset n1($key)
unset n2($key)
}
}
foreach {key data} [array get n2] {
if {[info exists n1($key)] && ($n1($key) eq $n2($key))} {
unset n1($key)
unset n2($key)
}
}
foreach {type block} [array get n1] {
set block [string map {\0 °} $block]
puts "n1->$type:$block"
}
foreach {type block} [array get n2] {
set block [string map {\0 °} $block]
puts "n2->$type:$block"
}
}
#----------------------------------------------------------------------------
# Walk a ID3 V2 block and veriy it is correct
# In the future, this is the "correct" way to read ID3 tags, and should be
# faster also.
# //Bertha/Music/Rock/Album Rock/Guess Who/The Guess Who - American Woman.mp3: Actual end (40) before length (1502) delta 1462, padding=7
#----------------------------------------------------------------------------
#------------------------------------------------------------------------------
# Frame length for a 2.2 tag
#------------------------------------------------------------------------------
# proc id3Tag::v2.2.Length {block loc _type _next} {
# upvar $_type type
# upvar $_next next
# set headlen 6
# binary scan [string range $block $loc [expr {$loc+$headlen}] ] "a3c1c1c1c1" type b c d enc
# set taglen [expr {(($b&0xFF)<<16 | ($c&0xFF)<<8 | ($d&0xFF))& 0xFFFFF}]
# set next [expr {$loc+$taglen+$headlen}]
# return $taglen
# }
# proc id3Tag::v2.3.Length {block loc _type _next} {
# upvar $_type type
# upvar $_next next
# set headlen 10
# binary scan [string range $block $loc [expr {$loc+$headlen}] ] "a4c1c1c1c1c1c1c1" type a b c d f1 f2 enc
# set taglen [expr {(($a&0xFF)<<24 | ($b&0xFF)<<16 | ($c&0xFF)<<8 | ($d&0xFF))& 0xFFFFF}]
# set next [expr {$loc+$taglen+$headlen}]
# return $taglen
# }
# proc id3Tag::v2.4.Length {block loc _type _next} {
# upvar $_type type
# upvar $_next next
# set headlen 10
# binary scan [string range $block $loc [expr {$loc+$headlen}] ] "a4c1c1c1c1c1c1c1" type a b c d f1 f2 enc
# set taglen [expr {(($a&0xFF)<<21 | ($b&0xFF)<<14 | ($c&0xFF)<<7 | ($d&0xFF))& 0xFFFFF}]
# set next [expr {$loc+$taglen+$headlen}]
# return $taglen
# }
#----------------------------------------------------------------------------
# Walk a id3V2 tag and gather the tags in it.
# TODO: Handle unicode like in {//Bertha/Music/Rock/College Rock/Toad the Wet Sprocket/1994 Dulcinea/04 - Stupid.mp3}
#----------------------------------------------------------------------------
proc id3Tag::id3V2WalkBlock {block majVer _data} {
upvar $_data data
set length [string length $block]
set loc 0
while {1} {
# set taglen [v2.$majVer.Length $block $loc type next]
switch -- $majVer {
2 {
set headlen 6
binary scan [string range $block $loc [expr {$loc+$headlen}] ] "a3c1c1c1c1" type b c d enc
set taglen [expr {(($b&0xFF)<<16 | ($c&0xFF)<<8 | ($d&0xFF))& 0xFFFFF}]
}
3 {
set headlen 10
binary scan [string range $block $loc [expr {$loc+$headlen}] ] "a4c1c1c1c1c1c1c1" type a b c d f1 f2 enc
set taglen [expr {(($a&0xFF)<<24 | ($b&0xFF)<<16 | ($c&0xFF)<<8 | ($d&0xFF))& 0xFFFFF}]
}
4 {
set headlen 10
binary scan [string range $block $loc [expr {$loc+$headlen}] ] "a4c1c1c1c1c1c1c1" type a b c d f1 f2 enc
set taglen [expr {(($a&0xFF)<<21 | ($b&0xFF)<<14 | ($c&0xFF)<<7 | ($d&0xFF))& 0xFFFFF}]
}
default {
saLog "Version $majVer tags not supported"
return [list 0 0]
}
}
set padlength 0
set next [expr {$loc+$taglen+$headlen}]
# If next tag location is a null, we are in padding
# Allow zero length tags (even though the spec doesn't)
#puts "$type:$length:$next:$taglen:'[string range $block $next [expr {$next+2}]]'"
#{$taglen < 0 ||$next >= $length|| ![string is ascii -strict [string range $block $next [expr {$next+2}]]]}
if {$taglen < 0 || $next > $length || ![string is ascii -strict $type]} {
# Don't really care about padding (for speed)
# if {[regexp -indices {\0+} [string range $block $next end] pair]} {
# foreach {start padlength} $pair {break}
# incr padlength
# set length [expr {$next+$padlength}]
# } else {
# set padlength 0
# }
#puts "Done:$type:$length:$next:$taglen"
return [list $length $padlength]
}
##
# Check for invalid condition
# || $enc < 0 || $enc > 1
if {$taglen > ($length-$loc)} {
# saLog "[string range $block $next [expr {$next+15}]] Invalid condition $taglen <= 0 || $taglen > ($length-$loc) || $enc < 0 || $enc > 1"
return [list 0 0]
}
##
# Either get retained or new tags
# include header in data
lappend data($type) [string range $block $loc [expr {$next-1}]]
##
# start of next search (front of next tag)
#
set loc $next
}
return [list 0 0]
}
#----------------------------------------------------------------------------
# Write the new header length (2.3.0 only)
#----------------------------------------------------------------------------
proc id3Tag::id3V2FixTagLength {fid tagLen} {
set d [expr {($tagLen) & 0x7F}]
set c [expr {($tagLen>>7) & 0x7F}]
set b [expr {($tagLen>>14) & 0x7F}]
set a [expr {($tagLen>>21) & 0x7F}] ;# Ver 2.3.0 with no flags
set TAG "ID3"
append TAG [binary format "h1h1h1c1c1c1c1" 3 0 0 $a $b $c $d]
seek $fid 0 start
puts -nonewline $fid $TAG
}
#------------------------------------------------------------------------------
# Function: id3Tag::isogg
#
# Return true if the file extension is for an ogg/vorbis file
#------------------------------------------------------------------------------
proc id3Tag::isogg {file} {
return [string equal -nocase [file extension $file] ".ogg"]
}
proc id3Tag::ismp3 {file} {
return [string equal -nocase [file extension $file] ".mp3"]
}
#------------------------------------------------------------------------------
# Retrieve ogg data for a file
#------------------------------------------------------------------------------
proc id3Tag::id3OGGGet {file _data} {
variable oggSound
variable id3v1Genres
upvar $_data data
$oggSound config -file $file
if {[catch {$oggSound config -comment} tagdata] } then {
return 0
} else {
foreach {entry} $tagdata {
foreach {tag value} [split $entry =] {
set value [id3Clean $value]
switch -- [string tolower $tag] {
"title" {set data(Title) $value}
"artist" {set data(Artist) $value}
"album" {set data(Album) $value}
"genre" {set data(Genre) $value}
"date" {set data(Year) $value}
"tracknumber" {set data(Track) $value}
"comment" {set data(Note) $value}
default {}
}
}
}
set data(Tag) OGG
}
$oggSound config -file ""
return 1
}
#------------------------------------------------------------------------------
# Function: id3Tag::id3OGGModify
#
# Update the Ogg tag with new data (if needed)
#------------------------------------------------------------------------------
proc id3Tag::id3OGGModify {file _Data} {
#Trace
variable oggSound
$oggSound config -file $file
set oldTag [lsort [$oggSound config -comment]]
upvar $_Data Data
set newTag [list]
foreach {idTag oggTag} {
Title TITLE
Artist ARTIST
Album ALBUM
Track TRACKNUMBER
Genre GENRE
Note COMMENT
Year DATE
} {
if {[info exists Data($idTag)]} {
lappend newTag "$oggTag=$Data($idTag)"
}
}
set newTag [lsort $newTag]
if {$oldTag ne $newTag} {
saLog "Changing\n$oldTag\nto\n$newTag"
$oggSound config -comment $newTag
}
$oggSound config -file ""
return 1
}
#------------------------------------------------------------------------------
# Function : id3Tag::findTagOffsets
# Description: Find offsets for tag types
# Used to remove a tag
# Author : Tom Wilkason
#------------------------------------------------------------------------------
proc id3Tag::findTagOffsets {file {types {V1 V2}}} {
if {[catch {open $file r} fid]} {
saLog "[me] Could not open file $file for reading"
return [list 0 0]
}
fconfigure $fid -translation binary -encoding binary
set endOffset 0
set startOffset 0
foreach {type} $types {
switch -- $type {
"V1" {
if {[catch {seek $fid -256 end} result] } {
close $fid
saLog $result
return [list 0 0]
}
set block [read $fid 256]
if {[string range $block 0 2]=="EXT"} {
set endOffset -256
} elseif {[string range $block 128 130]=="TAG"} {
set endOffset -128
} else {
set endOffset 0
}
}
"V2" {
seek $fid 0 start
set startOffset [id3Tag::id3V2Offset $fid]
}
default {}
}
}
close $fid
return [list $startOffset $endOffset]
}
#----------------------------------------------------------------------------
# Trim a file safely to some start/stop offset
#----------------------------------------------------------------------------
proc id3Tag::trimFile {file startOffset endOffset} {
##
# Snackamp Unique, stop track if playing and resume
#
if {[catch {open $file r} fid]} {
saLog "[me] Could not open file $file for reading"
return 0
}
fconfigure $fid -translation binary -encoding binary
set tfile [file join [file dirname $file] "[clock clicks].tmp"]
if {[catch {open $tfile w} ftd]} {
close $fid
saLog $ftd
return 0
}
# Have ID, get data
fconfigure $ftd -translation binary -encoding binary -buffersize 512000 -buffering full
# find proper portions to copy
seek $fid $endOffset end
set end [tell $fid]
seek $fid $startOffset start
set start [tell $fid]
set len [expr {$end-$start}]
# Handle errors, such as if disk is full
if {[catch {
fcopy $fid $ftd -size $len
} result] } then {
catch {close $ftd}
catch {close $fid}
file delete -force -- $tfile
saLog $result
return 0
} else {
close $ftd
close $fid
}
# If we have an error removing the old file, cleanup properly
if {[catch {file delete -force -- $file} result] } then {
saLog $result
file delete -force -- $tfile
return 0
} else {
catch {file rename -force -- $tfile $file}
}
return 1
}
#------------------------------------------------------------------------------
# Function : id3Tag::padTo
# Description: Pad/truncate a string to some length
# Author : Tom Wilkason
# Date : 3/17/2002
#------------------------------------------------------------------------------
proc id3Tag::padTo {string len} {
return [string range [format "%-${len}s" $string] 0 [incr len -1]]
}
#------------------------------------------------------------------------------
# Function : formatID3Data {List}
# Description: If a list of ID3 info is passed in, this will format it for
# use on a balloon pop-up. Non-blank entries are not returned.
# Author : Tom Wilkason
# Date : 11/11/2001
#------------------------------------------------------------------------------
proc id3Tag::formatID3Data {_Data} {
variable TagIDs
upvar $_Data Data
set Info {}
# for each tag, if it exists then append the info
foreach Tag $TagIDs {
if {[hasData Data($Tag)]} {
if {$Tag eq "Note"} {
append Info "$Tag \t: [wrap $Data($Tag) 72]\n"
} else {
append Info "$Tag \t: $Data($Tag)\n"
}
}
}
return $Info
}
#------------------------------------------------------------------------------
# Function : id3Clean
# Description: Remove garbage from an ID3 tag
# Author : Tom Wilkason
# Date : 2/11/2001
#------------------------------------------------------------------------------
proc id3Tag::id3Clean {String {trim 1}} {
regsub -all -- {\0|þ|ÿ|[[:cntrl:]]} $String {} String
if {$trim} {
# trimming causes problems with join 1.2 tags, need to retain the spaces
return [string trim $String]
} else {
return $String
}
}
#------------------------------------------------------------------------------
# Convert a possibly signed integer into an unsigned one (e.g. incoming byte)
#------------------------------------------------------------------------------
proc id3Tag::toUnsigned {val} {
return [cleanTrack [expr {($val + 0x100) % 0x100}]]
}
#------------------------------------------------------------------------------
# Function : id3Tag::cleanTrack
# Description: Format a track with at least two digits
# Author : Tom Wilkason
# Date : 10/12/2002
#------------------------------------------------------------------------------
proc id3Tag::cleanTrack {track} {
variable zeroPadTrack
variable zeroPadLookup
if {[string length $track]} {
set found [scan $track "%d/%d" track ntk]
set fmt $zeroPadLookup($zeroPadTrack)
# track number
if {[catch {format $fmt $track} Track] } then {
set tr $track
} else {
set tr $Track
}
# Check for n/m format
if {$found > 1 && ![catch {format $fmt $ntk} Track]} {
append tr "/$Track"
}
return $tr
} else {
return ""
}
}
#------------------------------------------------------------------------------
# Function : id3Tag::blankForNull
# Description: Return a blank or real data for some array element
#
# Author : Tom Wilkason
#------------------------------------------------------------------------------
proc id3Tag::blankForNull {_Data element} {
upvar $_Data Data
if {[info exists Data($element)]} {
return $Data($element)
} else {
return ""
}
}
#------------------------------------------------------------------------------
# Function : id3Tag::appendIfNotBlank
# Description:
# Author : Tom Wilkason
# Date : 11/11/2001
#------------------------------------------------------------------------------
proc id3Tag::appendIfNotBlank {_Array Title Data {units {}}} {
upvar $_Array Array
if {[string length $Data]>0} {
append Array "$Title $Data $units\n"
}
}
#------------------------------------------------------------------------------
# Function: id3Editor::guessArtist/guessTitle/guessAlbum
#
# Make an estimate of the artist/title & album names, used if no ID3 tag info exists
#------------------------------------------------------------------------------
proc id3Tag::guessArtist {file} {
variable ListDepth
return [lindex [lrange [file split [file rootname $file]] end-$ListDepth end] 0]
}
proc id3Tag::guessTitle {file} {
variable ListDepth
return [file rootname [file tail $file]]
}
proc id3Tag::guessAlbum {file} {
variable ListDepth
return [lindex [lrange [file split [file rootname $file]] end-$ListDepth end] end-1]
}
#----------------------------------------------------------------------------
# Read a string and return the decode data
#----------------------------------------------------------------------------
proc id3Tag::swapUnicode {data} {
#Trace
global tcl_platform
variable littleEndian
# puts "BOM=$bom:'[string map {\0 " "} $data]'"
if {[binary scan $data S bom] == 1} {
;#FEFF
if {$bom == -257} {
if {$littleEndian} {
set data [fromUnicode [wordswap [string range $data 2 end]]]
} else {
set data [fromUnicode [string range $data 2 end]]
}
;#FFFE
} elseif {$bom == -2} {
if {$littleEndian} {
set data [fromUnicode [string range $data 2 end]]
} else {
set data [fromUnicode [wordswap [string range $data 2 end]]]
}
# no byte order mark
} elseif {$littleEndian} {
set data [fromUnicode $data] ;# this works on windows, no swap
#set data [fromUnicode [wordswap $data]]
} else {
set data [fromUnicode $data]
}
}
return $data
}
#----------------------------------------------------------------------------
# byteswap unicode if needed
#----------------------------------------------------------------------------
proc id3Tag::wordswap {data} {
binary scan $data s* elements
return [binary format S* $elements]
}
package provide snID3 1.0