ManUtils: Move, use ExtUtils::MakeMaker and get rid of AnyEvent

I mean, I like AnyEvent, but this can be done with core modules as well
(albeit somewhat more verbose and error-prone...)
This commit is contained in:
Yorhel 2025-02-24 16:27:07 +01:00
parent 2f33e7f4b5
commit 682321d1be
9 changed files with 92 additions and 106 deletions

8
.gitignore vendored
View file

@ -1,7 +1,7 @@
/lib/ManUtils/* /ManUtils/*
!/lib/ManUtils/Build.PL !/ManUtils/Makefile.PL
!/lib/ManUtils/ManUtils.pm !/ManUtils/ManUtils.pm
!/lib/ManUtils/ManUtils.xs !/ManUtils/ManUtils.xs
indexer/target indexer/target
web/target web/target
util/.config util/.config

View file

@ -3,26 +3,24 @@
all: ManUtils indexer all: ManUtils indexer
ManUtils: lib/ManUtils/inst/lib/perl5/x86_64-linux/ManUtils.pm ManUtils: ManUtils/blib/lib/ManUtils.pm
lib/ManUtils/inst/lib/perl5/x86_64-linux/ManUtils.pm: lib/ManUtils/Build.PL lib/ManUtils/ManUtils.pm lib/ManUtils/ManUtils.xs web/target/release/libweb.a ManUtils/blib/lib/ManUtils.pm: ManUtils/Makefile.PL ManUtils/ManUtils.pm ManUtils/ManUtils.xs web/target/release/libweb.a
-test lib/ManUtils/ManUtils.xs -ot web/target/release/libweb.a && touch -r web/target/release/libweb.a lib/ManUtils/ManUtils.xs -test ManUtils/ManUtils.xs -ot web/target/release/libweb.a && touch -r web/target/release/libweb.a ManUtils/ManUtils.xs
cd lib/ManUtils && perl Build.PL && ./Build install --install-base=inst cd ManUtils && perl Makefile.PL && make
touch lib/ManUtils/inst/lib/perl5/x86_64-linux/ManUtils.pm touch ManUtils/blib/lib/ManUtils.pm
web/target/release/libweb.a: web/Cargo.toml web/src/*.rs web/target/release/libweb.a: web/Cargo.toml web/src/*.rs
cd web && cargo build --release cd web && cargo build --release
#strip --strip-unneeded web/target/release/libweb.a #strip --strip-unneeded web/target/release/libweb.a
indexer: indexer/target/release/indexer indexer: indexer/target/release/indexer
indexer/target/release/indexer: indexer/Cargo.toml indexer/src/*.rs indexer/target/release/indexer: indexer/Cargo.toml indexer/src/*.rs
cd indexer && cargo build --release cd indexer && cargo build --release
clean: clean:
cd lib/ManUtils && ./Build distclean make -C ManUtils clean
rm -rf lib/ManUtils/inst rm -f ManUtils/Makefile.old
cd indexer && cargo clean cd indexer && cargo clean
cd web && cargo clean cd web && cargo clean

10
ManUtils/Makefile.PL Normal file
View file

@ -0,0 +1,10 @@
use ExtUtils::MakeMaker;
WriteMakefile(
NAME => 'ManUtils',
VERSION_FROM => 'ManUtils.pm',
LICENSE => 'mit',
NO_MYMETA => 1,
MIN_PERL_VERSION => 'v5.36',
LDFROM => 'ManUtils.o ../web/target/release/libweb.a -lpthread',
);

68
ManUtils/ManUtils.pm Normal file
View file

@ -0,0 +1,68 @@
package ManUtils 0.2;
use v5.36;
use IPC::Open3;
use IO::Poll qw/POLLOUT POLLIN/;
use Symbol 'gensym';
use XSLoader;
XSLoader::load('ManUtils');
sub fmt($input) {
my @cmd = 'groff';
push @cmd, '-t' if $input =~ /^\.TS/m;
push @cmd, '-e' if $input =~ /^\.EQ/m;
# $MANWIDTH works by using the following groff options: -rLL=100n -rLT=100n
push @cmd, qw/-mandoc -Tutf8 -DUTF-8 -P-c -rLL=80n -rLT=80n -/;
$input =
# Disable hyphenation, since that screws up man page references. :-(
".hy 0\n.de hy\n..\n"
# Emulate man-db's --nj option
.".na\n.de ad\n..\n"
# Unbreak some quotes, there's plenty of man pages that ("incorrectly") use these for code samples.
.".char ` \\`\n"
.".char ' \\[aq]\n"
.$input;
utf8::encode($input);
my $pid = open3(my $in, my $out, my $err = gensym, @cmd);
my $inoff = 0;
my $output = '';
my $poll = IO::Poll->new;
$poll->mask($in => POLLOUT);
$poll->mask($out => POLLIN);
$poll->mask($err => POLLIN);
while (1) {
$poll->poll;
if ($poll->events($in)) {
my $r = syswrite $in, $input, 16*1024, $inoff;
die "Write error: $!\n" if $r <= 0;
$inoff += $r;
if ($inoff == length $input) {
$poll->remove($in);
close $in;
}
}
if ($poll->events($out)) {
my $r = sysread $out, $output, 16*1024, length $output;
die "Read error: $!\n" if $r < 0;
if ($r == 0) {
utf8::decode($output);
waitpid $pid, 0;
die "Groff exited with $?\n" if $?;
return $output =~ s/\s+$//r;
}
}
if ($poll->events($err)) {
my $r = sysread $err, my $buf, 16*1024;
$poll->remove($err) if $r == 0;
warn "GROFF: $buf\n" if $r > 0;
}
}
}
1;

View file

@ -14,7 +14,6 @@ Ironically, documentation about how things work is completely lacking.
### Web front-end ### Web front-end
- FU - FU
- AnyEvent
### Man page indexer ### Man page indexer

View file

@ -1,18 +0,0 @@
#!/usr/bin/perl
use Module::Build;
Module::Build->new(
dist_name => 'ManUtils',
dist_version_from => 'ManUtils.pm',
dist_abstract => 'Utils for manned.org',
license => 'MIT',
extra_linker_flags => '../../web/target/release/libweb.a -lpthread',
pm_files => {
'ManUtils.pm' => 'lib/ManUtils.pm',
},
xs_files => {
'ManUtils.xs' => 'lib/ManUtils.xs',
},
)->create_build_script;

View file

@ -1,67 +0,0 @@
package ManUtils;
use strict;
use warnings;
use AE;
use AnyEvent::Util;
use Encode 'decode_utf8', 'encode_utf8';
our $VERSION = '0.01';
require XSLoader;
XSLoader::load('ManUtils', $VERSION);
# Usage: $cv = fmt($input, \$output, \@errors)
# $cv = AnyEvent condition variable, fired when done.
# $input = UTF-8 encoded manual page source
# $output = variable that will hold the output when done
# @errors = list of warnings/errors while running groff
sub fmt {
my($input, $output, $errors) = @_;
$$output = '';
@$errors = ();
my @cmd = 'groff';
push @cmd, '-t' if $input =~ /^\.TS/m;
push @cmd, '-e' if $input =~ /^\.EQ/m;
# $MANWIDTH works by using the following groff options: -rLL=100n -rLT=100n
push @cmd, qw/-mandoc -Tutf8 -DUTF-8 -P-c -rLL=80n -rLT=80n -/;
$input =
# Disable hyphenation, since that screws up man page references. :-(
".hy 0\n.de hy\n..\n"
# Emulate man-db's --nj option
.".na\n.de ad\n..\n"
# Unbreak some quotes, there's plenty of man pages that ("incorrectly") use these for code samples.
.".char ` \\`\n"
.".char ' \\[aq]\n"
.encode_utf8($input);
my $groff = run_cmd \@cmd,
'<' => \$input,
'>' => $output,
'2>' => sub { if($_[0]) { chomp(my $e = $_[0]); push @$errors, "groff: $e" } };
my $cv = AE::cv;
$groff->cb(sub {
decode_utf8 $$output;
$$output =~ s/[\t\s\r\n]+$//;
$cv->send;
});
$cv
}
# Blocking version of fmt(). Returns the formatted man page, errors are
# forwarded to warn().
sub fmt_block {
my $c = shift;
my $cv = fmt $c, \my $out, \my @err;
$cv->recv;
#warn "$_\n" for @err;
$out;
}
1;

View file

@ -13,11 +13,7 @@ use Cwd 'abs_path';
our $ROOT; our $ROOT;
BEGIN { ($ROOT = abs_path $0) =~ s{/www/index\.pl$}{}; } BEGIN { ($ROOT = abs_path $0) =~ s{/www/index\.pl$}{}; }
# Force the pure-perl AnyEvent backend; More lightweight and we don't need the use lib "$ROOT/ManUtils/blib/lib", "$ROOT/ManUtils/blib/arch";
# performance of EV.
BEGIN { $ENV{PERL_ANYEVENT_MODEL} = 'Perl'; }
use lib "$ROOT/lib/ManUtils/inst/lib/perl5";
use ManUtils; use ManUtils;
@ -740,7 +736,7 @@ sub man_page($man, $url) {
fu->done; fu->done;
} }
my $fmt = ManUtils::html ManUtils::fmt_block soelim $man->{verid}, $content; my $fmt = ManUtils::html ManUtils::fmt soelim $man->{verid}, $content;
if($url->{fmt} eq 'txt') { if($url->{fmt} eq 'txt') {
# TODO: The 'txt' format is kind of broken right now as it includes our HTML formatting codes. # TODO: The 'txt' format is kind of broken right now as it includes our HTML formatting codes.
# This feature is a WIP and not advertised at the moment, anyway. # This feature is a WIP and not advertised at the moment, anyway.
@ -981,7 +977,7 @@ FU::get qr{/pkg/([^/]+)/(.+)} => sub($short, $path) {
FU::get qr{/browse/(.+)} => sub($pkg) { fu->redirect(perm => "/pkg/$pkg") }; FU::get qr{/browse/(.+)} => sub($pkg) { fu->redirect(perm => "/pkg/$pkg") };
# Redirect for the system selection box, for visitors who have disabled JS. # Redirect for the system selection box, for visitors who have disabled JS.
FU::get qr{/sysredir/([^/]+)} => sub($path) { fu->redirect(temp => '/man/'.(fu->query('system')//'arch')."/$path", 'temp') }; FU::get qr{/sysredir/([^/]+)} => sub($path) { fu->redirect(temp => '/man/'.(fu->query('system')//'arch')."/$path") };
# Redirect for a specific language for a man page. I have no idea if anyone # Redirect for a specific language for a man page. I have no idea if anyone
# still uses this URL format, but it was supported at some point, so let's keep # still uses this URL format, but it was supported at some point, so let's keep