view release on metacpan or  search on metacpan

README.pod  view on Meta::CPAN

package AnyEvent::DAAP::Server;
use Any::Moose;
use AnyEvent::DAAP::Server::Connection;
use AnyEvent::Socket;
use AnyEvent::Handle;
use Net::Rendezvous::Publish;
use Net::DAAP::DMAP qw(dmap_pack);
use HTTP::Request;
use Router::Simple;
use URI::QueryParam;

our $VERSION = '0.01';

has name => (
    is  => 'rw',
    isa => 'Str',
    default => sub { ref $_[0] },
);

has port => (
    is  => 'rw',
    isa => 'Int',
    default => 3689,
);

has rendezvous_publisher => (
    is  => 'rw',
    isa => 'Net::Rendezvous::Publish',
    default => sub { Net::Rendezvous::Publish->new },
);

has rendezvous_service => (
    is  => 'rw',
    isa => 'Net::Rendezvous::Publish::Service',
    lazy_build => 1,
);

sub _build_rendezvous_service {
    my $self = shift;
    return $self->rendezvous_publisher->publish(
        port => $self->port,
        name => $self->name,
        type => '_daap._tcp',
    );
}

has db_id => (
    is => 'rw',
    default => '13950142391337751523', # XXX magic value (from Net::DAAP::Server)
);

has tracks => (
    is  => 'rw',
    isa => 'HashRef[AnyEvent::DAAP::Server::Track]',
    default => sub { +{} },
);

has global_playlist => (
    is  => 'rw',
    isa => 'AnyEvent::DAAP::Server::Playlist',
    default => sub { AnyEvent::DAAP::Server::Playlist->new },
);

has playlists => (
    is  => 'rw',
    isa => 'HashRef[AnyEvent::DAAP::Server::Playlist]',
    default => sub { +{} },
);

has revision => (
    is  => 'rw',
    isa => 'Int',
    default => 1,
);

has connections => (
    is  => 'rw',
    isa => 'ArrayRef[AnyEvent::DAAP::Server::Connection]',
    default => sub { +[] },
);

has router => (
    is  => 'rw',
    isa => 'Router::Simple',
    default => sub { Router::Simple->new },
);

__PACKAGE__->meta->make_immutable;

no Any::Moose;

sub BUILD {
    my $self = shift;
    $self->add_playlist($self->global_playlist);
}

sub publish {
    my $self = shift;
    $self->rendezvous_service; # build
}

sub setup {
    my $self = shift;

    my @route = (
        '/databases/{database_id}/items'                           => '_database_items',
        '/databases/{database_id}/containers'                      => '_database_containers',
        '/databases/{database_id}/containers/{container_id}/items' => '_database_container_items',
        '/databases/{database_id}/items/{item_id}.*'               => '_database_item',
    );

    while (my ($route, $method) = splice @route, 0, 2) {
        $self->router->connect($route => { method => $method });
    }

    $self->publish;

    tcp_server undef, $self->port, sub {
        my ($fh, $host, $port) = @_;
        my $connection = AnyEvent::DAAP::Server::Connection->new(server => $self, fh => $fh);
        $connection->handle->on_read(sub {
            my ($handle) = @_;
            $handle->push_read(
                regex => qr<\r\n\r\n>, sub {
                    my ($handle, $data) = @_;
                    my $request = HTTP::Request->parse($data);
                    my $path = $request->uri->path;
                    my $p = $self->router->match($path) || {};
                    my $method = $p->{method} || $path;
                    $method =~ s<[/-]><_>g;
                    $self->$method($connection, $request, $p);
                }
            );
        });
        push @{ $self->connections }, $connection;
    };
}

sub database_updated {
    my $self = shift;
    $self->{revision}++;
    foreach my $connection (@{ $self->connections }) {
        $connection->pause_cv->send if $connection->pause_cv;
    }
}

# XXX dmap_itemid is used as only its lower 3 bytes

sub add_track {
    my ($self, $track) = @_;
    $self->tracks->{ $track->dmap_itemid & 0xFFFFFF } = $track;
    $self->global_playlist->add_track($track);
}

sub add_playlist {
    my ($self, $playlist) = @_;
    $self->playlists->{ $playlist->dmap_itemid & 0xFFFFFF } = $playlist;
}

### Handlers

sub _server_info {
    my ($self, $connection) = @_;
    $connection->respond_dmap([[
        'dmap.serverinforesponse' => [
            [ 'dmap.status'                => 200 ],
            [ 'dmap.protocolversion'       => 2 ],
            [ 'daap.protocolversion'       => '3.11' ],
            [ 'dmap.itemname'              => $self->name ],
            [ 'dmap.loginrequired'         => 1 ],
            [ 'dmap.timeoutinterval'       => 1800 ],
            [ 'dmap.supportsautologout'    => 0 ],
            [ 'dmap.supportsupdate'        => 1 ],
            [ 'dmap.supportspersistentids' => 0 ],
            [ 'dmap.supportsextensions'    => 0 ],
            [ 'dmap.supportsbrowse'        => 0 ],
            [ 'dmap.supportsquery'         => 0 ],
            [ 'dmap.supportsindex'         => 0 ],
            [ 'dmap.supportsresolve'       => 0 ],
            [ 'dmap.databasescount'        => 1 ],
        ]
    ]]);
}

sub _login {
    my ($self, $connection) = @_;