From 5f87ab9069f2361db2642726ce875a03e61313d0 Mon Sep 17 00:00:00 2001
From: Yorhel <git@yorhel.nl>
Date: Wed, 11 Jul 2012 11:33:12 +0200
Subject: [PATCH] Rewrote manfmt to use AnyEvent and moved it to ManUtils

---
 lib/ManUtils/ManUtils.pm | 71 ++++++++++++++++++++++++++++++++++++++++
 www/index.pl             | 59 ++-------------------------------
 2 files changed, 73 insertions(+), 57 deletions(-)

diff --git a/lib/ManUtils/ManUtils.pm b/lib/ManUtils/ManUtils.pm
index 793747f..660829c 100644
--- a/lib/ManUtils/ManUtils.pm
+++ b/lib/ManUtils/ManUtils.pm
@@ -2,11 +2,82 @@ 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) = @_;
+  my $cv = AE::cv;
+  $$output = '';
+  @$errors = ();
+
+  # tix comes with[1] a custom(?) macro package. But it looks okay even without
+  # loading that.
+  # [1] It actually doesn't, the tcllib package appears to have that file, but
+  # doesn't '.so' it.
+  $input =~ s/^\.so man.macros$//mg;
+  # Other .so's should be handled by html()
+  $input =~ s/^\.so (.+)$/\[\[\[MANNEDINCLUDE $1\]\]\]/mg;
+
+  # Disable hyphenation, since that screws up man page references. :-(
+  $input = ".hy 0\n.de hy\n..\n$input";
+
+  $input = encode_utf8($input);
+
+  # Call grog to figure out which preprocessors to use.
+  # $MANWIDTH works by using the following groff options: -rLL=100n -rLT=100n
+  my $grog = run_cmd [qw|grog -Tutf8 -P-c -DUTF-8 -|],
+    '<' => \$input,
+    '>' => \my $cmd,
+    '2>' => sub { $_[0] && push @$errors, "grog: $_[0]" };
+
+  $grog->cb(sub {
+    chomp($cmd);
+    if(!$cmd || $cmd =~ /\n/) {
+      push @$errors, !$cmd ? 'grog failed to produce output' : "Excessive grog output: $cmd";
+      $cv->send;
+      return;
+    }
+
+    my $groff = run_cmd [split / /, $cmd],
+      '<' => \$input,
+      '>' => \my $fmt,
+      '2>' => sub { $_[0] && push @$errors, "groff: $_[0]" };
+
+    $groff->cb(sub {
+      $$output = $fmt ? decode_utf8($fmt) : '';
+      $$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 $_ for @err;
+  $out;
+}
+
+
 1;
 
diff --git a/www/index.pl b/www/index.pl
index 3f1ff37..000d4a1 100755
--- a/www/index.pl
+++ b/www/index.pl
@@ -325,62 +325,6 @@ sub browsepkg {
 }
 
 
-# TODO: Store/cache the result of this of this function in the database.
-sub manfmt {
-  my $c = shift;
-
-  # tix comes with[1] a custom(?) macro package. But it looks okay even without
-  # loading that.
-  # [1] It actually doesn't, the tcllib package appears to have that file, but
-  # doesn't '.so' it.
-  $c =~ s/^\.so man.macros$//mg;
-  # Other .so's should be handled by the web interface
-  $c =~ s/^\.so (.+)$/\[\[\[MANNEDINCLUDE $1\]\]\]/mg;
-
-  # Disable hyphenation, since that screws up man page references. :-(
-  $c = ".hy 0\n.de hy\n..\n$c";
-
-  # Call grog to figure out which preprocessors to use.
-  # $MANWIDTH works by using the following groff options: -rLL=100n -rLT=100n
-  my($out, $in);
-  my $pid = open2($out, $in, qw|grog -Tutf8 -P-c -DUTF-8 -|);
-  binmode $in, ':utf8';
-  print $in $c;
-  close($in);
-  chomp(my $grog = <$out>);
-  waitpid $pid, 0;
-
-  # Call groff
-  $pid = open2($out, $in, split / /, $grog);
-  $c = encode_utf8($c);
-  my $ret;
-  # Read/write the data in chunks to avoid a deadlock on large I/O
-  while($c) {
-    my @a = IO::Select::select(IO::Select->new($out), IO::Select->new($in), undef);
-    die "IO::Select failed: $!\n" if !@a;
-    if(@{$a[0]}) {
-      my $b;
-      my $r = sysread($out, $b, 4096);
-      die "sysread failed: $!\n" if $r < 0;
-      $ret .= $b if $r;
-    }
-    if(@{$a[1]}) {
-      my $w = syswrite($in, $c, 4096);
-      die "syswrite failed: $!\n" if $w <= 0;
-      $c = substr($c, $w);
-    }
-  }
-  close($in);
-  local $/;
-  $ret .= <$out>; # Now I'm mixing sysread and buffered read. I don't suppose that is an issue in this case, though.
-  waitpid $pid, 0;
-
-  $ret = decode_utf8($ret);
-  $ret =~ s/[\t\s\r\n]+$//;
-  return $ret;
-}
-
-
 sub manjslist {
   my($self, $m) = @_;
 
@@ -486,7 +430,8 @@ sub man {
 
   div id => 'contents';
    my $c = $self->dbManContent($man->{hash});
-   pre; lit ManUtils::html(manfmt $c); end;
+   # TODO: Store/cache the result of fmt() in the database.
+   pre; lit ManUtils::html(ManUtils::fmt_block $c); end;
   end;
 
   div id => 'locations';