view release on metacpan or  search on metacpan

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

}


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;
	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;
			$parent->remove if $parent && $parent->tag && $parent->tag eq 'p' && $parent =~ m|^<p>\s*</p>|;
		}
	}
	for my $el ($slide_root->find('notes')->each) {
		$el->tag('pre');
		$el->{class}= 'notes';
		my $parent= $el->parent;
		$parent->strip if $parent->tag eq 'p'; # markdown processor adds <p> tags
	}
	
	# Find each element that is an immediate child of body, and add it to
	# the current slide until the next <h1> <h2> <h3> <hr> or <div class="slide">
	# at which point, move to the next slide.
	my (@slides, $cur_slide);
	for my $node ($slide_root->@*) {
		$node->remove;
		my $tag= $node->tag // '';
		# is it a whole pre-defined slide?
		if ($self->_node_is_slide($node, $tag)) {
			$cur_slide= undef;
			push @slides, $node;
		}