Net::DAAP::Client - client for Apple iTunes DAAP service

  Net::DAAP::Client - client for Apple iTunes DAAP service

  my $daap;  # see WARNING below
  $daap = Net::DAAP::Client->new(SERVER_HOST => $hostname,
                                 SERVER_PORT => $portnum,
                                 PASSWORD    => $password);
  $dsn = $daap->connect;

  $dbs_hash = $daap->databases;
  $current_db = $daap->db;
  $daap_db($new_db_id);

  $songs_hash = $daap->songs;
  $playlists_hash = $daap->playlists;
  $array_of_songs_in_playlist = $daap->playlist($playlist_id);

  $url = $daap->url($song_or_playlist_id);

  $binary_audio_data = $obj->get($song_id);
  $binary_audio_data = $obj->get(@song_ids);
  $song_id = $obj->save($dir, $song_id);
  @song_ids = $obj->get($dir, @song_ids);

  $daap->disconnect;

  if ($daap->error) {
      warn $daap->error;  # returns error string
  }

    $obj = Net::DAAP::Client->new(OPTNAME => $value, ...);

    $name = $obj->connect
        or die $obj->error;

    $dbs = $self->databases();

    $db_id = $obj->db;     # learn current database ID
    $obj->db($db_id);      # set current database

    $songs = $obj->songs();

    '127' => {
        'daap.songsize' => 2597221,
        'daap.songalbum' => 'Live (Disc 2)',
        'dmap.persistentid' => '4081440092921832180',
        'dmap.itemname' => 'Down To The River To Pray',
        'daap.songartist' => 'Alison Krauss + Union Station',
        'dmap.itemid' => 127,
        'daap.songformat' => 'mp3'
        },

    $songlist = $obj->playlists();

    '2583' => {
        'dmap.itemcount' => 335,
        'dmap.persistentid' => '4609413108325671202',
        'dmap.itemname' => 'Recently Played',
        'com.apple.itunes.smart-playlist' => 0,
        'dmap.itemid' => 2583
    }

    $playlist = $obj->playlist($playlist_id);

    $url = $obj->url($song_id);
    $url = $obj->url($playlist_id);

    @tracks = $obj->get(@song_ids);

    $tracks_saved = $obj->save($dir, @song_ids);

    $obj->disconnect;

    $string = $obj->error;

use strict;
package Net::DAAP::Client;
use Net::DAAP::Client::v2;
use Net::DAAP::Client::v3;
use Net::DAAP::DMAP 1.22;
use Net::DAAP::DMAP qw(:all);
use LWP;
use HTTP::Request::Common;
use Carp;
use sigtrap qw(die untrapped normal-signals);
use vars qw( $VERSION );
$VERSION = '0.42';

my $DAAP_Port = 3689;
my @User_Columns = qw( SERVER_HOST SERVER_PORT PASSWORD DEBUG SONG_ATTRIBUTES );
my %Defaults = (
    # user-specified
    SERVER_HOST   => "",
    SERVER_PORT   => $DAAP_Port,
    PASSWORD      => "",
    DEBUG         => 0,
    SONG_ATTRIBUTES => [ qw(dmap.itemid dmap.itemname dmap.persistentid
                            daap.songalbum daap.songartist daap.songformat
                            daap.songsize) ],

    # private
    ERROR         => "",
    CONNECTED     => 0,
    DATABASE_LIST => undef,
    DATABASE      => undef,
    SONGS         => undef,
    PLAYLISTS     => undef,
    VALIDATOR     => undef,
   );


sub new {
    my $class = shift;
    my $self = bless { %Defaults } => $class;

    if (@_ > 1) {
        $self->_init(@_);
    } elsif (@_) {
        $self->{SERVER_HOST} = shift;
    } else {
        warn "Why are you calling new with no arguments?";
        die "Need to implement get/set for hostname and port";
    }

    return $self;
}

sub _init {
    my $self = shift;
    my %opts = @_;

    foreach my $key (@User_Columns) {
        $self->{$key} = $opts{$key} || $Defaults{$key};
    }
}

sub _debug {
    my $self = shift;
    warn "$_[0]\n" if $self->{DEBUG};
}

