File Coverage

blib/lib/Mac/iPod/DB.pm
Criterion Covered Total %
statement 21 167 12.5
branch 0 40 0.0
condition 0 6 0.0
subroutine 7 20 35.0
pod 0 5 0.0
total 28 238 11.7


line stmt bran cond sub pod time code
1             # $Id: DB.pm,v 1.1.1.1 2003/07/30 01:55:25 sps Exp $
2             # Copyright (C) 2003 Sean P. Scanlon
3             #
4             # contains large chunks of code written and copyrighted by: Adrian Ulrich
5             # Copyright (C) 2002-2003 Adrian Ulrich
6             #
7             #
8             # large portions of this module have been taken from "tunes2pod.pl"
9             # Part of the gnupod-tools collection
10             # URL: http://www.gnu.org/software/gnupod/
11             #
12             # This program is free software; you can redistribute it and/or modify
13             # it under the terms of the GNU General Public License as published by
14             # the Free Software Foundation; either version 2 of the License, or
15             # (at your option) any later version.
16             #
17             # This program is distributed in the hope that it will be useful,
18             # but WITHOUT ANY WARRANTY; without even the implied warranty of
19             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20             # GNU General Public License for more details.
21             #
22             # You should have received a copy of the GNU General Public License
23             # along with this program; if not, write to the Free Software
24             # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
25             #
26             # iTunes and iPod are trademarks of Apple
27             #
28             # This product is not supported/written/published by Apple!
29              
30             package Mac::iPod::DB;
31              
32             require 5.005_03;
33 1     1   519 use strict;
  1         1  
  1         50  
34              
35              
36              
37             our $VERSION = '0.01';
38              
39             # header of a valid iTunesDB
40 1     1   5 use constant IPODMAGIC => '6d 68 62 64 68 00 00 00';
  1         2  
  1         82  
41              
42             #the HARDCODED start of the first mhit #FIXME .. shouldn't be hardcooded...
43 1     1   5 use constant FIRST_MHIT => 292;
  1         3  
  1         1788  
