#!/usr/bin/perl

# This code is GPLed but abondoned.  I don't expect to ever update it again,
# but I am placing it under the GPL and leaving is posted for posterity.
# If you really want to do something cool w/ perl and an iPod, consider
# Mac::iPod::DB or Mac::iPod::GNUpod from your local CPAN mirror
# - jetmore

use strict;

my($p_name)   = $0 =~ m|/?([^/]+)$|;
my $p_version = "20040316.0";
my $p_usage   = "Usage: $p_name [--help] [--version] <ipod mount point>";
my $p_cp      = <<EOM;
        Copyright (c) 2003 John Jetmore <jj33\@pobox.com>

    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
EOM
ext_usage();

my $base = shift || die "Usage: $0 <ipod mount point>\n";
$base =~ s|/$||g;
my $f = $base . '/iPod_Control/iTunes/iTunesDB';
my $track_info;
my %fields = (
  1 => 'title',       2 => 'file',         3 => 'album',      4 => 'artist',
  5 => 'genre',       6 => 'audio',        7 => 'UNKNOWN_7',  8 => 'comment',
  9 => 'UNKNOWN_9',   10 => 'UNKNOWN_10', 11 => 'UNKNOWN_11',
  12 => 'composer',   13 => 'UNKNOWN_13', 14 => 'UNKNOWN_14',
  15 => 'UNKNOWN_15', 16 => 'UNKNOWN_16', 17 => 'UNKNOWN_17',
);

open(I, "<$f") || die "Can't open $f: $!\n";
while ($track_info = get_track(\*I)) {
  print "$track_info->{artist}\t$track_info->{album}\t$track_info->{title}\t",
        "$track_info->{file}\t$track_info->{genre}\n";

  #print "saw track $track_info->{title}\n";
  #foreach (keys %$track_info) {
  #  print "\t$_\t$track_info->{$_}\n";
  #}
}
close(I);

exit;

sub get_track {
  my $fh = shift;
  my %hash = ();
  my $record;
  my $num_fields;

  # we want the very first thing to be a "mhit" record, which marks the start
  # of a group of records for a single track.  If the first record isn't an 
  # mhit record, skip until we find one.
  do {
    ($record,$num_fields) = skip_bogus_record($fh);
  } while ($record ne 'mhit');

  for (my $i = 0; $i < $num_fields; $i++) {
    my($data,$type) = get_track_data($fh);
    $hash{$fields{$type}} = $data;
  }

  return(\%hash);
}

sub get_track_data {
  my $fh = shift;
  my $record;
  my $data;
  my $buff;
  my $reclen;

  read($fh,$buff,4) || return("");
  return("") if ($buff ne 'mhod');
  $record .= $buff;

  read($fh,$buff,4) || return("");
  $record .= $buff;

  read($fh,$buff,1) || return("");
  $record .= $buff;
  $reclen = ord($buff);
  read($fh,$buff,1) || return("");
  $record .= $buff;
  $reclen += ord($buff) * 0x100;

  read($fh,$buff,$reclen-length($record)) || return("");
  $record .= $buff;

  my $datalen = ord(substr($record,0x1c,1)) +
                ord(substr($record,0x1d,1)) * 0x100;

  my $type = ord(substr($record, 0xc, 1));

  $data = substr($record, $datalen*-1);
  
  # I think the data is in unicode or some such (2-byte chars, whatever the
  # format), but I don't speak japanese and neither does my itunes, so just 
  # delete the nulls and go from there.
  my $null = chr(0);
  $data =~ s/$null//g;

  # this is a bit-o-a-hack, but I want to get the full path to the filw,
  # plus make it a unix path
  if ($fields{$type} eq 'file') {
    $data =~ s|:|/|g;
    $data = "$base$data";
  }

  return($data,$type);
}

sub skip_bogus_record {
  my $fh = shift;
  my $record;
  my $data;
  my $buff;

  read($fh,$record,4) || return(undef);
  $data .= $record;
  
  read($fh,$buff,1) || return(undef);
  $data .= $buff;

  # This is probably a 2-byte number like in the mhod records, but it doesn't
  # seem to matter to me right now.
  my $length = ord($buff);
  read($fh,$buff,$length-5) || return(undef);
  $data .= $buff;

  # This is only relevant for mhit records, but for now collect it everywhere
  my $num_fields = ord(substr($data,0xc,1));

  return($record,$num_fields);
}

sub ext_usage {
  if ($ARGV[0] =~ /^--help$/i) {
    require Config;
    $ENV{PATH} .= ":" unless $ENV{PATH} eq "";
    $ENV{PATH} = "$ENV{PATH}$Config::Config{'installscript'}";
    exec("perldoc", "-F", "-U", $0) || exit 1;
    # make parser happy
    %Config::Config = ();
  } elsif ($ARGV[0] =~ /^--version$/i) {
    print "$p_name version $p_version\n\n$p_cp\n";
  } else {
    return;
  }

  exit(0);
}

__END__

=head1 NAME

parse-ipod-db - Provide information from ipod database

=head1 USAGE

parse-ipod-db [--help|--version] | <ipod mount point>

=head1 OPTIONS

=over 4

=item --help

This screen.

=item --version

version info.

=item <ipod mount point>

The mount point of your ipod.  For instance, when I run this program my mount point is "/Volumes/John's iPod".

=back

=head1 COMMENTS

Used by me to extract whole albums out of the hashed dir's in iPod's music folders.

=head1 CONTACT

=item proj-parse-ipod-db@jetmore.net