sub connect {
    my $self = shift;
    my $ua = ($self->{UA} ||= Net::DAAP::Client::UA->new(keep_alive => 1) );
    my ($dmap, $id);

    $self->_devine_validator;


    $self->error("");
    $self->{DATABASE_LIST} = undef;

    # get content codes
    $dmap = $self->_do_get("content-codes") or return;
    update_content_codes(dmap_unpack($dmap));

    # check server name/version
    $dmap = $self->_do_get("server-info") or return;

    my %hash = dmap_flat_list( dmap_unpack ($dmap) );
    my $data_source_name = $hash{'/dmap.serverinforesponse/dmap.itemname'};
    $self->{DSN} = $data_source_name;
    $self->_debug("Connected to iTunes share '$data_source_name'");

    # log in
    $dmap = $self->_do_get("login") or return;
    $id = dmap_seek(dmap_unpack($dmap), "dmap.loginresponse/dmap.sessionid");
    $self->{ID} = $id;
    $self->_debug("my id is $id");

    $self->{CONNECTED} = 1;

    # fetch databases
    my $dbs = $self->databases()
      or return;

    # autoselect if only one database present
    if (keys(%$dbs) == 1) {
        $self->db((keys %$dbs)[0])
          or return;
    }

    return $self->{DSN};
}

sub databases {
    my $self = shift;

    $self->error("");

    unless ($self->{CONNECTED}) {
        $self->error("Not connected--can't fetch databases list");
        return;
    }

    my $res = $self->_do_get("databases");
    my $listing = dmap_seek(dmap_unpack($res),
                            "daap.serverdatabases/dmap.listing");

    unless ($listing) {
        $self->error("databases query didn't return a list of databases");
        return;
    }

    my $struct = $self->_unpack_listing_to_hash($listing);

    $self->{DATABASE_LIST} = $struct;
    return $struct;
}

sub db {
    my ($self, $db_id) = @_;
    my $db;

    unless ($self->{DATABASE_LIST}) {
        $self->error("You haven't fetched the list of databases yet");
        return;
    }

    unless (defined $db_id) {
        return $self->{DATABASE};
    }

    $db = $self->{DATABASE_LIST}{$db_id};
    if (defined $db) {
        $self->{DATABASE} = $db_id;
        $self->_debug("Loading songs from database $db->{'dmap.itemname'}");
        $self->{SONGS} = $self->_get_songs($db_id)
          or return;
        $self->_debug("Loading playlists from database $db->{'dmap.itemname'}");
        $self->{PLAYLISTS} = $self->_get_playlists($db_id)
          or return;
    } else {
        $self->error("Database ID $db_id not found");
        return;
    }

    return $self;
}

sub songs {
    my $self = shift;

    return $self->{SONGS};
}

sub playlists {
    my $self = shift;

    return $self->{PLAYLISTS};
}

sub _get_songs {
    my ($self, $db_id) = @_;

    my $path = "databases/$db_id/items?type=music&meta=" .
      join ",", @{ $self->{SONG_ATTRIBUTES} };
    my $res = $self->_do_get($path) or return;

    my $listing = dmap_seek(dmap_unpack($res),
                            "daap.databasesongs/dmap.listing");
    if (!$listing) {
        $self->error("no song database in response from server");
        return;
    }

    my $struct = $self->_unpack_listing_to_hash($listing);
    delete @{%$struct}{ grep { $struct->{$_}{'daap.songsize'} == 0 } keys %$struct };  # remove deleted songs

    return $struct;
}

sub _get_playlists {
    my ($self, $db_id) = @_;

    my $res = $self->_do_get("databases/$db_id/containers?meta=dmap.itemid,dmap.itemname,dmap.persistentid,com.apple.itunes.smart-playlist")
        or return;

    my $listing = dmap_seek(dmap_unpack($res),
                            "daap.databaseplaylists/dmap.listing");
    if (!$listing) {
        $self->error("no playlist in response from server");
        return;
    }

    return $self->_unpack_listing_to_hash($listing);
}

