#!/usr/bin/perl -T -I /audiotest/perlmodules/ ################################################################################ # _____ _ # |_ _| |_ ___ # | | | ' \/ -_) # |_| |_||_\___| # _ _ ____ _ _ # / \ _ __ ___| |_(_) ___ __ _ | _ \ _ __ ___ (_) ___ ___| |_ # / _ \ | '__/ __| __| |/ __/ _` | | |_) | '__/ _ \| |/ _ \/ __| __| # / ___ \| | | (__| |_| | (_| (_| | | __/| | | (_) | | __/ (__| |_ # /_/ \_\_| \___|\__|_|\___\__,_| |_| |_| \___// |\___|\___|\__| # |__/ # The Arctica Modular Remote Computing Framework # ################################################################################ # # Copyright (C) 2015-2016 The Arctica Project # http://arctica-project.org/ # # This code is dual licensed: strictly GPL-2 or AGPL-3+ # # GPL-2 # ----- # 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; version 2 of the License. # # 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., # # 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. # # AGPL-3+ # ------- # This programm is free software; you can redistribute it and/or modify # it under the terms of the GNU Affero General Public License as published by # the Free Software Foundation; either version 3 of the License, or # (at your option) any later version. # # This programm 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 Affero General Public License for more details. # # You should have received a copy of the GNU Affero General Public License # along with this program; if not, write to the # Free Software Foundation, Inc., # 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. # # Copyright (C) 2015-2017 Guangzhou Nianguan Electronics Technology Co.Ltd. # # Copyright (C) 2015-2017 Mike Gabriel # ################################################################################ use strict; use Data::Dumper; use Arctica::Core::eventInit qw(genARandom BugOUT); use Arctica::Core::JABus::Socket; use Arctica::Services::Audio::Server::PulseAudio::PAVirtualDevices; use Arctica::Services::Audio::Streamer::PulseAudio2GST; #FIXME ADD something that checks for active PulseAudio before we start doing our stuff.... my $ACO = Arctica::Core::eventInit->new({ app_name=>'audio-server-test', app_class =>'amoduletester', app_version=>'0.0.1.1'}); my $JABusServer = Arctica::Core::JABus::Socket->new($ACO,{ type => "unix", destination => "local", is_server => 1, handle_in_dispatch => { # heartbeat => \&heartbeat, #FIXME heartbeat will be intergrated in RTT and persistency code in JABus... gstctl => \&pa2gst_ctl,# Client facing stuff must be NON pulse centric init => \&client_init, # cmd => \&client_init,# JABus runtime control # sub => \&subsrvc,# JABus runtime notifications service }, }); open(SID,">$ACO->{'a_dirs'}{'tmp_adir'}/audiotest_socet_id"); print SID "$JABusServer->{'_socket_id'}\n"; close(SID); my $PA2GST = Arctica::Services::Audio::Streamer::PulseAudio2GST->new($ACO,$JABusServer); if (@ARGV) { foreach my $arg (@ARGV) { BugOUT(8,"ARG:\t$arg\t:ARG\n"); if ($arg =~ /^\-bitrate=([0-9\:]{1,})/) { $PA2GST->set_bitrate($1); } elsif ($arg =~ /^\-dgst_soc_port\=([io]\d*)\:(\d*)$/) {# FIXME by the time we're doing something with unix sockets this will be looooooong gone... $PA2GST->set_device_gst_port($1,$2); } elsif ($arg =~ /^\-dgst_soc_type\=([a-z]{3,5})/) { $PA2GST->set_device_socket_type($1); } } } else { BugOUT(0,"NO ARGS?"); } my $PA_VDev = Arctica::Services::Audio::Server::PulseAudio::PAVirtualDevices->new($ACO,{ hook_device_state => \&handle_PA_device_events, }); my $wtf = Glib::Timeout->add (500, \&chk_bitrate_file, undef, 1 );# FIXME DIRTY HACK... WILL BE HANDELED ON JABus in the TeKi enabled version $ACO->{'Glib'}{'MainLoop'}->run; sub pa2gst_ctl { my $JDATA = $_[0]; my (undef,$device_soc_style) = $PA2GST->get_device_socket_type(); # print "SOCK STYLE: $device_soc_style\n"; # print "GSTCTL_JSON:\n",Dumper($JDATA); # print "Action:\t$JDATA->{'action'}\n"; if ($JDATA->{'action'} eq "ready") { if ($JDATA->{'type'} eq "output") { if ($JDATA->{'idnum'} =~ /^(\d{1,})$/) { my $idnum = $1; if ($device_soc_style eq "stream") { $PA2GST->start_output($idnum,$PA_VDev->{'pa_vdev'}{'output'}{$idnum}{'pa_sink_name'}); } } } } return 1; } sub handle_PA_device_events {# FIXME this has moved into PulseAudio2GST...: But then it came back out here... print "-------------------------------\n"; print Dumper(@_),"\n"; my $type = $_[0]; my $idnum = $_[1]; my $name = $_[2]; my $new_state = $_[3]; my $clientID = $PA2GST->get_active_client_id(); my (undef,$device_soc_style) = $PA2GST->get_device_socket_type(); if ($clientID) { if ($type eq "input") { if ($new_state eq "R") { # START LOCAL THEN CLIENTSIDE $PA2GST->start_input($idnum,$PA_VDev->{'pa_vdev'}{$type}{$idnum}{'pa_sink_name'},sub { $JABusServer->server_send($clientID,"gstctl",{ action => "start", type => $type, idnum => $idnum, bitrate => $PA2GST->get_bitrate("input"), }); }); open(HM,">/tmp/hotmic");print HM time;close(HM);# FIXME DIRTY HACK... WILL BE HANDELED ON JABus in the TeKi enabled version } elsif($new_state eq "S") { $PA2GST->stop_input($idnum); $JABusServer->server_send($clientID,"gstctl",{ action => "stop", type => $type, idnum => $idnum, }); if (-f "/tmp/hotmic") {unlink("/tmp/hotmic");}# FIXME DIRTY HACK... WILL BE HANDELED ON JABus in the TeKi enabled version } } elsif ($type eq "output") { if ($new_state eq "R") { unless ($device_soc_style ne "datagram") { $PA2GST->start_output($idnum,$PA_VDev->{'pa_vdev'}{$type}{$idnum}{'pa_sink_name'}); } $JABusServer->server_send($clientID,"gstctl",{ action => "start", type => $type, idnum => $idnum, }); } elsif ($new_state eq "S") { $JABusServer->server_send($clientID,"gstctl",{ action => "stop", type => $type, idnum => $idnum, }); $PA2GST->stop_output($idnum); } } } } sub client_init { my $JSONDATA = $_[0]; my $client_ID = $_[1]; my $TheJBUS = $_[2]; BugOUT(8,"NEW CLIENT! ( $client_ID )"); if ($ACO->{'aobj'}{'AudioServer'}{'client_ID'}) { client_cleanup($ACO->{'aobj'}{'AudioServer'}{'client_ID'}); } $ACO->{'aobj'}{'AudioServer'}{'client_ID'} = $client_ID; $PA2GST->set_jbus_client_id($client_ID); # FIXME Add something to force check of pulse vdev status at this point.... $PA_VDev->force_chk_dev_state(); # $TheJBUS->server_send($client_ID,'init','GOOD TO GO!'); return 1; } sub chk_bitrate_file {# FIXME DIRTY HACK... WILL BE HANDELED ON JABus in the TeKi enabled version if (-f "/tmp/ch_bitrate") { open(BR,"/tmp/ch_bitrate"); my ($rate,undef) =
; close(BR); if ($rate =~ /^([0-9\:]{1,})/) { BugOUT(1,"CHBITRATE: $rate"); $PA2GST->set_bitrate($rate); my $clientID = $PA2GST->get_active_client_id(); if ($clientID) { my $input_rate = $PA2GST->get_bitrate("input"); $JABusServer->server_send($clientID,"gstctl",{ action => "ch_input_bitrate", bitrate => $input_rate , }); } } unlink("/tmp/ch_bitrate"); } return 1; } sub client_cleanup { #FIXME Reset everything to a clean state when new client connection is initiated! # ( Cause you'r mom ain't no perl sub! ) }