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 $content =~ /^\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 $content =~ /^\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$/i;
		$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);
	}
}


has markdown_processor => \&_build_markdown_processor;
sub _build_markdown_processor {
	if (eval { require Markdown::Perl }) {
		my $mdp= Markdown::Perl->new(mode => 'github', disallowed_html_tags => []);
		return sub { $mdp->convert(shift) };
	} elsif (eval { require Text::Markdown::Hoedown }) {
		my $opts= 0;
		$opts |= Text::Markdown::Hoedown->$_
			for qw( 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 );
		return sub {
			my $html= Text::Markdown::Hoedown::markdown(shift, extensions => $opts);
			# The Hoedown markdown processor puts <p> tags on any raw html it wasn't expecting.
			# We don't want them unless they contain actual content.
			my %not_content= map +($_ => 1), qw( head title script link style base meta );
			my $dom= Mojo::DOM->new($html);
			for my $p ($dom->find('p')->each) {
				# Remove it if the contents do not include printable text
				# or span-type content.
				my $keep= 0;
				for ($p->child_nodes->each) {