From 10f2744658eeb4ccbf0342d707c08ecfb9623b91 Mon Sep 17 00:00:00 2001 From: dakkar Date: Sun, 28 Nov 2021 15:21:34 +0000 Subject: move stuff around, add lirc client --- .gitignore | 3 ++ META6.json | 9 ++++ lib/Cro/BodyParser/VlcXML.rakumod | 38 +++++++++++++++ lib/Lirc/Client.rakumod | 37 ++++++++++++++ lib/Vlc/App.rakumod | 33 +++++++++++++ lib/Vlc/Client.rakumod | 46 ++++++++++++++++++ resources/vlc.html | 58 ++++++++++++++++++++++ vlc.html | 58 ---------------------- vlc.raku | 100 +++----------------------------------- 9 files changed, 231 insertions(+), 151 deletions(-) create mode 100644 .gitignore create mode 100644 META6.json create mode 100644 lib/Cro/BodyParser/VlcXML.rakumod create mode 100644 lib/Lirc/Client.rakumod create mode 100644 lib/Vlc/App.rakumod create mode 100644 lib/Vlc/Client.rakumod create mode 100644 resources/vlc.html delete mode 100644 vlc.html diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..e95422e --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +*~ +.#* +.precomp/ diff --git a/META6.json b/META6.json new file mode 100644 index 0000000..0933a3f --- /dev/null +++ b/META6.json @@ -0,0 +1,9 @@ +{ + "perl": "6.d", + "name": "Vlc::Control", + "depends": [ + ], + "resources": [ + "vlc.html" + ] +} diff --git a/lib/Cro/BodyParser/VlcXML.rakumod b/lib/Cro/BodyParser/VlcXML.rakumod new file mode 100644 index 0000000..0750c9a --- /dev/null +++ b/lib/Cro/BodyParser/VlcXML.rakumod @@ -0,0 +1,38 @@ +use v6.d; +use Cro::BodyParser; +use Cro::HTTP::Message; +use XML; + +class Cro::BodyParser::VlcXML does Cro::BodyParser { + method is-applicable(Cro::HTTP::Message $message --> Bool) { + with $message.content-type { + .type eq 'application'|'text' && .subtype eq 'xml' || .suffix eq 'json' + } + else { + False + } + } + + method parse(Cro::HTTP::Message $message --> Promise) { + Promise( + supply { + my $payload = Blob.new; + + whenever $message.body-byte-stream -> $blob { + $payload ~= $blob; + LAST emit from-xml($payload.decode('utf-8')); + } + + # if we had LibXML + + # my LibXML::PushParser $parser .= new(); + # + # whenever $message.body-byte-stream -> $blob { + # $parser.push($blob); + # $payload ~= $blob; + # LAST emit $parser.finish-push; + # } + } + ) + } +} diff --git a/lib/Lirc/Client.rakumod b/lib/Lirc/Client.rakumod new file mode 100644 index 0000000..0065335 --- /dev/null +++ b/lib/Lirc/Client.rakumod @@ -0,0 +1,37 @@ +use v6.d; +use NativeCall; + +class Lirc::Client { + our class X::Init is Exception { + has Int $.rc; + method message { "Failed to init LIRC client: $!rc" } + } + + our class X::Send is Exception { + method message { "Failed to send command to LIRC client" } + } + + my sub lirc_get_local_socket(Str $socket is encoded('utf8'), int32 $verbose --> int32) is native('lirc_client') {*} + my sub lirc_send_one(int32 $fd, Str $remote is encoded('utf8'), Str $keysym is encoded('utf8') --> int32) is native('lirc_client') {*} + + has int $!fd; + + submethod BUILD(Str :$socket=Str, Bool :$verbose=False) { + $!fd = lirc_get_local_socket($socket, $verbose ?? 1 !! 0); + X::Init.new(rc => -$!fd).throw() if $!fd < 0; + } + + method !send-sync(Str :$remote, Str :$keysym) { + my $rc = lirc_send_one($!fd, $remote, $keysym); + X::Send.new().throw() if $rc != 0; + } + + # copied from OO::Actors + has Lock::Async $!orderer .= new; + method send(Str :$remote, Str :$keysym) { + $!orderer.lock.then({ + LEAVE $!orderer.unlock; + self!send-sync(:$remote, :$keysym); + }) + } +} diff --git a/lib/Vlc/App.rakumod b/lib/Vlc/App.rakumod new file mode 100644 index 0000000..e4401e6 --- /dev/null +++ b/lib/Vlc/App.rakumod @@ -0,0 +1,33 @@ +use v6.d; +use Cro::HTTP::Server; +use Cro::HTTP::Router; +use Vlc::Client; + +class Vlc::App { + has Vlc::Client $.vlc is required; + has Int $.port = 8080; + has Cro::Service $!service handles ; + + method start() { + my $application = route { + resources-from %?RESOURCES; + + get -> { resource 'vlc.html' } + + post -> 'play' { await self.vlc.command('pl_play') } + post -> 'pause' { await self.vlc.command('pl_pause') } + post -> 'stop' { await self.vlc.command('pl_stop') } + + get -> 'status' { + my $status = await self.vlc.status(); + content 'application/json', $status; + } + }; + + $!service = Cro::HTTP::Server.new( + :port(self.port), :$application, + ); + + return $!service.start(); + } +} diff --git a/lib/Vlc/Client.rakumod b/lib/Vlc/Client.rakumod new file mode 100644 index 0000000..3620d47 --- /dev/null +++ b/lib/Vlc/Client.rakumod @@ -0,0 +1,46 @@ +use v6.d; +use Cro::HTTP::Client; +use Cro::Uri::HTTP; +use Cro::BodyParser::VlcXML; +use XML; + +multi sub maybe-bool('true') { True } +multi sub maybe-bool('false') { False } +multi sub maybe-bool($x) { $x } + +sub xml-to-hash(XML::Element $elem) { + if $elem.elements() -> @children { + return %( @children.map: { .name => xml-to-hash($_) } ) + } + + return maybe-bool($elem.contents().join('').trim) +} + +class Vlc::Client { + has Cro::HTTP::Client $!vlc; + has Str $.password is required; + has Str $.base-uri = 'http://127.0.0.1:8080/requests/'; + + method !call-vlc(Str $path, *%args) { + $!vlc ||= Cro::HTTP::Client.new( + auth => { :username(), :password(self.password) }, + add-body-parsers => [ Cro::BodyParser::VlcXML ], + ); + + state Cro::Uri::HTTP $base-uri .= parse(self.base-uri); + + return $!vlc.get( + $base-uri.add($path).add-query(|%args), + ); + } + + method command(Str $command, *%args) { + return self!call-vlc('status.xml', :$command, |%args); + } + + method status() { + my $res = await self!call-vlc('status.xml'); + my XML::Document $status = await $res.body; + return Promise.kept({:status(xml-to-hash($status.root))}) + } +} diff --git a/resources/vlc.html b/resources/vlc.html new file mode 100644 index 0000000..e33ac9a --- /dev/null +++ b/resources/vlc.html @@ -0,0 +1,58 @@ + + + + + vlc + + + + + + + + + + diff --git a/vlc.html b/vlc.html deleted file mode 100644 index e33ac9a..0000000 --- a/vlc.html +++ /dev/null @@ -1,58 +0,0 @@ - - - - - vlc - - - - - - - - - - diff --git a/vlc.raku b/vlc.raku index 1e66776..803bda8 100644 --- a/vlc.raku +++ b/vlc.raku @@ -1,102 +1,16 @@ #!/usr/bin/env rakudo use v6.d; -use Cro::HTTP::Server; -use Cro::HTTP::Router; -use Cro::HTTP::Client; -use Cro::Uri::HTTP; -use XML; -use XML::XPath; -use MIME::Base64; +use lib 'lib'; +use Vlc::Client; +use Vlc::App; -class VlcXMLParser does Cro::BodyParser { - method is-applicable(Cro::HTTP::Message $message --> Bool) { - with $message.content-type { - .type eq 'application'|'text' && .subtype eq 'xml' || .suffix eq 'json' - } - else { - False - } - } +my Vlc::Client $vlc .= new(:password,:base-uri); - method parse(Cro::HTTP::Message $message --> Promise) { - Promise( - supply { - my $payload = Blob.new; +my Vlc::App $app .= new(:port(8080), :$vlc); - whenever $message.body-byte-stream -> $blob { - $payload ~= $blob; - LAST emit from-xml($payload.decode('utf-8')); - } - - # if we had LibXML - - # my LibXML::PushParser $parser .= new(); - # - # whenever $message.body-byte-stream -> $blob { - # $parser.push($blob); - # $payload ~= $blob; - # LAST emit $parser.finish-push; - # } - } - ) - } -} - -multi sub maybe-bool('true') { True } -multi sub maybe-bool('false') { False } -multi sub maybe-bool($x) { $x } - -sub xml-to-hash(XML::Element $elem) { - if $elem.elements() -> @children { - return %( @children.map: { .name => xml-to-hash($_) } ) - } - - return maybe-bool($elem.contents().join('').trim) -} - -sub call-vlc(Str $path, *%args) { - my Cro::HTTP::Client $vlc .= new( - auth => { :username(), :password('ginopino') }, - add-body-parsers => [ VlcXMLParser ], - ); - - state Cro::Uri::HTTP $base-uri .= parse('http://192.168.1.111:8080/requests/'); - - return $vlc.get( - $base-uri.add($path).add-query(|%args) - ); -} - -sub vlc-command(Str $command, *%args) { - return call-vlc('status.xml', :$command, |%args); -} - -sub vlc-status() { - my $res = await call-vlc('status.xml'); - my XML::Document $status = await $res.body; - return Promise.kept({:status(xml-to-hash($status.root))}) -} - -my $application = route { - get -> { static 'vlc.html' } - - post -> 'play' { await vlc-command('pl_play') } - post -> 'pause' { await vlc-command('pl_pause') } - post -> 'stop' { await vlc-command('pl_stop') } - - get -> 'status' { - my $status = await vlc-status(); - content 'application/json', $status; - } -}; - -my Cro::Service $service = Cro::HTTP::Server.new( - :port(8080), :$application, -); - -$service.start; +$app.start; react whenever signal(SIGINT) { - $service.stop; + $app.stop; exit; } -- cgit v1.2.3