sub playlist {
    my ($self, $playlist_id) = @_;

    my $db_id = $self->{DATABASE};
    if (!$db_id) {
        $self->error("No database selected so can't fetch playlist");
        return;
    }

    if (!exists $self->{PLAYLISTS}->{$playlist_id}) {
        $self->error("No such playlist $playlist_id");
        return;
    }

    my $res = $self->_do_get("databases/$db_id/containers/$playlist_id/items?type=music&meta=dmap.itemkind,dmap.itemid,dmap.containeritemid")
        or return;

    my $listing = dmap_seek(dmap_unpack($res),
                            "daap.playlistsongs/dmap.listing");
    if (!$listing) {
        $self->error("Couldn't fetch playlist $playlist_id");
    }

    my $struct = [];

    foreach my $item (@$listing) {
        my $record = {};
        my $field_array_ref = $item->[1];
        foreach my $field_pair_ref (@$field_array_ref) {
            my ($field, $value) = @$field_pair_ref;
            $record->{$field} = $value;
        }
        push @$struct, $self->{SONGS}->{ $record->{"dmap.itemid"} };
    }

    return $struct;
}

sub _unpack_listing_to_hash {
    my ($self, $listing) = @_;

    my $struct = {};

    foreach my $item (@$listing) {
        my $record = {};
        my $field_array_ref = $item->[1];
        foreach my $field_pair_ref (@$field_array_ref) {
            my ($field, $value) = @$field_pair_ref;
            $record->{$field} = $value;
        }
        $struct->{$record->{'dmap.itemid'}} = $record;
    }

    return $struct;
}

###
### XXX: I go from Math::BigInt to
### string to Math::BigInt again.  Some of these helper methods are surely
### not necessary?
###

sub url {
    my ($self, @arg) = @_;

    $self->error("");

    if (!$self->{CONNECTED}) {
        $self->error("Can't fetch URL when not connected");
        return;
    }

    my $song_list = $self->{SONGS};
    my $playlists = $self->{PLAYLISTS};
    my $db = $self->{DATABASE_LIST}{$self->{DATABASE}}{"dmap.persistentid"};
    my @urls = ();
    my @skipped = ();

    foreach my $id (@arg) {
        if (exists $song_list->{$id}) {
            my $song = $song_list->{$id};
            push @urls, $self->
            _build_resolve_url(database => $db,
                               song     => $song->{"dmap.persistentid"});
        } elsif (exists $playlists->{$id}) {
            my $playlist = $playlists->{$id};
            push @urls, $self->
            _build_resolve_url(database => $db,
                              playlist => $playlist->{"dmap.persistentid"});
        } else {
            push @skipped, $id;
        }
    }

    if (@skipped) {
        $self->error("skipped: @skipped");
    }

    if (wantarray) {
        return @urls;
    } else {
        return $urls[0];
    }
}

sub _build_resolve_url {
    my ($self, %specs) = @_;

    return "daap://$self->{SERVER_HOST}:$self->{SERVER_PORT}/resolve?" .
      join('&', map {my $id = $self->_persistentid_as_text($specs{$_});
                     "$_-spec='dmap.persistentid:$id'"} keys %specs);
}

sub _persistentid_as_text {
    my ($self, $id) = @_;

    $id = new Math::BigInt($id);

    return sprintf("0x%08x%08x", $id->brsft(32), $id->band(0xffffffff));
}

sub get {
    my ($self, @arg) = @_;
    $self->_download_songs(undef, @arg);
}

sub _download_songs {
    my ($self, $dir, @arg) = @_;
    my $song_list = $self->{SONGS};
    my @songs;
    my @skipped;

    foreach my $song_id (@arg) {
        my $song = $song_list->{$song_id};

        if (!defined $song) {  # ok to blur defined() and exists() here
            push @skipped, $song_id;
            next;
        }
        my $response = $self->_get_song($self->{DATABASE}, $song, $dir);
        if (!$response) {
            push @skipped, $song_id;
        } else {
            push @songs, $dir ? $song_id : $response;
        }
    }

    if (@skipped) {
        $self->error("skipped: @skipped");
    }
    if (wantarray) {
        return @songs;
    } else {
        return $songs[0];
    }
}

sub _get_song {
    my ($self, $db_id, $song, $dir) = @_;
    my ($song_id, $format) =
        ($song->{"dmap.itemid"}, $song->{"daap.songformat"});
    my $filename = "$song_id.$format";

    ++$self->{REQUEST_ID};

    if ($dir) {
        return $self->_do_get("databases/$db_id/items/$filename",
                              "$dir/$filename");
    } else {
        return $self->_do_get("databases/$db_id/items/$filename");
    }
}

