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 )