#!/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"; } if ($state->preformatted) { if (index($line, ' ') == 0) { $state->preformatted() = 0; print "\n"; } else { print escape($line); } continue; } if (index($line, '###') == 0) { print "

", escape(substr $line, 3), "

\n"; } elsif (index($line, '##') == 0) { print "

", escape(trimLeft(substr $line, 2)), "

\n"; } elsif (index($line, '#') == 0) { print "

", escape(trimLeft(substr $line, 2)), "

\n"; } elsif (index($line, ' ') == 0) { $state->preformatted = 1; my $alt = substr $line, 3; length($alt) == 0 ? 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 '', escape($content), '';
        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";
    }

    elsif (index($line, '>') == 0) {
      print '
    ', escape(trimLeft(substr $line, 1)), '
    ', "\n";
    }

    elsif ($line eq "") {
      print '
    ', "\n";
    }

    else {
      print '
    ', escape($line), '
    ', "\n";
    }
  }

  if ($config->{standalone}) {
    print '', "\n";
    print '', "\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