App-SlideServer
view release on metacpan or search on metacpan
lib/App/SlideServer.pm view on Meta::CPAN
our $VERSION = '0.002'; #VERSION
#ABSTRACT: Mojo web server that serves slides and websocket
# Files supplied by the user to override the distribution
has serve_dir => sub { path(shift->home) };
# Choose the first of
sub slides_source_file($self, $value=undef) {
$self->{slides_source_file}= $value if defined $value;
$self->{slides_source_file} // do {
my ($src)= grep -f $_,
$self->serve_dir->child('slides.html'),
$self->serve_dir->child('slides.md'),
$self->serve_dir->child('public','slides.html'),
$self->serve_dir->child('public','slides.md');
$src;
};
}
lib/App/SlideServer.pm view on Meta::CPAN
has viewers => sub { +{} };
# Hashref of data to be pushed to all clients
has published_state => sub { +{} };
has ['cache_token', 'page_dom', 'slides_dom'];
sub build_slides($self, %opts) {
my ($html, $token)= $self->load_slides_html(if_changed => $self->cache_token);
return 0 unless defined $html; # undef if source file unchanged
my ($page, @slides)= $self->extract_slides_dom($html);
$self->log->info("Loaded ".@slides." slides from ".$self->slides_source_file);
$page= $self->merge_page_assets($page);
$self->cache_token($token);
my $page_diff= !$self->page_dom || $self->page_dom ne $page;
my @slides_diff= !$self->slides_dom? (0..$#slides)
: grep { ($self->slides_dom->[$_]//'') ne ($slides[$_]//'') } 0..$#slides;
$self->page_dom($page);
$self->slides_dom(\@slides);
$self->on_page_changed() if $page_diff;
$self->on_slides_changed(\@slides_diff) if @slides_diff;
return \@slides;
}
sub load_slides_html($self, %opts) {
my $srcfile= $self->slides_source_file;
defined $srcfile
or croak "No source file; require slides.md or slides.html in serve_dir '".$self->serve_dir."'\n";
# Allow literal data with a scalar ref
my ($content, $change_token);
if (ref $srcfile eq 'SCALAR') {
return undef
if defined $opts{if_changed} && 0+$srcfile == $opts{if_changed};
$content= $$srcfile;
$change_token= 0+$srcfile;
lib/App/SlideServer.pm view on Meta::CPAN
$content= path($srcfile)->slurp;
utf8::decode($content); # Could try to detect encoding, but people should just use utf-8
$content= $self->markdown_to_html($content, %opts)
if $srcfile =~ /[.]md$/;
$change_token= $st->mtime;
}
return wantarray? ($content, $change_token) : $content;
}
sub monitor_source_changes($self, $enable=1) {
if ($enable) {
my $f= $self->slides_source_file;
-f $f or croak "No such file '$f'";
# TODO: wrap inotify in an object with a more convenient API and detect things like file renames
$self->{_inotify} //= do {
require Linux::Inotify2;
my $inotify= Linux::Inotify2->new;
my $i_fh= IO::Handle->new_from_fd($inotify->fileno, 'r');
Mojo::IOLoop->singleton->reactor
->io( $i_fh, sub($reactor, $writable) { $inotify->poll if $inotify && !$writable })
lib/App/SlideServer.pm view on Meta::CPAN
};
Scalar::Util::weaken( my $app= $self );
my $watch= $self->{_inotify}{inotify}->watch("$f", Linux::Inotify2::IN_MODIFY(), sub { $app->build_slides });
$self->slides_source_monitor($watch);
} else {
$self->slides_source_monitor(undef);
}
}
sub markdown_to_html($self, $md, %opts) {
return markdown($md, extensions => (
HOEDOWN_EXT_TABLES | HOEDOWN_EXT_FENCED_CODE | HOEDOWN_EXT_AUTOLINK | HOEDOWN_EXT_STRIKETHROUGH
| HOEDOWN_EXT_UNDERLINE | HOEDOWN_EXT_QUOTE | HOEDOWN_EXT_SUPERSCRIPT | HOEDOWN_EXT_NO_INTRA_EMPHASIS
)
);
}
sub _node_is_slide($self, $node, $tag) {
return $tag eq 'div' && ($node->{class}//'') =~ /\bslide\b/;
}
sub _node_starts_slide($self, $node, $tag) {
return $tag eq 'h1' || $tag eq 'h2' || $tag eq 'h3';
}
sub _node_splits_slide($self, $node, $tag) {
return $tag eq 'hr';
}
sub extract_slides_dom($self, $html, %opts) {
my $dom= Mojo::DOM->new($html);
my @head_tags= qw( head title script link style base meta );
my @move_to_head;
my $slide_root= $dom->at('div.slides') || $dom->at('body') || $dom;
for my $tag (@head_tags) {
for my $el ($slide_root->find("$tag")->each) {
push @move_to_head, $el;
# The markdown processor puts <p> tags on any raw html it wasn't expecting,
my $parent= $el->parent;
$el->remove;
lib/App/SlideServer.pm view on Meta::CPAN
if ($el->tag eq 'head') {
$el->child_nodes->each(sub{ $dom->at('head')->append_content($_) });
} else {
$dom->at('head')->append_content($el);
}
}
return ($dom, @slides);
}
sub merge_page_assets($self, $srcdom, %opts) {
my $page= Mojo::DOM->new($self->share_dir->child('page_template.html')->slurp);
if (my $srchead= $srcdom->at('head')) {
my $pagehead= $page->at('head');
# Prevent conflicting tags (TODO, more...)
if (my $title= $srchead->at('title')) {
$pagehead->at('title')->remove;
}
$pagehead->append_content($_) for $srchead->@*;
}
if (my $srcbody= $srcdom->at('body')) {
lib/App/SlideServer.pm view on Meta::CPAN
$page->at('body')->append_content('<div class="slides"></div>');
}
} else {
$page->at('body')->%*= $srcbody->%*;
}
}
return $page;
}
sub update_published_state($self, @new_attrs) {
$self->published_state->%* = ( $self->published_state->%*, @new_attrs );
$_->send({ json => { state => $self->published_state } })
for values $self->viewers->%*;
}
sub startup($self) {
$self->build_slides;
$self->presenter_key;
$self->static->paths([ $self->serve_dir->child('public'), $self->share_dir->child('public') ]);
$self->routes->get('/' => sub($c){ $c->app->serve_page($c) });
$self->routes->websocket('/slidelink.io' => sub($c){ $c->app->init_slidelink($c) });
}
sub serve_page($self, $c, %opts) {
if (!defined $self->page_dom || $self->cache_token) {
eval { $self->build_slides; 1 }
or $self->log->error($@);
}
# Merge the empty page with all currently-visible slides,
# which saves the client from needing a second request to fetch them.
# TODO: implement slide-by-slide loading
my $slide_max= $#{$self->slides_dom}; # $self->published_state->{slide_max} || 0;
my @slides= $self->slides_dom->@[0..$slide_max];
my $combined= Mojo::DOM->new($self->page_dom);
lib/App/SlideServer.pm view on Meta::CPAN
# If this is for the presenter, set the config variable for that
if ($opts{presenter} || defined $c->req->param('presenter')) {
$combined->at('head')->append_content(
'<script>window.slides.config.mode="presenter";</script>'."\n"
);
}
$c->render(text => ''.$combined);
}
sub init_slidelink($self, $c) {
my $id= $c->req->request_id;
$self->viewers->{$id}= $c;
my $mode= $c->req->param('mode');
my $key= $c->req->param('key');
my %roles= ( follow => 1 );
if ($mode eq 'presenter') {
if (($key||'') eq $self->presenter_key) {
$roles{lead}= 1;
$roles{navigate}= 1;
$self->update_published_state(viewer_count => scalar keys $self->viewers->%*);
lib/App/SlideServer.pm view on Meta::CPAN
$c->send({ json => { roles => [ keys %roles ] } });
$c->on(json => sub($c, $msg, @) { $c->app->on_viewer_message($c, $msg) });
$c->on(finish => sub($c, @) { $c->app->on_viewer_disconnect($c) });
$c->inactivity_timeout(3600);
#my $keepalive= Mojo::IOLoop->recurring(60 => sub { $viewers{$id}->send([1, 0, 0, 0, WS_PING, '']); });
#$c->stash(keepalive => $keepalive);
}
sub on_viewer_message($self, $c, $msg) {
my $id= $c->req->request_id;
$self->log->debug(sprintf "client %s %s msg=%s", $id, $c->tx->original_remote_address//'', $msg//'');
if ($c->stash('roles') =~ /\blead\b/) {
if (defined $msg->{extern}) {
}
if (defined $msg->{slide_num}) {
$self->update_published_state(
slide_num => $msg->{slide_num},
step_num => $msg->{step_num},
($msg->{slide_num} > ($self->published_state->{slide_max}//0)?
( slide_max => $msg->{slide_num} ) : ()
)
);
}
}
# if ($c->stash('roles') =~ /\b
}
sub on_viewer_disconnect($self, $c) {
my $id= $c->req->request_id;
#Mojo::IOLoop->remove($keepalive);
delete $self->viewers->{$id};
$self->update_published_state(viewer_count => scalar keys $self->viewers->%*);
}
sub on_page_changed($self) {
$_->send({ json => { page_changed => 1 } })
for values $self->viewers->%*;
}
sub on_slides_changed($self, $changed) {
my @changes= map +{ idx => $_, html => $self->slides_dom->[$_] }, @$changed;
for my $viewer (values $self->viewers->%*) {
$viewer->send({ json => { slides_changed => \@changes } })
}
}
use Exporter 'import';
our @EXPORT_OK= qw( mojo2logany );
# Utility method to create a Mojo logger that logs to Log::Any
sub mojo2logany($logger= undef) {
require Mojo::Log;
require Log::Any;
if (defined $logger && !ref $logger) {
$logger= Log::Any->get_logger(category => $logger);
} elsif (!defined $logger) {
$logger= Log::Any->get_logger;
}
my $mlog= Mojo::Log->new;
$mlog->unsubscribe('message');
$mlog->on(message => sub($app, $level, @lines) { $logger->$level(join ' ', @lines) });
t/03-unicode.t view on Meta::CPAN
use v5.36;
use utf8;
use Test::More;
use Test::Mojo;
use File::Temp;
use Log::Any::Adapter 'TAP';
use App::SlideServer 'mojo2logany';
my $nanika= chr(0x4F55).chr(0x304B);
sub tempfile_containing($content, @opts) {
my $f= File::Temp->new(@opts);
binmode($f, ':encoding(UTF-8)');
$f->print(@_);
$f->seek(0,0);
$f;
}
my $html= <<~HTML;
<html>
<head><title>Test1</title></head>
( run in 0.653 second using v1.01-cache-2.11-cpan-65fba6d93b7 )