sub save {
    my ($self, @arg) = @_;
    $self->_download_songs(@arg);
}

sub disconnect {
    my $self = shift;

    $self->error("");
    if ($self->{CONNECTED}) {
        (undef) = $self->_do_get("logout");
    }
    undef $self->{CONNECTED};
    return $self->error;
}

sub DESTROY {
    my $self = shift;
    $self->_debug("Destroying $self->{ID} to $self->{SERVER_HOST}");
    $self->disconnect;
}

sub error {
    my $self = shift;
    if ($self->{DEBUG} and defined($_[0]) and length($_[0])) {
        warn "Setting error to $_[0]\n";
    }
    if (@_) { $self->{ERROR} = shift } else { $self->{ERROR} }
}

sub _devine_validator {
    my $self = shift;
    $self->{VALIDATOR} = undef;
    $self->{M4p_evil}  = 0;

    my $response = $self->{UA}->get( $self->_server_url.'/server-info' );
    my $server = $response->header('DAAP-Server');

    if ($server =~ m{^iTunes/4.2 }) {
        $self->{VALIDATOR} = __PACKAGE__."::v2";
        return;
    }

    if ($server =~ m{^iTunes/}) {
        $self->{M4p_evil} = 1;
        $self->{VALIDATOR} = __PACKAGE__."::v3"
    }
}


sub _validation_cookie {
    my $self = shift;
    return unless $self->{VALIDATOR};
    return ( "Client-DAAP-Validation" => $self->{VALIDATOR}->validate( @_ ) );
}

sub _server_url {
    my $self = shift;
    sprintf("http://%s:%d", $self->{SERVER_HOST}, $self->{SERVER_PORT});
}

# quite the fugly hack
my @credentials;
{
    package Net::DAAP::Client::UA;
    use base qw( LWP::UserAgent );
    sub get_basic_credentials { return @credentials }

}

sub _do_get {
    my ($self, $req, $file) = @_;
    if (!defined wantarray) { carp "_do_get's result is being ignored" }

    my $id = $self->{ID};
    my $revision = $self->{REVISION};
    my $ua = $self->{UA};

    my $url = $self->_server_url . "/$req";
    my $res;

    # append session-id and revision-number query args automatically
    if ($self->{ID}) {
        $url .= $req =~ m{ \? }x ? "&" : "?";
        $url .= "session-id=$id";
    }

    if ($revision && $req ne 'logout') {
        $url .= "&revision-number=$revision";
    }

    # fetch into memory or save to disk as needed

    $self->_debug($url);

    # form the request ourself so we have magic headers.
    my $path = $url;
    $path =~ s{http://.*?/}{/};

    my $reqid = $self->{REQUEST_ID};
    my $request = HTTP::Request::Common::GET(
        $url,
        "Client-DAAP-Version"      => '3.0',
        "Client-DAAP-Access-Index" => 2,
        $reqid ? ( "Client-DAAP-Request-ID" => $reqid ) : (),
        $self->_validation_cookie( $path, 2, $reqid ),
       );

    #print ">>>>\n", $request->as_string, ">>>>>\n";

    # It would seem that 4.{5,6} are using their internal MD5/M4p for
    # their digest auth, or some other form of evil, certainly the
    # regular Digest auth that works with 4.2 gets refused.

    #local *Digest::MD5::new = sub { shift; Digest::MD5::M4p->new( @_ ) }
    #  if $self->{M4p_evil};

    @credentials = $self->{PASSWORD} ? ('iTunes_4.6', $self->{PASSWORD}) : ();

    if ($file) {
        $res = $ua->request($request, $file);
    } else {
        $res = $ua->request($request);
    }
    # complain if the server sent back the wrong response
    unless ($res->is_success) {
        $self->error("$url\n" . $res->as_string);
        return;
    }

    my $content_type = $res->header("Content-Type");
    if ($req !~ m{(?:/items/\d+\.|logout)} && $content_type !~ /dmap/) {
        $self->error("Broken response (content type $content_type) on $url");
        return;
    }

    if ($file) {
        return $res;           # return obj to avoid copying huge string
    } else {
        return $res->content;
    }
}

1;

__END__