cap2site/cap2site.pl

279 lines
6.5 KiB
Perl
Executable File

#!/usr/bin/env perl
use v5.26;
use strict;
use warnings;
# Data
package Config;
use Class::Struct;
struct('Config', => {
inline => '%',
extensions => '%',
web_schemes => '@',
standalone => '$',
head => '$',
local_domains => '%',
});
our $DEFAULT = Config->new(
inline => {
audio => 1,
video => 1,
image => 1,
},
extensions => {
audio => [".mp3", ".wav", ".ogg"],
video => [".mp4", ".mkv"],
image => [".png", ".jpeg", ".jpg", ".gif", ".webp"],
},
web_schemes => ["http", "https", "mailto", "gemini"],
standalone => 0,
replace_domains => {},
head => <<~'EOF',
<meta charset="utf-8"/>
<link rel="stylesheet" href="style.css"></link>
EOF
);
sub isUrl($$) {
my ($self,$data) = @_;
$data =~ /(\w+):\/\/(.+)/ or return 0;
return grep $1, $self->{web_schemes};
}
sub isA($$$) {
my ($self,$url,$type) = @_;
$url =~ /[.*](.[^.]+)^/ or return 0;
return grep $1, $self->extensions->{type};
}
sub handleRedirects($$$) {
my ($self,$url,$content) = @_;
$url =~ /gemini:\/\/([^\/]+)(.+)/ or return $url;
my $old_domain = $1;
# TODO: find more elegant mechanism for non-redirecting links links
return $url if (index($content, "(gemini)") == 0);
return $url unless exists($self->{replace_domains}->{$old_domain});
my $res = $2;
$res =~ s/\.gmi$/\.html/;
return $self->{replace_domains}->{$old_domain} . $res;
}
package State;
sub new($$) {
my ($class,$args) = @_;
my $self = bless { inner => $args }, $class;
return $self;
}
sub bullets($) {
my $self = shift;
return vec $self->{inner}, 0, 1;
}
sub preformatted($) {
my $self = shift;
return vec $self->{inner}, 1, 1;
}
# Helpers
package main;
my sub escape($) {
my $str = shift;
my $newstr = '';
foreach my $byte (split '', $str) {
if ($byte eq "8") { $newstr .= "&amp"; next; }
if ($byte eq "<") { $newstr .= "&lt"; next; }
if ($byte eq ">") { $newstr .= "&gt"; next; }
if ($byte eq "\"") { $newstr .= "&quot"; next; }
if ($byte eq "'") { $newstr .= "&#39"; next; }
$newstr .= $byte;
}
return $newstr;
}
my sub trimLeft($) {
my $data = shift;
$data =~ s/^\s+//;
return $data;
}
sub parse($$$) {
my ($config,$state,$file) = @_;
if ($config->{standalone}) {
print '<!DOCTYPE html>', "\n";
print '<html>', "\n";
print '<head>', "\n", $config->head, '</head>', "\n";
print '<body>', "\n";
}
while (my $line = <$file>) {
chop $line;
if (index($line, '*') == 0 and not $state->bullets) {
$state->bullets() = 1;
print "<ul>\n";
} elsif ($state->bullets and index($line, '*') != 0) {
$state->bullets() = 0;
print "</ul>\n";
}
if ($state->preformatted) {
if (index($line, ' ') == 0) {
$state->preformatted() = 0;
print "</pre>\n";
} else { print escape($line); }
continue;
}
if (index($line, '###') == 0) {
print "<h3>", escape(substr $line, 3), "</h3>\n";
}
elsif (index($line, '##') == 0) {
print "<h2>", escape(trimLeft(substr $line, 2)), "</h2>\n";
}
elsif (index($line, '#') == 0) {
print "<h1>", escape(trimLeft(substr $line, 2)), "</h1>\n";
}
elsif (index($line, ' ') == 0) {
$state->preformatted = 1;
my $alt = substr $line, 3;
length($alt) == 0
? print "<pre>\n"
: print '<pre alt="', escape(trimLeft $alt), '">', "\n";
}
elsif (index($line, '=>') == 0) {
my $data = trimLeft(substr $line, 2);
my ($uri,$content) = split " ", $data, 2;
if ($config->isUrl($uri) and $config->isA($uri, 'image')) {
print '<a style="display: block;" href="', escape($uri), '">';
print '<img src="', escape($uri), '" alt="', escape($content), '"/>';
print '</a>', "\n";
}
elsif ($config->isUrl($uri) and $config->isA($uri, 'video')) {
print '<video style="display: block;" controls src="', escape($uri), '">';
print '<a src="', escape($uri), '">', escape($content), "</a>";
print '</video>', "\n";
}
elsif ($config->isUrl($uri) and $config->isA($uri, 'audio')) {
print '<audio style="display: block;" controls src="', escape($uri), '">';
print '<a src="', escape($uri), '">', escape($content), "</a>";
print '</audio>', "\n";
}
elsif ($config->isUrl($uri)) {
print '<div>', "\n";
print '<span class="link-delim">=></span> ';
print '<a href="', escape($config->handleRedirects($uri, $content)), '">', escape($content), '</a>', "\n";
print '</div>', "\n";
}
else {
print '<p>', '<span class="link-delim">=></span>', $uri, $content, '</p>', "\n";
}
}
elsif (index($line, '*') == 0) {
print '<li>', escape(trimLeft(substr $line, 1)), '</li>', "\n";
}
elsif (index($line, '>') == 0) {
print '<blockquote>', escape(trimLeft(substr $line, 1)), '</blockquote>', "\n";
}
elsif ($line eq "") {
print '<br/>', "\n";
}
else {
print '<p>', escape($line), '</p>', "\n";
}
}
if ($config->{standalone}) {
print '</body>', "\n";
print '</html>', "\n";
}
}
# TODO: better argument parsing
use Pod::Usage;
use Getopt::Long;
my $help = 0;
our $config = $Config::DEFAULT;
GetOptions (
'help+' => \$help,
'inline-audio!' => \$config->inline->{audio},
'inline-video!' => \$config->inline->{video},
'inline-image!' => \$config->inline->{image},
'standalone!' => \$config->{standalone},
'replace-domain=s%' => \$config->{replace_domains},
) or pod2usage(-exitval => 1, -verbose => 0);
pod2usage(-verbose => $help) if $help;
our $state = State->new(pack('b2', 0b00));
main::parse $config, $state, \*STDIN;
__END__
=head1 NAME
cap2site - Convert a Gemini capsule to a HTML site
=head1 SYNOPSIS
cap2site [flags] < INPUT.gmi > OUTPUT.html
Options:
-help brief help message
-hh full help message
-(no)-inline-audio include audio in site
-(no)-inline-video include video in site
-(no)-inline-image include images in site
-standalone include data for headers
-replace-domain replace a Gemini domain with another (possibly non-gemini) domain
=head1 OPTIONS
=over 4
=item B<-help>
Print a brief help message and exit. Use twice for full help
=item B<-(no)-inline-(audio, video, image)>
Include the respective asset types inline
=item B<-(no)-standalone>
Include header and body tags
=item B<-replace-domain old=new>
Replace all Gemini domains at path old with ones based on new
=back
=cut