You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
279 lines
6.5 KiB
Perl
279 lines
6.5 KiB
Perl
#!/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 .= "&"; next; }
|
|
if ($byte eq "<") { $newstr .= "<"; next; }
|
|
if ($byte eq ">") { $newstr .= ">"; next; }
|
|
if ($byte eq "\"") { $newstr .= """; next; }
|
|
if ($byte eq "'") { $newstr .= "'"; 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
|