← Back to branch summary

~ubuntu-branches/ubuntu/feisty/gnupod-tools/feisty

« back to all changes in this revision

Viewing changes to src/ext/QTfile.pm

  • Committer: Bazaar Package Importer
  • Author(s): Brian Nelson
  • Date: 2005-04-05 09:10:01 UTC
  • mto: (2.1.1 sarge)
  • mto: This revision was merged to the branch mainline in revision 3.
  • Revision ID: james.westby@ubuntu.com-20050405091001-vjtr9oktjemr6mn6
Tags: upstream-0.98
Import upstream version 0.98

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/ext/QTfile.pm
1
1
package GNUpod::QTfile;
2
2
 
3
 
#  Copyright (C) 2003 Adrian Ulrich <pab at blinkenlights.ch>
 
3
#  Copyright (C) 2003-2004 Adrian Ulrich <pab at blinkenlights.ch>
4
4
#  Part of the gnupod-tools collection
5
5
#
6
6
#  URL: http://www.gnu.org/software/gnupod/
25
25
 
26
26
# A poor QT Parser, can (sometimes ;) ) read m4a files written
27
27
# by iTunes
 
28
#
 
29
# Note: I didn't read/have any specs...
 
30
# It's written using 'try and error'
 
31
#
28
32
 
29
33
use strict;
30
34
use GNUpod::FooBar;
31
 
use vars qw(%hchild %reth);
 
35
use vars qw(%hchild %reth @LEVELA);
 
36
 
 
37
use constant SOUND_ITEM => 'soun';
32
38
 
33
39
#Some static def
34
40
$hchild{'moov'} = 8;
42
48
$hchild{'meta'} = 12;
43
49
$hchild{'ilst'} = 8;
44
50
$hchild{'----'} = 8;
45
 
$hchild{'�alb'} = 8;
46
51
$hchild{'day'} = 8;
47
52
$hchild{'cmt'} = 8;
48
53
$hchild{'disk'} = 8;
49
 
$hchild{'�ART'} = 8;
50
54
$hchild{'wrt'} = 8;
 
55
$hchild{'dinf'} = 8;
 
56
$hchild{'�grp'} = 8;
 
57
$hchild{'�too'} = 8;
51
58
$hchild{'�nam'} = 8;
52
 
$hchild{'�too'} = 8;
53
 
$hchild{'dinf'} = 8;
54
 
 
 
59
$hchild{'�ART'} = 8;
 
60
$hchild{'�alb'} = 8;
 
61
$hchild{'�gen'} = 8;
 
62
$hchild{'�cmt'} = 8;
 
63
$hchild{'�wrt'} = 8;
 
64
$hchild{'�day'} = 8;
 
65
$hchild{'trkn'} = 8;
 
66
$hchild{'tmpo'} = 8;
 
67
$hchild{'disk'} = 8;
 
