view release on metacpan or  search on metacpan

lib/App/SlideServer.pm  view on Meta::CPAN

};


# Hashref of { ID => $context } for every connected websocket
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;
		# Assume markdown unless first non-whitespace is the start of a tag
		$content= $self->markdown_to_html($content, %opts)
			unless $srcfile =~ /^\s*</;
	}
	elsif (ref $srcfile eq 'GLOB' || (ref($srcfile) && ref($srcfile)->isa('IO::Handle'))) {
		return undef
			if defined $opts{if_changed} && (0+$srcfile) .'_'. tell($srcfile) eq $opts{if_changed};
		seek($srcfile, 0, 0) || die "seek: $!"
			unless tell($srcfile) <= 0;
		$content= do { local $/= undef; <$srcfile> };
		utf8::decode($content) unless PerlIO::get_layers($srcfile) =~ /encoding|utf8/i;
		# Assume markdown unless first non-whitespace is the start of a tag
		$content= $self->markdown_to_html($content, %opts)
			unless $srcfile =~ /^\s*</;
		$change_token= (0+$srcfile) .'_'. tell($srcfile);
	}
	else {
		my $st= stat($srcfile)
			or croak "Can't stat '$srcfile'";
		return undef
			if defined $opts{if_changed} && $st->mtime == $opts{if_changed};
		
		$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 })
				->watch($i_fh, 1, 0);
			{ inotify => $inotify, inotify_fh => $i_fh }
		};
		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;