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