44              
45             my @MHOD_ID = (
46             0,
47             'title',
48             'path',
49             'album',
50             'artist',
51             'genre',
52             'fdesc',
53             'comment',
54             'composer'
55             );
56              
57              
58             sub playlists {
59              
60 0     0 0   my $self = shift();
61              
62 0           return values %{ $self->{_playlists} };
  0            
63              
64             }
65              
66             sub songIds {
67              
68 0     0 0   my $self = shift();
69              
70 0           return sort keys %{ $self->{_songs} };
  0            
71              
72             }
73              
74             sub songs {
75              
76 0     0 0   my $self = shift();
77              
78 0           return values %{ $self->{_songs} };
  0            
79              
80             }
81              
82             sub song {
83              
84 0     0 0   my $self = shift();
85              
86 0           my $id = shift();
87              
88 0 0         if (defined $self->{_songs}->{$id}) {
89              
90 0           return $self->{_songs}->{$id};
91              
92             }
93              
94 0           return undef;
95              
96             }
97              
98             sub new {
99              
100 0     0 0   my $class = shift();
101              
102 0           my $file = shift();
103              
104 0 0         return undef if ! $file;
105              
106 0           my $self = {};
107              
108 0   0       bless $self, ref $class || $class;
109              
110 0 0         open($self->{_dbfh}, $file) || die $!;
111              
112 0 0         if($self->_bin2hex(0, (length(IPODMAGIC)+2)/3) ne IPODMAGIC) {
113              
114 0           printf "found header: %s\n", $self->_bin2hex(0, (length(IPODMAGIC)+2)/3);
115              
116 0           die "** ERROR ** : Could open your iTunesDB, but: Wrong Header found..\n";
117              
118             }
119              
120              
121 0           my $pos = FIRST_MHIT;
122              
123             # get every
124              
125 0           while($pos != -1) {
126              
127             #get_nod_a returns wher it's guessing the next MHIT, if it fails, it returns '-1'
128              
129 0           $pos = $self->_get_nod_a($pos);
130              
131             }
132              
133             ## search PL start
134 0           $pos = $self->_getshoe(112, 4) + 292;
135              
136 0           my ($mpl, $cont, $plname);
137              
138             #get every playlist (no items)
139              
140 0           while($pos != -1) {
141              
142             #get_nod_a returns where it's guessing the next MHIT, if it fails, it returns '-1'
143              
144 0           ($pos, $mpl, $cont, $plname) = $self->_get_pl($pos);
145              
146 0           my $p = Mac::iPod::DB::Playlist::new();
147              
148 0           $p->name($plname);
149              
150 0           $p->_songs($cont);
151              
152 0 0         $self->{_playlists}->{$plname} = $p if $plname;
153              
154             }
155              
156 0           close($self->{_dbfh});
157              
158 0           return $self;
159              
160             }
161              
162              
163              
164              
165             sub _get_pl {
166              
167 0     0     my($self, $offset) = @_;
168              
169 0           my($is_mpl, $oid, $mht, $plname, $px, $ret) = undef;
170              
171 0 0         if($self->_getstr($offset,4) eq "mhyp") {
172              
173 0           $is_mpl = $self->_getshoe($offset + 20, 4);
174              
175 0           $offset += $self->_getshoe($offset + 4, 4);
176              
177             #Get the name of the playlist...
178             #You would think that a playlist only has one name.. forget it!
179             #Ehpod does funny things here and writes the playlist name two times.. *plenk*
180             #MusicMatch does also funny things here (Like writing *no* plname for the MPL)
181              
182 0           while($oid != -1) {
183              
184 0           $offset+=$oid;
185              
186 0           ($oid, $mht, $px) = $self->_get_mhod($offset);
187              
188 0 0         $plname = $px if $mht == 1;
189              
190             }
191              
192             #Now get the PL items..
193 0           $oid = undef;
194              
195 0           while($oid != -1) {
196              
197 0           $offset+=$oid;
198              
199 0           ($oid, $px) = $self->_get_mhip($offset);
200              
201 0 0         push @{ $ret }, $px if $px;
  0            
202              
203             }
204              
205 0           return ($offset, $is_mpl, $ret, $plname);
206              
207             }
208              
209 0           return -1;
210              
211             }
212              
213              
214             sub _get_mhip {
215              
216 0     0     my($self, $sum) = @_;
217              
218 0 0         if($self->_bin2hex($sum, 4) eq "6d 68 69 70") {
219              
220 0           my $oof = $self->_getshoe($sum+4, 4);
221              
222 0           my($oid, $mht, $txt) = $self->_get_mhod($sum+$oof);
223              
224 0 0         return -1 if $oid == -1; #fatal error..
225              
226 0           my $px = $self->_getshoe($sum+$oof-52, 4);
227              
228 0           return ($oid+$oof, $px);
229              
230             }
231              
232             #we are lost
233 0           return -1;
234             }
235              
236             #get a mhod entry
237             #
238             # get_nod_a(START) - Get mhits..
239              
240             sub _get_nod_a {
241              
242 0     0     my(@jerk, $zip, $state, $sa, $sl, $sb, $sid, $cdnum, $cdanz, $songnum, $songanz, $year);
243              
244 0           my($sbr, $oid, $otxt);
245              
246 0           my ($self, $sum) = @_;
247              
248 0 0         if($self->_bin2hex($sum, 4) eq "6d 68 69 74") { #aren't we lost?
249              
250 0           $sid = $self->_getshoe($sum + 16, 4);
251 0           $sa = $self->_getshoe($sum + 36, 4);
252 0           $sl = $self->_getshoe($sum + 40, 4);
253 0           $cdnum = $self->_getshoe($sum + 92, 4); #cd nr
254 0           $cdanz = $self->_getshoe($sum + 96, 4); #cd nr of..
255 0           $songnum = $self->_getshoe($sum + 44, 4); #song number
256 0           $songanz = $self->_getshoe($sum + 48, 4); #song num of..
257 0           $year = $self->_getshoe($sum + 52, 4); #year
258              
259 0           $sbr = $self->_getshoe($sum + 56, 4);
260              
261 0           $sum += 156; #1st mhod starts here!
262              
263 0           while($zip != -1) {
264              
265 0           $sum = $zip + $sum;
266              
267             #returns the number where its guessing the next mhod, -1 if it's failed
268              
269 0           ($zip, $oid, $otxt) = $self->_get_mhod($sum);
270              
271 0           $jerk[$oid] = $otxt;
272              
273             }
274              
275 0           my $s = Mac::iPod::DB::Song::new();
276              
277 0           $s->id($sid);
278              
279 0           $s->bitrate($sbr);
280              
281 0           $s->time($sl);
282              
283 0           $s->filesize($sa);
284              
285 0           $s->songnum($songnum);
286              
287 0           $s->songs($songanz);
288              
289 0           $s->cdnum($cdnum);
290              
291 0           $s->cds($cdanz);
292              
293 0           $s->year($year);
294              
295 0           for(my $i=1;$i<=int(@jerk)-1;$i++) {
296              
297             #print "\t$i $MHOD_ID[$i] = $jerk[$i]\n" if $jerk[$i] && $MHOD_ID[$i];
298              
299 0           my $att = $MHOD_ID[$i];
300              
301 0 0 0       $s->$att($jerk[$i]) if $jerk[$i] && $MHOD_ID[$i];
302              
303             }
304              
305 0           $self->{_songs}->{$sid} = $s;
306              
307 0           return ($sum - $zip - 1); #black magic
308              
309             }
310              
311             else {
312              
313 0           return "-1";
314              
315             }
316              
317             }
318              
319             # get a SINGLE mhod entry:
320             #
321             # get_mhod(START_OF_MHOD);
322             #
323             # return+seek = new_mhod should be there
324              
325             sub _get_mhod() {
326              
327 0     0     my($xl, $ml, $mty, $foo, $id );
328              
329 0           my ($self, $seek, $dbg) = @_;
330              
331 0           $id = $self->_bin2hex($seek, 4); #are we lost?
332              
333 0           $ml = $self->_getshoe($seek+8, 4);
334              
335 0           $mty = $self->_getshoe($seek+12, 4); #genre number
336              
337 0           $xl = $self->_getshoe($seek+28,4); #Entrylength
338              
339 0 0         if($id ne "6d 68 6f 64") { $ml = -1;} #is the id INcorrect??
  0            
340              
341             else {
342              
343             #get the TYPE of the DB-Entry
344              
345 0           $foo = $self->_getstr($seek + 40, $xl); #string of the entry
346              
347 0           $foo =~ tr/\0//d; #we have many \0.. killem!
348              
349 0           return ($ml, $mty, $foo);
350              
351             }
352              
353             }
354              
355              
356             sub _getstr {
357              
358             #reads $anz chars from FILE and returns a string!
359              
360 0     0     my($buffer, $xx, $xr );
361              
362 0           my ($self, $start, $anz, $noseek) = @_;
363              
364             # paranoia checks
365              
366 0 0         if(!$start) { $start = 0; }
  0            
367              
368 0 0         if(!$anz) { $anz = "1"; }
  0            
369              
370              
371             #seek to the given position
372             #if 3th ARG isn't defined
373              
374 0           seek($self->{_dbfh}, $start, 0);
375              
376             #start reading
377              
378 0           read($self->{_dbfh}, $buffer, $anz);
379              
380 0           return $buffer;
381              
382             }
383              
384              
385             sub _getshoe {
386              
387             #reads $anz chars from FILE and returns int
388              
389 0     0     my($buffer, $xx, $xr, $xxt);
390              
391 0           my ($self, $start, $anz, $noseek) = @_;
392              
393             # paranoia checks
394              
395 0 0         if(!$start) { $start = 0; }
  0            
396              
397 0 0         if(!$anz) { $anz = "1"; }
  0            
398              
399             #seek to the given position
400              
401 0           seek($self->{_dbfh}, $start, 0);
402              
403             #start reading
404              
405 0           read($self->{_dbfh}, $buffer, $anz);
406              
407 0           foreach(split(//, $buffer)) {
408              
409 0           $xx = sprintf("%02X", ord($_));
410              
411             #print "XX: $xx XR: $xr\n";
412              
413 0 0         if ($xr) {
414              
415 0           $xr = "$xx$xr";
416              
417             } else {
418              
419 0           $xr = $xx;
420              
421             }
422              
423             }
424              
425 0           $xr = oct("0x".$xr);
426              
427 0           return $xr;
428              
429             }
430              
431              
432             sub _bin2hex {
433              
434             #reads $anz chars from FILE and returns HEX values!
435              
436 0     0     my($buffer, $xx, $xr);
437              
438 0           my ($self, $start, $anz, $noseek) = @_;
439              
440             # paranoia checks
441              
442 0 0         if(!$start) { $start = 0; }
  0            
443              
444 0 0         if(!$anz) { $anz = "1"; }
  0            
445              
446             #seek to the given position
447              
448 0           seek($self->{_dbfh}, $start, 0);
449              
450             #start reading
451              
452 0           read($self->{_dbfh}, $buffer, $anz);
453              
454 0           foreach(split(//, $buffer)) {
455              
456 0           $xx = sprintf("%02x ", ord($_));
457              
458 0           $xr = "$xr$xx";
459              
460             }
461              
462 0           chop($xr);# no whitespace at end
463              
464 0           return $xr;
465              
466             }
467              
468             package Mac::iPod::DB::Song;
469              
470 1     1   7 use strict;
  1         2  
  1         40  
471 1     1   1128 use Class::Struct;
  1         2354  
  1         7  
472              
473             struct(
474             id => '$',
475             title => '$',
476             path => '$',
477             album => '$',
478             artist => '$',
479             genre => '$',
480             fdesc => '$',
481             comment => '$',
482             composer => '$',
483             bitrate => '$',
484             time => '$',
485             filesize => '$',
486             songnum => '$',
487             songs => '$',
488             cdnum => '$',
489             cds => '$',
490             year => '$'
491             );
492              
493             package Mac::iPod::DB::Playlist;
494              
495 1     1   193 use strict;
  1         2  
  1         22  
496 1     1   4 use Class::Struct;
  1         3  
  1         3  
497              
498             struct(name => '$', _songs => '$');
499              
500             sub songs {
501              
502 0     0     my $self = shift();
503              
504 0           return @{ $self->_songs };
  0            
505              
506             }
507              
508             1;
509             __END__