From: Harlan Stenn Date: Sun, 7 Jun 2015 06:16:41 +0000 (+0000) Subject: [Bug 2842] Bug in mdoc2man X-Git-Tag: NTP_4_3_36~4^2 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=e1e4f8687cbb82bbff1b8ac51593d9bf13c08ba3;p=thirdparty%2Fntp.git [Bug 2842] Bug in mdoc2man bk: 5573e1c9mq3PAn8Anoi9WZ8TUQtZtA --- diff --git a/ChangeLog b/ChangeLog index 032fb2da6..dc0484099 100644 --- a/ChangeLog +++ b/ChangeLog @@ -11,6 +11,7 @@ * [Bug 2837] Allow a configurable DSCP value. * [Bug 2837] add test for DSCP to ntpd/complete.conf.in * [Bug 2842] Glitch in ntp.conf.def documentation stanza. +* [Bug 2842] Bug in mdoc2man. * Report select() debug messages at debug level 3 now. --- (4.2.8p3-RC1) 2015/05/12 Released by Harlan Stenn diff --git a/sntp/ag-tpl/Mdoc.pm b/sntp/ag-tpl/Mdoc.pm new file mode 100644 index 000000000..549454f0f --- /dev/null +++ b/sntp/ag-tpl/Mdoc.pm @@ -0,0 +1,542 @@ +=begin comment + +## Mdoc.pm -- Perl functions for mdoc processing +## +## Author: Oliver Kindernay (GSoC project for NTP.org) +## +## +## This file is part of AutoOpts, a companion to AutoGen. +## AutoOpts is free software. +## AutoOpts is Copyright (C) 1992-2015 by Bruce Korb - all rights reserved +## +## AutoOpts is available under any one of two licenses. The license +## in use must be one of these two and the choice is under the control +## of the user of the license. +## +## The GNU Lesser General Public License, version 3 or later +## See the files "COPYING.lgplv3" and "COPYING.gplv3" +## +## The Modified Berkeley Software Distribution License +## See the file "COPYING.mbsd" +## +## These files have the following sha256 sums: +## +## 8584710e9b04216a394078dc156b781d0b47e1729104d666658aecef8ee32e95 COPYING.gplv3 +## 4379e7444a0e2ce2b12dd6f5a52a27a4d02d39d247901d3285c88cf0d37f477b COPYING.lgplv3 +## 13aa749a5b0a454917a944ed8fffc530b784f5ead522b1aacaf4ec8aa55a6239 COPYING.mbsd +=end comment +=head1 NAME + +Mdoc - perl module to parse Mdoc macros + +=head1 SYNOPSIS + + use Mdoc qw(ns pp soff son stoggle mapwords); + +See mdoc2man and mdoc2texi for code examples. + +=head1 FUNCTIONS + +=over 4 + +=item def_macro( NAME, CODE, [ raw => 1, greedy => 1, concat_until => '.Xx' ] ) + +Define new macro. The CODE reference will be called by call_macro(). You can +have two distinct definitions for and inline macro and for a standalone macro +(i. e. 'Pa' and '.Pa'). + +The CODE reference is passed a list of arguments and is expected to return list +of strings and control characters (see C). + +By default the surrouding "" from arguments to macros are removed, use C +to disable this. + +Normaly CODE reference is passed all arguments up to next nested macro. Set +C to to pass everything up to the end of the line. + +If the concat_until is present, the line is concated until the .Xx macro is +found. For example the following macro definition + + def_macro('.Oo', gen_encloser(qw([ ]), concat_until => '.Oc' } + def_macro('.Cm', sub { mapwords {'($_)'} @_ } } + +and the following input + + .Oo + .Cm foo | + .Cm bar | + .Oc + +results in [(foo) | (bar)] + +=item get_macro( NAME ) + +Returns a hash reference like: + + { run => CODE, raw => [1|0], greedy => [1|0] } + +Where C is the CODE reference used to define macro called C + +=item parse_line( INPUT, OUTPUT_CODE, PREPROCESS_CODE ) + +Parse a line from the C filehandle. If a macro was detected it returns a +list (MACRO_NAME, @MACRO_ARGS), otherwise it calls the C, giving +caller a chance to modify line before printing it. If C is +defined it calls it prior to passing argument to a macro, giving caller a +chance to alter them. if EOF was reached undef is returned. + +=item call_macro( MACRO, ARGS, ... ) + +Call macro C with C. The CODE reference for macro C is +called and for all the nested macros. Every called macro returns a list which +is appended to return value and returned when all nested macros are processed. +Use to_string() to produce a printable string from the list. + +=item to_string ( LIST ) + +Processes C returned from call_macro() and returns formatted string. + +=item mapwords BLOCK ARRAY + +This is like perl's map only it calls BLOCK only on elements which are not +punctuation or control characters. + +=item space ( ['on'|'off] ) + +Turn spacing on or off. If called without argument it returns the current state. + +=item gen_encloser ( START, END ) + +Helper function for generating macros that enclose their arguments. + gen_encloser(qw({ })); +returns + sub { '{', ns, @_, ns, pp('}')} + +=item set_Bl_callback( CODE , DEFS ) + +This module implements the Bl/El macros for you. Using set_Bl_callback you can +provide a macro definition that should be executed on a .Bl call. + +=item set_El_callback( CODE , DEFS ) + +This module implements the Bl/El macros for you. Using set_El_callback you can +provide a macro definition that should be executed on a .El call. + +=item set_Re_callback( CODE ) + +The C is called after a Rs/Re block is done. With a hash reference as a +parameter, describing the reference. + +=back + +=head1 CONSTANTS + +=over 4 + +=item ns + +Indicate 'no space' between to members of the list. + +=item pp ( STRING ) + +The string is 'punctuation point'. It means that every punctuation +preceeding that element is put behind it. + +=item soff + +Turn spacing off. + +=item son + +Turn spacing on. + +=item stoggle + +Toogle spacing. + +=item hs + +Print space no matter spacing mode. + +=back + +=head1 TODO + +* The concat_until only works with standalone macros. This means that + .Po blah Pc +will hang until .Pc in encountered. + +* Provide default macros for Bd/Ed + +* The reference implementation is uncomplete + +=cut + +package Mdoc; +use strict; +use warnings; +use List::Util qw(reduce); +use Text::ParseWords qw(quotewords); +use Carp; +use Exporter qw(import); +our @EXPORT_OK = qw(ns pp soff son stoggle hs mapwords gen_encloser nl); + +use constant { + ns => ['nospace'], + soff => ['spaceoff'], + son => ['spaceon'], + stoggle => ['spacetoggle'], + hs => ['hardspace'], +}; + +sub pp { + my $c = shift; + return ['pp', $c ]; +} +sub gen_encloser { + my ($o, $c) = @_; + return sub { ($o, ns, @_, ns, pp($c)) }; +} + +sub mapwords(&@) { + my ($f, @l) = @_; + my @res; + for my $el (@l) { + local $_ = $el; + push @res, $el =~ /^(?:[,\.\{\}\(\):;\[\]\|])$/ || ref $el eq 'ARRAY' ? + $el : $f->(); + } + return @res; +} + +my %macros; + +############################################################################### + +# Default macro definitions start + +############################################################################### + +def_macro('Xo', sub { @_ }, concat_until => '.Xc'); + +def_macro('.Ns', sub {ns, @_}); +def_macro('Ns', sub {ns, @_}); + +{ + my %reference; + def_macro('.Rs', sub { () } ); + def_macro('.%A', sub { + if ($reference{authors}) { + $reference{authors} .= " and @_" + } + else { + $reference{authors} = "@_"; + } + return (); + }); + def_macro('.%T', sub { $reference{title} = "@_"; () } ); + def_macro('.%O', sub { $reference{optional} = "@_"; () } ); + + sub set_Re_callback { + my ($sub) = @_; + croak 'Not a CODE reference' if not ref $sub eq 'CODE'; + def_macro('.Re', sub { + my @ret = $sub->(\%reference); + %reference = (); @ret + }); + return; + } +} + +def_macro('.Bl', sub { die '.Bl - no list callback set' }); +def_macro('.It', sub { die ".It called outside of list context - maybe near line $." }); +def_macro('.El', sub { die '.El requires .Bl first' }); + + +{ + my $elcb = sub { () }; + + sub set_El_callback { + my ($sub) = @_; + croak 'Not a CODE reference' if ref $sub ne 'CODE'; + $elcb = $sub; + return; + } + + sub set_Bl_callback { + my ($blcb, %defs) = @_; + croak 'Not a CODE reference' if ref $blcb ne 'CODE'; + def_macro('.Bl', sub { + + my $orig_it = get_macro('.It'); + my $orig_el = get_macro('.El'); + my $orig_bl = get_macro('.Bl'); + my $orig_elcb = $elcb; + + # Restore previous .It and .El on each .El + def_macro('.El', sub { + def_macro('.El', delete $orig_el->{run}, %$orig_el); + def_macro('.It', delete $orig_it->{run}, %$orig_it); + def_macro('.Bl', delete $orig_bl->{run}, %$orig_bl); + my @ret = $elcb->(@_); + $elcb = $orig_elcb; + @ret + }); + $blcb->(@_) + }, %defs); + return; + } +} + +def_macro('.Sm', sub { + my ($arg) = @_; + if (defined $arg) { + space($arg); + } else { + space() eq 'off' ? + space('on') : + space('off'); + } + () +} ); +def_macro('Sm', do { my $off; sub { + my ($arg) = @_; + if (defined $arg && $arg =~ /^(on|off)$/) { + shift; + if ($arg eq 'off') { soff, @_; } + elsif ($arg eq 'on') { son, @_; } + } + else { + stoggle, @_; + } +}} ); + +############################################################################### + +# Default macro definitions end + +############################################################################### + +sub def_macro { + croak 'Odd number of elements for hash argument <'.(scalar @_).'>' if @_%2; + my ($macro, $sub, %def) = @_; + croak 'Not a CODE reference' if ref $sub ne 'CODE'; + + $macros{ $macro } = { + run => $sub, + greedy => delete $def{greedy} || 0, + raw => delete $def{raw} || 0, + concat_until => delete $def{concat_until}, + }; + if ($macros{ $macro }{concat_until}) { + $macros{ $macros{ $macro }{concat_until} } = { run => sub { @_ } }; + $macros{ $macro }{greedy} = 1; + } + return; +} + +sub get_macro { + my ($macro) = @_; + croak "Macro <$macro> not defined" if not exists $macros{ $macro }; + +{ %{ $macros{ $macro } } } +} + +#TODO: document this +sub parse_opts { + my %args; + my $last; + for (@_) { + if ($_ =~ /^\\?-/) { + s/^\\?-//; + $args{$_} = 1; + $last = _unquote($_); + } + else { + $args{$last} = _unquote($_) if $last; + undef $last; + } + } + return %args; +} + +sub _is_control { + my ($el, $expected) = @_; + if (defined $expected) { + ref $el eq 'ARRAY' and $el->[0] eq $expected; + } + else { + ref $el eq 'ARRAY'; + } +} + +{ + my $sep = ' '; + + sub to_string { + if (@_ > 0) { + # Handle punctunation + my ($in_brace, @punct) = ''; + my @new = map { + if (/^([\[\(])$/) { + ($in_brace = $1) =~ tr/([/)]/; + $_, ns + } + elsif (/^([\)\]])$/ && $in_brace eq $1) { + $in_brace = ''; + ns, $_ + } + elsif ($_ =~ /^[,\.;:\?\!\)\]]$/) { + push @punct, ns, $_; + (); + } + elsif (_is_control($_, 'pp')) { + $_->[1] + } + elsif (_is_control($_)) { + $_ + } + else { + splice (@punct), $_; + } + } @_; + push @new, @punct; + + # Produce string out of an array dealing with the special control characters + # space('off') must but one character delayed + my ($no_space, $space_off) = 1; + my $res = ''; + while (defined(my $el = shift @new)) { + if (_is_control($el, 'hardspace')) { $no_space = 1; $res .= ' ' } + elsif (_is_control($el, 'nospace')) { $no_space = 1; } + elsif (_is_control($el, 'spaceoff')) { $space_off = 1; } + elsif (_is_control($el, 'spaceon')) { space('on'); } + elsif (_is_control($el, 'spacetoggle')) { space() eq 'on' ? + $space_off = 1 : + space('on') } + else { + if ($no_space) { + $no_space = 0; + $res .= "$el" + } + else { + $res .= "$sep$el" + } + + if ($space_off) { space('off'); $space_off = 0; } + } + } + $res + } + else { + ''; + } + } + + sub space { + my ($arg) = @_; + if (defined $arg && $arg =~ /^(on|off)$/) { + $sep = ' ' if $arg eq 'on'; + $sep = '' if $arg eq 'off'; + return; + } + else { + return $sep eq '' ? 'off' : 'on'; + } + } +} + +sub _unquote { + my @args = @_; + $_ =~ s/^"([^"]+)"$/$1/g for @args; + wantarray ? @args : $args[0]; +} + +sub call_macro { + my ($macro, @args) = @_; + my @ret; + + my @newargs; + my $i = 0; + + @args = _unquote(@args) if (!$macros{ $macro }{raw}); + + # Call any callable macros in the argument list + for (@args) { + if ($_ =~ /^[A-Z][a-z]+$/ && exists $macros{ $_ }) { + push @ret, call_macro($_, @args[$i+1 .. $#args]); + last; + } else { + if ($macros{ $macro }{greedy}) { + push @ret, $_; + } + else { + push @newargs, $_; + } + } + $i++; + } + + if ($macros{ $macro }{concat_until}) { + my ($n_macro, @n_args) = (''); + while (1) { + die "EOF was reached and no $macros{ $macro }{concat_until} found" + if not defined $n_macro; + ($n_macro, @n_args) = parse_line(undef, sub { push @ret, shift }); + if ($n_macro eq $macros{ $macro }{concat_until}) { + push @ret, call_macro($n_macro, @n_args); + last; + } + else { + $n_macro =~ s/^\.//; + push @ret, call_macro($n_macro, @n_args) if exists $macros{ $n_macro }; + } + } + } + + if ($macros{ $macro }{greedy}) { + #print "MACROG $macro (", (join ', ', @ret), ")\n"; + return $macros{ $macro }{run}->(@ret); + } + else { + #print "MACRO $macro (", (join ', ', @newargs), ")".(join ', ', @ret)."\n"; + return $macros{ $macro }{run}->(@newargs), @ret; + } +} + +{ + my ($in_fh, $out_sub, $preprocess_sub); + sub parse_line { + $in_fh = $_[0] if defined $_[0] || !defined $in_fh; + $out_sub = $_[1] if defined $_[1] || !defined $out_sub; + $preprocess_sub = $_[2] if defined $_[2] || !defined $preprocess_sub; + + croak 'out_sub not a CODE reference' + if not ref $out_sub eq 'CODE'; + croak 'preprocess_sub not a CODE reference' + if defined $preprocess_sub && not ref $preprocess_sub eq 'CODE'; + + while (my $line = <$in_fh>) { + chomp $line; + if ($line =~ /^\.[A-z][a-z0-9]+/ || $line =~ /^\.%[A-Z]/ || + $line =~ /^\.\\"/) + { + $line =~ s/ +/ /g; + my ($macro, @args) = quotewords(' ', 1, $line); + @args = grep { defined $_ } @args; + $preprocess_sub->(@args) if defined $preprocess_sub; + if ($macro && exists $macros{ $macro }) { + return ($macro, @args); + } else { + $out_sub->($line); + } + } + else { + $out_sub->($line); + } + } + return; + } +} + +1; +__END__ diff --git a/sntp/ag-tpl/mdoc2man b/sntp/ag-tpl/mdoc2man new file mode 100755 index 000000000..305fab07b --- /dev/null +++ b/sntp/ag-tpl/mdoc2man @@ -0,0 +1,219 @@ +#! /usr/local/bin/perl + +## mdoc2man.pl -- Convert mdoc tags to man tags +## +## Author: Harlan Stenn +## +## +## This file is part of AutoOpts, a companion to AutoGen. +## AutoOpts is free software. +## AutoOpts is Copyright (C) 1992-2015 by Bruce Korb - all rights reserved +## +## AutoOpts is available under any one of two licenses. The license +## in use must be one of these two and the choice is under the control +## of the user of the license. +## +## The GNU Lesser General Public License, version 3 or later +## See the files "COPYING.lgplv3" and "COPYING.gplv3" +## +## The Modified Berkeley Software Distribution License +## See the file "COPYING.mbsd" +## +## These files have the following sha256 sums: +## +## 8584710e9b04216a394078dc156b781d0b47e1729104d666658aecef8ee32e95 COPYING.gplv3 +## 4379e7444a0e2ce2b12dd6f5a52a27a4d02d39d247901d3285c88cf0d37f477b COPYING.lgplv3 +## 13aa749a5b0a454917a944ed8fffc530b784f5ead522b1aacaf4ec8aa55a6239 COPYING.mbsd + +### ToDo +# Properly implement -columns in the "my %lists" definition... +# +# .Xr requires at least 1 arg, the code here expects at least 2 +# +### + +package mdoc2man; +use strict; +use warnings; +use File::Basename; +use lib dirname(__FILE__); +use Mdoc qw(hs ns pp mapwords son soff stoggle gen_encloser); + +######## +## Basic +######## + +Mdoc::def_macro( '.Sh', sub { '.SH', hs, @_ }, raw => 1); +Mdoc::def_macro( '.Ss', sub { '.SS', hs, @_ }, raw => 1); +Mdoc::def_macro( '.Pp', sub { ".sp \\n(Ppu\n.ne 2\n" } ); +Mdoc::def_macro( '.Nd', sub { "\\- @_" } ); + +# Macros that enclose things +Mdoc::def_macro( '.Brq', gen_encloser(qw({ })) , greedy => 1 ); +Mdoc::def_macro( '.Op' , gen_encloser(qw([ ])) , greedy => 1 ); +Mdoc::def_macro( '.Qq' , gen_encloser(qw(" ")) , greedy => 1 ); +Mdoc::def_macro( '.Dq' , gen_encloser(qw(\*[Lq] \*[Rq])), greedy => 1 ); +Mdoc::def_macro( '.Ql' , gen_encloser(qw(\[oq] \[cq])) , greedy => 1 ); +Mdoc::def_macro( '.Sq' , gen_encloser(qw(\[oq] \[cq])) , greedy => 1 ); +Mdoc::def_macro( '.Pq' , gen_encloser(qw/( )/) , greedy => 1 ); +Mdoc::def_macro( '.D1' , sub { ".in +4\n", ns, @_ , ns , "\n.in -4" } , greedy => 1); + +Mdoc::def_macro( 'Oo', sub { '[', @_ } ); +Mdoc::def_macro( 'Oc', sub { ']', @_ } ); + +Mdoc::def_macro( 'Po', sub { '(', @_} ); +Mdoc::def_macro( 'Pc', sub { ')', @_ } ); + +Mdoc::def_macro( 'Bro', sub { '{', ns, @_ } ); +Mdoc::def_macro( 'Brc', sub { '}', @_ } ); + +Mdoc::def_macro( '.Oo', gen_encloser(qw([ ])), concat_until => '.Oc' ); +Mdoc::def_macro( '.Bro', gen_encloser(qw({ })), concat_until => '.Brc' ); +Mdoc::def_macro( '.Po', gen_encloser(qw/( )/), concat_until => '.Pc' ); + +Mdoc::def_macro( '.Ev', sub { @_ } ); +Mdoc::def_macro( '.An', sub { ".NOP ", @_, "\n.br" }, raw => 1 ); +Mdoc::def_macro( '.Li', sub { mapwords {"\\f[C]$_\\f[]"} @_ } ); +Mdoc::def_macro( '.Cm', sub { mapwords {"\\f\\*[B-Font]$_\\f[]"} @_ } ); +Mdoc::def_macro( '.Ic', sub { mapwords {"\\f\\*[B-Font]$_\\f[]"} @_ } ); +Mdoc::def_macro( '.Fl', sub { mapwords {"\\f\\*[B-Font]\\-$_\\f[]"} @_ } ); +Mdoc::def_macro( '.Ar', sub { mapwords {"\\f\\*[I-Font]$_\\f[]"} @_ } ); +Mdoc::def_macro( '.Em', sub { mapwords {"\\fI$_\\f[]"} @_ } ); +Mdoc::def_macro( '.Va', sub { mapwords {"\\fI$_\\f[]"} @_ } ); +Mdoc::def_macro( '.Sx', sub { mapwords {"\\fI$_\\f[]"} @_ } ); +Mdoc::def_macro( '.Xr', sub { "\\fC".(shift)."\\f[]\\fR(".(shift).")\\f[]", @_ } ); +Mdoc::def_macro( '.Fn', sub { "\\f\\*[B-Font]".(shift)."\\f[]\\fR()\\f[]" } ); +Mdoc::def_macro( '.Fn', sub { "\\fB".(shift)."\\f[]\\fR()\\f[]" } ); +Mdoc::def_macro( '.Fx', sub { "FreeBSD", @_ } ); +Mdoc::def_macro( '.Ux', sub { "UNIX", @_ } ); + +Mdoc::def_macro( '.No', sub { ".NOP", map { ($_, ns) } @_ } ); +Mdoc::def_macro( '.Pa', sub { mapwords {"\\fI$_\\f[]"} @_; } ); +{ + my $name; + Mdoc::def_macro('.Nm', sub { + $name = shift if (!$name); + "\\f\\*[B-Font]$name\\fP", @_ + } ); +} + +######## +## lists +######## + +my %lists = ( + bullet => sub { + Mdoc::def_macro('.It', sub { '.IP \fB\(bu\fP 2' }); + }, + + column => sub { + Mdoc::def_macro('.It', sub { '.IP \fB\(bu\fP 2' }); + }, + + tag => sub { + my (%opts) = @_; + + my $width = ''; + + if (exists $opts{width}) { + $width = ' '.((length $opts{width})+1); + } + + if (exists $opts{compact}) { + my $dobrns = 0; + Mdoc::def_macro('.It', sub { + my @ret = (".TP$width\n.NOP", hs); + if ($dobrns) { + ".br\n.ns\n", ns, @ret, @_; + } + else { + $dobrns = 1; + @ret, @_; + } + }, raw => 1); + } + else { + Mdoc::def_macro('.It', sub { + ".TP$width\n.NOP", hs, @_ + }, raw => 1); + } + }, +); + +Mdoc::set_Bl_callback(do { my $nested = 0; sub { + my $type = shift; + my %opts = Mdoc::parse_opts(@_); + if (defined $type && $type =~ /-(\w+)/ && exists $lists{$1}) { + + # Wrap nested lists with .RS and .RE + Mdoc::set_El_callback(sub { + return '.RE' if $nested-- > 1; + return '.PP'; + }); + + $lists{$1}->(%opts); + + if ($nested++) { + return ".RS"; + } + else { + return (); + } + } + else { + die "Invalid list type <$type>"; + } +}}, raw => 1); + +# don't bother with arguments for now and do what mdoc2man'.sh' did + +Mdoc::def_macro('.Bd', sub { ".br\n.in +4\n.nf" } ); +Mdoc::def_macro('.Ed', sub { ".in -4\n.fi" } ); + +Mdoc::set_Re_callback(sub { + my ($reference) = @_; + <<"REF"; +$reference->{authors}, +\\fI$reference->{title}\\fR, +$reference->{optional}\n.PP +REF +}); + +# Define all macros which have the same sub for inline and standalone macro +for (qw(Xr Em Ar Fl Ic Cm Qq Op Nm Pa Sq Li Va Brq Pq Fx Ux)) { + my $m = Mdoc::get_macro(".$_"); + Mdoc::def_macro($_, delete $m->{run}, %$m); +} + +sub print_line { + print shift; + print "\n"; +} + +sub run { + print <<'DEFS'; +.de1 NOP +. it 1 an-trap +. if \\n[.$] \,\\$*\/ +.. +.ie t \ +.ds B-Font [CB] +.ds I-Font [CI] +.ds R-Font [CR] +.el \ +.ds B-Font B +.ds I-Font I +.ds R-Font R +DEFS + + while (my ($macro, @args) = Mdoc::parse_line(\*STDIN, \&print_line)) { + my @ret = Mdoc::call_macro($macro, @args); + print_line(Mdoc::to_string(@ret)) if @ret; + } + return 0; +} + +exit run(@ARGV) unless caller; + +1; +__END__