#!/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', 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 '', "\n"; print '', "\n"; print '
', "\n", $config->head, '', "\n"; print '', "\n"; } while (my $line = <$file>) { chop $line; if (index($line, '*') == 0 and not $state->bullets) { $state->bullets() = 1; print "\n" : print '', "\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 ''; print ''; print '', "\n"; } elsif ($config->isUrl($uri) and $config->isA($uri, 'video')) { print '', "\n"; } elsif ($config->isUrl($uri) and $config->isA($uri, 'audio')) { print '', "\n"; } elsif ($config->isUrl($uri)) { print '', "\n"; print '=> '; print '', escape($content), '', "\n"; print '', "\n"; } else { print '', '=>', $uri, $content, '
', "\n"; } } elsif (index($line, '*') == 0) { print '
', escape(trimLeft(substr $line, 1)), '', "\n"; } else { print '
';
print (length($line) == 0 ? '
' : escape $line);
print '