68
 
 
69
 
 
70
##Call this to parse a file
55
71
sub parsefile {
56
 
 my($qtfile) = @_;
57
 
 open(QTFILE, $qtfile) or return undef;
58
 
 
59
 
 my $fsize = -s "$qtfile";
60
 
 my $pos = 0;
61
 
 my $level = 1;
62
 
 my %lx = ();
63
 
 
64
 
 if($fsize < 16 || rseek(4,4) ne "ftyp") {
65
 
  return undef;
66
 
 }
67
 
 
68
 
 while($pos<$fsize) {
69
 
  my($clevel, $len) = get_atom($level, $pos, \%lx);
70
 
  unless($len) {
71
 
   warn "** Unexpected data found at $pos!\n";
72
 
   warn "** You found a bug! Please send a bugreport\n";
73
 
   warn "** to pab\@blinkenlights.ch\n";
74
 
   warn "** GIVING UP PARSING\n";
75
 
   last;
 
72
        my($qtfile) = @_;
 
73
 
 
74
 
 
75
        open(QTFILE, $qtfile) or return undef;
 
76
 
 
77
        my $fsize = -s "$qtfile" or return undef; #Hey.. VFS borken?
 
78
        my $pos = 0;
 
79
        my $level = 1;
 
80
        my %lx = ();
 
81
           %reth = (); #Cleanup
 
82
 
 
83
        if($fsize < 16 || rseek(4,4) ne "ftyp") { #Can't be a QTfile
 
84
                close(QTFILE);
 
85
                return undef;
 
86
        }
 
87
 
 
88
 
 
89
        #Ok, header looks okay.. seek each atom and buildup $lx{metadat}
 
90
        while($pos<$fsize) {
 
91
                my($clevel, $len) = get_atom($level, $pos, \%lx);
 
92
                unless($len) {
 
93
                        warn "QTfile.pm: ** Unexpected data found at $pos!\n";
 
94
                        warn "QTfile.pm: ** You found a bug! Please send a bugreport\n";
 
95
                        warn "QTfile.pm: ** to pab\@blinkenlights.ch\n";
 
96
                        warn "QTfile.pm: ** GIVING UP PARSING **\n";
 
97
                        last;
 
98
                }
 
99
        $pos+=$len;
 
100
        $level = $clevel;
 
101
        }
 
102
        close(QTFILE);
 
103
 
 
104
 
 
105
########### Now we build the chain #######################################
 
106
 
 
107
#Search the Sound-Stream
 
108
my $sound_index = get_sound_index($lx{metadat}{'::moov::trak::mdia::hdlr'});
 
109
 
 
110
if($sound_index < 0) {
 
111
 warn "QTfile.pm: No 'sound' data found in file!\n";
 
112
 return undef;
 
113
}
 
114
 
 
115
#print "::moov::trak::mdia::hdlr  -> $sound_index\n";
 
116
 
 
117
my @METADEF = ("album",   "\xA9alb",
 
118
               "comment", "\xA9cmt",
 
119
               "genre",   "\xA9gen",
 
120
               "group",   "\xA9grp",
 
121
               "composer","\xA9wrt",
 
122
               "artist",  "\xA9ART",
 
123
               "title",   "\xA9nam",
 
124
               "fdesc",   "\xA9too",
 
125
               "year",    "\xA9day",
 
126
               "comment", "\xA9cmt");
 
127
 
 
128
###All STRING fields..
 
129
 for(my $i = 0;$i<int(@METADEF);$i+=2) {
 
130
  my $cKey = "::moov::udta::meta::ilst::".$METADEF[$i+1]."::data";
 
131
  if($lx{metadat}{$cKey}[$sound_index]) {
 
132
   $reth{$METADEF[$i]} = $lx{metadat}{$cKey}[$sound_index];
76
133
  }
77
 
  $pos+=$len;
78
 
  $level = $clevel;
 
134
 }
 
135
 
 
136
###INT and such fields are here:
 
137
 
 
138
 if( my $cDat = $lx{metadat}{'::moov::udta::meta::ilst::tmpo::data'}[$sound_index] ) {
 
139
  $reth{bpm} = GNUpod::FooBar::shx2_x86_int($cDat);
 
140
 }
 
141
 
 
142
 if( my $cDat = $lx{metadat}{'::moov::udta::meta::ilst::trkn::data'}[$sound_index]) {
 
143
   $reth{tracknum} = GNUpod::FooBar::shx2_x86_int(substr($cDat,2,2));
 
144
   $reth{tracks}   = GNUpod::FooBar::shx2_x86_int(substr($cDat,4,2));  
 
145
 }
 
146
 
 
147
 if( my $cDat = $lx{metadat}{'::moov::udta::meta::ilst::disk::data'}[$sound_index]) {
 
148
   $reth{cdnum} = GNUpod::FooBar::shx2_x86_int(substr($cDat,2,2));
 
149
   $reth{cds}   = GNUpod::FooBar::shx2_x86_int(substr($cDat,4,2));  
 
150
 }
 
151
 
 
152
 
 
153
 if( my $cDat = $lx{metadat}{'::moov::mvhd'}[$sound_index] ) {
 
154
 #Calculate the time... 
 
155
 $reth{time} = int( get_string_oct(8,4,$cDat)/
 
156
                    get_string_oct(4,4,$cDat)*1000 );
 
157
 }
 
158
 
 
159
 
 
160
 if($lx{metadat}{'::moov::udta::meta::ilst::----::mean'}[$sound_index] eq "apple.iTunes" &&
 
161
    $lx{metadat}{'::moov::udta::meta::ilst::----::name'}[$sound_index] eq "NORM") {
 
162
       $reth{iTunNORM} = $lx{metadat}{'::moov::udta::meta::ilst::----::data'}[$sound_index];
 
163
 }
 
164
 
 
165
 if( my $cDat = $lx{metadat}{'::moov::trak::mdia::minf::stbl::stsd'}[$sound_index] ) {
 
166
  $reth{_CODEC} = substr($cDat,4,4);
 
167
  $reth{srate}  = get_string_oct(32,2,$cDat);
 
168
  $reth{channels}  = get_string_oct(24,2,$cDat);
 
169
  $reth{bit_depth}  = get_string_oct(26,2,$cDat);
79
170
 }
80
171
 $reth{filesize} = $fsize;
 
172
 
 
173
 #Fixme: This is ugly.. bitrate is somewhere found in esds / stsd
 
174
 $reth{bitrate} = int( ($reth{filesize}*8/1024)/(1+$reth{time})*1000 );
 
175
 
 
176
=head
 
177
print "* ************ FINISHED PARSER ***********************\n";
 
178
foreach(keys(%{$lx{metadat}})) {
 
179
 print "-> $_\n";
 
180
}
 
181
use GNUpod::iTunesDB;
 
182
while(<STDIN>) {
 
183
 chomp;
 
184
 my $x = 0;
 
185
 foreach(@{$lx{metadat}{$_}}) {
 
186
 
 
187
 print "==============> $x <==================\n";
 
188
 GNUpod::iTunesDB::__hd($_);
 
189
  $x++;
 
190
  
 
191
 }
 
192
}
 
193
=cut
 
194
 
 
195
 
81
196
 return \%reth;
82
197
}
83
198
 
84
199
############################################################
85
200
# Get a single ATOM
86
201
sub get_atom {
87
 
 my($level, $pos, $lt) = @_;
88
 
 
89
 
 my $len = getoct($pos,4);
90
 
 #Error
91
 
 return(undef, undef) if $len < 16;
92
 
 my $typ = rseek($pos+4,4);
 
202
        my($level, $pos, $lt) = @_;
 
203
        my $len = getoct($pos,4); #Length of field
 
204
        #Error
 
205
        return(undef, undef) if $len < 8;
93
206
 
94
 
 $level = $lt->{ltrack}->{$pos} if $lt->{ltrack}->{$pos};
95
 
 $lt->{topic}->{$level} = $typ;
96
 
 
97
 
#print "_" x $level;
98
 
#print int($level)."] \@$pos L $len -> $typ \n";
99
 
#print " parent : ".$lt->{"topic_".($level-1)}."\n";
100
 
 
101
 
 if($typ eq "data") {
102
 
  my $parent =$lt->{topic}->{$level-1};
103
 
  my $dat = rseek($pos+16,$len-16);
104
 
  if($parent eq "�alb") {
105
 
   $reth{album} = $dat;
106
 
  }
107
 
  elsif($parent eq "�ART") {
108
 
   $reth{artist} = $dat;
109
 
  }
110
 
  elsif($parent eq "�nam") {
111
 
   $reth{title} = $dat;
112
 
  }
113
 
  elsif($parent eq "�too") {
114
 
   $reth{fdesc} = $dat;
115
 
  }
116
 
  else {
117
 
   warn "Skipping $typ -> $parent\n";
118
 
  }
119
 
 }
120
 
 elsif($typ eq "mvhd") {
121
 
  $reth{time} = int(getoct($pos+24,4)/getoct($pos+20,4)*1000);
122
 
 }
123
 
 
124
 
  if(defined($hchild{$typ})) { #This type has a child
125
 
   #Track the old level
126
 
   $lt->{ltrack}->{$pos+$len} = $level unless $lt->{ltrack}->{$pos+$len};
127
 
   #Go to the next
128
 
   $level++;
129
 
   #Fix len
130
 
   $len = $hchild{$typ};
131
 
  }
132
 
 return($level,$len);
133
 
}
134
 
 
135
 
 
136
 
 
 
207
        #Now get the type
 
208
        my $typ = rseek($pos+4,4);
 
209
        #..and keep track of it..
 
210
        $level = $lt->{ltrack}->{$pos} if $lt->{ltrack}->{$pos};
 
211
        
 
212
        #Build a chain for this level.. looks like '::foo::bar::bla'
 
213
        $LEVELA[$level] = $typ;
 
214
        my $cChain = undef;
 
215
        for(1..$level) {
 
216
                $cChain .= "::".$LEVELA[$_];
 
217
        }
 
218
 
 
219
        if(defined($hchild{$typ})) { #This type has a child
 
220
                #Track the old level
 
221
                $lt->{ltrack}->{$pos+$len} = $level unless $lt->{ltrack}->{$pos+$len};
 
222
                #Go to the next
 
223
                $level++;
 
224
                #Fix len
 
225
                $len = $hchild{$typ};
 
226
        }
 
227
        elsif($len >= 16 && $cChain !~ /(::mdat|::free)$/) {  #No child -> final element -> data!
 
228
                push(@{$lt->{metadat}->{$cChain}},rseek($pos+16,$len-16));
 
229
        }
 
230
 
 
231
        return($level,$len);
 
232
}
 
233
 
 
234
############################################
 
235
# Search the 'soun' item
 
236
sub get_sound_index {
 
237
        my($ref) = @_;
 
238
        my $sid = 0;
 
239
        my $sound_index = -1;
 
240
        foreach(@$ref) {
 
241
                if( substr($_,0,4) eq SOUND_ITEM ) {
 
242
                        $sound_index = $sid;
 
243
                        last;
 
244
                }
 
245
                $sid++;
 
246
        }
 
247
        return $sound_index;
 
248
}
137
249
 
138
250
###################################################
139
251
# Get INT vaules
140
252
sub getoct {
141
 
my($offset, $len) = @_;
142
 
  GNUpod::FooBar::shx2_x86_int(rseek($offset,$len));
 
253
        my($offset, $len) = @_;
 
254
        GNUpod::FooBar::shx2_x86_int(rseek($offset,$len));
 
255
}
 
256
 
 
257
 
 
258
###################################################
 
259
# Get INT vaules from string
 
260
sub get_string_oct {
 
261
        my($offset, $len, $string) = @_;
 
262
 
 
263
        if($offset+$len > length($string)) {
 
264
                warn "Bug: invalid substr() call! Returning 0\n";
 
265
                return 0;
 
266
        }
 
267
 
 
268
        GNUpod::FooBar::shx2_x86_int(substr($string,$offset,$len));
143
269
}
144
270
 
145
271
####################################################
146
272
# Raw seeking
147
273
sub rseek {
148
 
 my($offset, $len) = @_;
149
 
 return undef if $len < 0;
150
 
 my $buff;
151
 
 seek(QTFILE, $offset, 0);
152
 
 read(QTFILE, $buff, $len);
153
 
 return $buff;
 
274
        my($offset, $len) = @_;
 
275
        return undef if $len < 0;
 
276
        my $buff;
 
277
        seek(QTFILE, $offset, 0);
 
278
        read(QTFILE, $buff, $len);
 
279
        return $buff;
154
280
}
155
281
 
156
282
1;