1package GNUpod::QTfile; 2 3# Copyright (C) 2003-2007 Adrian Ulrich <pab at blinkenlights.ch> 4# Part of the gnupod-tools collection 5# 6# URL: http://www.gnu.org/software/gnupod/ 7# 8# GNUpod is free software; you can redistribute it and/or modify 9# it under the terms of the GNU General Public License as published by 10# the Free Software Foundation; either version 3 of the License, or 11# (at your option) any later version. 12# 13# GNUpod is distributed in the hope that it will be useful, 14# but WITHOUT ANY WARRANTY; without even the implied warranty of 15# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16# GNU General Public License for more details. 17# 18# You should have received a copy of the GNU General Public License 19# along with this program. If not, see <http://www.gnu.org/licenses/>.# 20# 21# iTunes and iPod are trademarks of Apple 22# 23# This product is not supported/written/published by Apple! 24 25# A poor QT Parser, can (sometimes ;) ) read m4a files written 26# by iTunes 27# 28# Note: I didn't read/have any specs... 29# It's written using 'try and error' 30# 31 32use strict; 33use GNUpod::FooBar; 34use vars qw(%hchild %reth @LEVELA); 35 36#Define handler items 37use constant SOUND_ITEM => 'soun'; 38use constant VIDEO_ITEM => 'vide'; 39 40 41#Mediatypes for the iPod 42use constant MEDIATYPE_VIDEO => 0x02; 43use constant MEDIATYPE_AUDIO => 0x01; 44 45#Do not kill the host by allocating toomuch memory 46use constant MAX_RSEEK_DATA => 1024*1024; 47 48#Some static def 49$hchild{'moov'} = 8; 50$hchild{'trak'} = 8; 51$hchild{'edts'} = 8; 52$hchild{'mdia'} = 8; 53$hchild{'minf'} = 8; 54$hchild{'dinf'} = 8; 55$hchild{'stbl'} = 8; 56$hchild{'udta'} = 8; 57$hchild{'meta'} = 12; 58$hchild{'ilst'} = 8; 59$hchild{'----'} = 8; 60$hchild{'day'} = 8; 61$hchild{'cmt'} = 8; 62$hchild{'disk'} = 8; 63$hchild{'wrt'} = 8; 64$hchild{'dinf'} = 8; 65$hchild{'�grp'} = 8; 66$hchild{'�too'} = 8; 67$hchild{'�nam'} = 8; 68$hchild{'�ART'} = 8; 69$hchild{'�alb'} = 8; 70$hchild{'�gen'} = 8; 71$hchild{'�cmt'} = 8; 72$hchild{'�wrt'} = 8; 73$hchild{'�day'} = 8; 74$hchild{'trkn'} = 8; 75$hchild{'tmpo'} = 8; 76$hchild{'disk'} = 8; 77 78 79##Call this to parse a file 80sub parsefile { 81 my($qtfile) = @_; 82 83 84 open(QTFILE, $qtfile) or return undef; 85 binmode(QTFILE); 86 87 my $fsize = -s "$qtfile" or return undef; #Dunno parse emtpy files 88 my $pos = 0; 89 my $level = 1; 90 my %lx = (); 91 %reth = (); #Cleanup 92 if($fsize < 16 || rseek(4,4) ne "ftyp") { #Can't be a QTfile 93 close(QTFILE); 94 return undef; 95 } 96 97 98 #Ok, header looks okay.. seek each atom and buildup $lx{metadat} 99 while($pos<$fsize) { 100 my($clevel, $len) = get_atom($level, $pos, \%lx); 101 unless($len) { 102 warn "QTfile.pm: ** Unexpected data found at $pos!\n"; 103 warn "QTfile.pm: ** => File broken?\n"; 104 warn "QTfile.pm: ** => ..or maybe you found a bug: send a\n"; 105 warn "QTfile.pm: ** bugreport to <pab\@blinkenlights.ch>\n"; 106 warn "QTfile.pm: ** GIVING UP PARSING **\n"; 107 last; 108 } 109 $pos+=$len; 110 $level = $clevel; 111 } 112 close(QTFILE); 113 114 115########### Now we build the chain ####################################### 116 117my $video_index = get_media_index($lx{metadat}{'::moov::trak::mdia::hdlr'}, VIDEO_ITEM); 118my $sound_index = get_media_index($lx{metadat}{'::moov::trak::mdia::hdlr'}, SOUND_ITEM); 119 120 121if($video_index >= 0 && $sound_index >= 0) { 122 #This looks like a video 123 $reth{mediatype} = MEDIATYPE_VIDEO; 124} 125elsif($sound_index >= 0) { 126 #..only sound 127 $reth{mediatype} = MEDIATYPE_AUDIO; 128} 129else { 130 warn "QTfile.pm: No sound/video stream found in file!\n"; 131 return undef; 132} 133 134 135 136 137my @METADEF = ("album", "\xA9alb", 138 "comment", "\xA9cmt", 139 "genre", "\xA9gen", 140 "group", "\xA9grp", 141 "composer","\xA9wrt", 142 "artist", "\xA9ART", 143 "title", "\xA9nam", 144 "fdesc", "\xA9too", 145 "year", "\xA9day", 146 "comment", "\xA9cmt"); 147 148###All STRING fields.. 149 for(my $i = 0;$i<int(@METADEF);$i+=2) { 150 my $cKey = "::moov::udta::meta::ilst::".$METADEF[$i+1]."::data"; 151 if($lx{metadat}{$cKey}[$sound_index]) { 152 $reth{$METADEF[$i]} = $lx{metadat}{$cKey}[$sound_index]; 153 } 154 } 155 156 157###INT and such fields are here: 158 159 if( my $cDat = $lx{metadat}{'::moov::udta::meta::ilst::tmpo::data'}[$sound_index] ) { 160 $reth{bpm} = GNUpod::FooBar::shx2_x86_int($cDat); 161 } 162 163 if( my $cDat = $lx{metadat}{'::moov::udta::meta::ilst::trkn::data'}[$sound_index]) { 164 $reth{tracknum} = GNUpod::FooBar::shx2_x86_int(substr($cDat,2,2)); 165 $reth{tracks} = GNUpod::FooBar::shx2_x86_int(substr($cDat,4,2)); 166 } 167 168 if( my $cDat = $lx{metadat}{'::moov::udta::meta::ilst::disk::data'}[$sound_index]) { 169 $reth{cdnum} = GNUpod::FooBar::shx2_x86_int(substr($cDat,2,2)); 170 $reth{cds} = GNUpod::FooBar::shx2_x86_int(substr($cDat,4,2)); 171 } 172 173 174#Search for a TIME index: first sound, then video 175 foreach my $cidentify ( ($sound_index, $video_index) ) { 176 next if $cidentify < 0; #Invalid identifyer 177 if( my $cDat = ( $lx{metadat}{'::moov::mvhd'}[$cidentify] or $lx{metadat}{'::moov::trak::mdia::mdhd'}[$cidentify]) ) { 178 #Calculate the time... 179 $reth{time} = int( get_string_oct(8,4,$cDat)/ 180 get_string_oct(4,4,$cDat)*1000 ); 181 last if $reth{time}; 182 } 183 } 184 185 186 if($lx{metadat}{'::moov::udta::meta::ilst::----::mean'}[$sound_index] eq "apple.iTunes" && 187 $lx{metadat}{'::moov::udta::meta::ilst::----::name'}[$sound_index] eq "NORM") { 188 $reth{iTunNORM} = $lx{metadat}{'::moov::udta::meta::ilst::----::data'}[$sound_index]; 189 } 190 191 if( my $cDat = $lx{metadat}{'::moov::trak::mdia::minf::stbl::stsd'}[$sound_index] ) { 192 $reth{_CODEC} = substr($cDat,4,4); 193 $reth{srate} = get_string_oct(32,2,$cDat); 194 $reth{channels} = get_string_oct(24,2,$cDat); 195 $reth{bit_depth} = get_string_oct(26,2,$cDat); 196 } 197 198 if(!$reth{genre}) { 199 my $numeric_genre = GNUpod::FooBar::shx2_x86_int($lx{metadat}{'::moov::udta::meta::ilst::gnre'}[$sound_index]); 200 $reth{genre} = "(".($numeric_genre-1).")" if $numeric_genre > 0; # Blues = 1 ; but blues == 0 on id3tags 201 } 202 203 $reth{filesize} = $fsize; 204 205 #Fixme: This is ugly.. bitrate is somewhere found in esds / stsd 206 $reth{bitrate} = int( ($reth{filesize}*8/1024)/(1+$reth{time})*1000 ); 207 208 return \%reth; 209} 210 211############################################################ 212# Get a single ATOM 213sub get_atom { 214 my($level, $pos, $lt) = @_; 215 my $len = getoct($pos,4); #Length of field 216 #Error 217 return(undef, undef) if $len < 8; 218 219 #Now get the type 220 my $typ = rseek($pos+4,4); 221 #..and keep track of it.. 222 $level = $lt->{ltrack}->{$pos} if $lt->{ltrack}->{$pos}; 223 224 225 #Build a chain for this level.. looks like '::foo::bar::bla' 226 $LEVELA[$level] = $typ; 227 my $cChain = undef; 228 for(1..$level) { 229 $cChain .= "::".$LEVELA[$_]; 230 } 231 232 if(defined($hchild{$typ})) { #This type has a child 233 #Track the old level 234 $lt->{ltrack}->{$pos+$len} = $level unless $lt->{ltrack}->{$pos+$len}; 235 #Go to the next 236 $level++; 237 #Fix len 238 $len = $hchild{$typ}; 239 } 240 elsif($len >= 16 && $cChain !~ /(::mdat|::free)$/) { #No child -> final element -> data! 241 push(@{$lt->{metadat}->{$cChain}},rseek($pos+16,$len-16)); 242 } 243 244 return($level,$len); 245} 246 247############################################ 248# Search the 'soun' item 249sub get_media_index { 250 my($ref,$rq) = @_; 251 die "get_media_index($ref,$rq): Assert length(\$rq)==4 failed\n" unless length($rq) == 4; 252 my $sid = 0; 253 my $sound_index = -1; 254 foreach(@$ref) { 255 if( substr($_,0,4) eq $rq) { 256 $sound_index = $sid; 257 last; 258 } 259 $sid++; 260 } 261 return $sound_index; 262} 263 264################################################### 265# Get INT vaules 266sub getoct { 267 my($offset, $len) = @_; 268 GNUpod::FooBar::shx2_x86_int(rseek($offset,$len)); 269} 270 271 272################################################### 273# Get INT vaules from string 274sub get_string_oct { 275 my($offset, $len, $string) = @_; 276 277 if($offset+$len > length($string)) { 278 warn "QTfile.pm: Bug: invalid substr() call! Returning 0\n"; 279 return 0; 280 } 281 282 GNUpod::FooBar::shx2_x86_int(substr($string,$offset,$len)); 283} 284 285#################################################### 286# Raw seeking 287sub rseek { 288 my($offset, $len) = @_; 289 return undef if $len < 0; 290 291 if($len < 0) { 292 warn "QTFile.pm: rseek($offset,$len) : POSSIBLE BUG OR BROKEN FILE: Calling rseek with \$len == 0 isn't such a good idea?!\n"; 293 } 294 elsif($len > MAX_RSEEK_DATA) { 295 warn "QTFile.pm: rseek($offset,$len) : POSSIBLE BUG OR BROKEN FILE: Ouch! rseek refuses to return $len bytes; Request cropped to ".MAX_RSEEK_DATA."\n"; 296 $len = MAX_RSEEK_DATA; 297 } 298 299 my $buff; 300 seek(QTFILE, $offset, 0); 301 read(QTFILE, $buff, $len); 302 return $buff; 303} 304 3051; 306