#! /usr/bin/perl
use warnings;
use strict;
use integer;
use FindBin;
use lib $FindBin::RealBin;
use Def;

# (This script may be obsolete.)
#
# This script generates an appropriate README from the following listed
# sections of the manpage.  It clobbers the existing README.
#
# (This highly specialized helper script is perhaps the result of
# overenthusiasm.  It automates an otherwise slightly annoying
# package-maintenance task, but in retrospect it is not clear that the
# effort spent in writing the script justifies the gain.  Nevertheless,
# I like the script.  Here it is.  ---THB---)
#
# (By the way, I thought about extending the script to autogenerate the
# long description in debian/control.  However, overenthusiasm has
# bounds.  The long description is twenty times as important as the
# README.  It merits manual crafting.  But maybe we should generate the
# manpage "SUMMARY" section from the long description?  No, not
# today.  ---THB---)
#
# The Makefile and debian/rules probably should not invoke this script.
# Probably only the developer should invoke it, manually, if and when he
# wants to.
#
# As a developer, you do not need to use this script.  You can write
# your own README if you want to.  The only reason the script exists is
# that the author couldn't really think of anything at the moment to
# write in the README which wasn't already in the manpage, but if you
# can think of something else to write there, go right ahead.  However,
# if you do use this script and if you modify it, note the "Make special
# corrections" block below.
#
# One possible use of this script is to autogenerate a candidate README
# which you then manually edit.

# Relevant manpage sections.
our @sh = (
  'DESCRIPTION',
  'READING THE BOOK',
  'AUTHOR',
);

our $marker        = "\001";
our $headlead_trad = 'The Debian Package';
our $mark_lic      = qr/^Copyright\s+\(C\)/;
our $time_dflt     = '00:00:00 +0000';
our $cmd_date      = 'date -uRd';
our $cmd_fmt       = "fmt -w${Def::width} -u";
our $cmd_tempfile  = 'tempfile';

my $manpage  = "${FindBin::RealBin}/../doc/${Def::out}.${Def::mansect}";
my $deb_cprt = "${FindBin::RealBin}/../debian/copyright";
my $readme   = "${FindBin::RealBin}/../${Def::name_readme}";
my $bar      = '-' x ${Def::width} ."\n";
my $mp_date;
my $mp_author;
my $mp_title;

# Subroutine: splice lines ending in backslash-newline.
sub splice_lines (;\@) {
  local $_ = @_ ? shift : \$_;
  for my $i ( reverse 0 .. $#$_ ) {
    chomp $_->[$i];
    next unless $_->[$i] =~ /\\$/;
    chop  $_->[$i];
    splice @$_, $i, 2, $_->[$i] . $_->[$i+1] . "\n" if $i < $#$_;
  }
  $_ .= "\n" for @$_;
  return $_;
}

our @escape_save = ();
# Subroutines: recognize, convert, save and restore escaped characters.
sub escape (;\$) {
  local $_ = @_ ? shift : \$_;
  @escape_save = ();
  $$_ =~ /$marker/ and die "$0: marker character is reserved\n";
  my $ends_newline = $$_ =~ /\n\z/;
  chomp $$_;
  {
    my $i;
    while ( ( $i = index $$_, '\\' ) >= 0 ) {
      substr( $$_, $i, 5 ) =~ /^\\\*\(/
        and push( @escape_save, substr( $$_, $i, 5, $marker ) ), next;
      substr( $$_, $i, 4 ) =~ /^\\\(/
        and push( @escape_save, substr( $$_, $i, 4, $marker ) ), next;
      push( @escape_save, substr( $$_, $i, 2, $marker ) );
    }
  }
  $$_ .= "\n" if $ends_newline;
  return $$_;
}
sub convescape () {
  for ( @escape_save ) {
    $_ =~ /^\\&$/       and $_ = ''   , next;
    $_ =~ /^\\-$/       and $_ = '-'  , next;
    $_ =~ /^\\\(em$/i   and $_ = '---', next;
    $_ =~ /^\\\*\(lq$/i and $_ = '"'  , next;
    $_ =~ /^\\\*\(rq$/i and $_ = '"'  , next;
  }
}
sub unescape (;\$) {
  local $_ = @_ ? shift : \$_;
  while ( @escape_save ) {
    my $c = shift @escape_save;
    $$_ =~ s/$marker/$c/;
  }
  @escape_save = ();
  return $$_;
}
sub convall (;\$) {
  local $_ = @_ ? shift : \$_;
  defined $$_ or return $$_;
  escape   $$_;
  convescape  ;
  unescape $$_;
  return   $$_;
}

# Subroutine: dequote a quoted string.
sub dequote (;\$) {
  local $_ = @_ ? shift : \$_;
  chomp    $$_;
  escape   $$_;
  $$_ =~ s/^\s*"([^"]*?)"\s*$/$1/;
  unescape $$_;
  return   $$_;
}

# Subroutine: collapse an alternating emphasizor.
sub collapse (;\$) {
  local $_ = @_ ? shift : \$_;
  chomp    $$_;
  escape   $$_;
  my @w = $$_ =~ /"[^"]*?"|[^"\s]+/g;
  dequote for @w;
  $$_ = join( '', @w );
  unescape $$_;
  return   $$_;
}

# Subroutine: format text to a maximum width.
sub format_text (@) {
  my $file = `$cmd_tempfile`; chomp $file;
  open  FILE, '>', $file;
    print FILE @_;
  close FILE;
  my @ret = `$cmd_fmt $file`;
  unlink $file;
  return @ret;
}

# Read the manpage in.
my @man;
open  MAN, '<', $manpage;
  @man = <MAN>;
close MAN;
splice_lines @man;

# Parse the manpage.
my %sect;
{
  my $sh;
  my $text = [];
  for ( @man ) {
    next unless /\S/;
    my( $cmd, $arg ) = /^\.(\S+)(?:\s+(\S(?:.*?\S)??))??\s*$/;
    if ( defined $cmd ) {
      if    ( $cmd =~ /^(?:B|I)$/i ) {
        dequote       $arg;
        $_         = "$arg\n";
        $cmd       = undef;
      }
      elsif ( $cmd =~ /^(?:BR|RB|IR|RI|BI|IB)$/i ) {
        collapse      $arg;
        $_         = "$arg\n";
        $cmd       = undef;
      }
      elsif ( $cmd =~ /^TH$/i ) {
        ( $mp_date, $mp_author, $mp_title ) = $arg =~
          /^.*"([^()"]*?)"\s*"([^()"]*?)"\s*"([^()"]*?)"\s*$/
          or die "$0: cannot parse .TH line";
      }
      elsif ( $cmd =~ /^SH$/i ) {
        $sect{$sh} = $text if defined $sh;
        $text      = [];
        $sh        = $arg;
        dequote $sh;
      }
      elsif ( $cmd =~ /^PP$/i ) {
        $_         = undef;
        $cmd       = undef;
      }
      # (Ignore lines beginning with other commands.)
    }
    push @$text, $_ unless defined $cmd;
  }
  $sect{$sh} = $text if defined $sh;
  $text = undef;
  $sh   = undef;
}

# If debian/copyright exists, pull licensing text from it.
my @lic;
if ( -e $deb_cprt ) {
  my @lic0;
  open  CPRT, '<', $deb_cprt;
  {
    my $in = '';
    while ( <CPRT> ) {
      $in = '1' if /$mark_lic/;
      $in or next;
      push @lic0, $_;
    }
  }
  close CPRT;
  @lic = format_text @lic0;
  unshift @lic, $bar, "\n";
  push    @lic,       "\n";
}

# Calculate the manpage date, then prepare the readme's header and
# footer.
my $date = `$cmd_date '$mp_date $time_dflt'`; chomp $date;
my @head = (
  $Def::traditional_readme
  ? $headlead_trad     . " ${Def::out}\n"
  : ${Def::full_title} .             "\n"
);
my @foot = ( "${Def::author} <${Def::email}>\n", "$date\n" );
if ( $Def::traditional_readme ) {
  push @head, '-' x (length($head[0])-1) . "\n";
}
else {
  unshift @head, $bar;
  unshift @head, "\n";
  push    @head, $bar;
  unshift @foot, $bar;
  push    @foot, "\n";
}
push @head, "\n";

# Make special corrections.
if ( defined $sect{'AUTHOR'} ) {
  for ( @{ $sect{'AUTHOR'} } ) {
    next if s/^(The book) (and this manpage are\b)/$1 is/;
    next if s/^(${Def::out})$/'$1'/;
    next if s/^(in which) (they are) (distributed.)/$1 the book is $3/;
  }
}

# Build the readme.
my @body0;
for my $sh ( @sh ) {
  defined $sect{$sh} or next;
  convall for @{ $sect{$sh} };
  push @body0, map { defined() ? $_ : "\n" } @{ $sect{$sh} };
  push @body0, "\n";
}
my @body   = format_text @body0;
my @readme = ( @head, @body, @lic, @foot );

# Write the readme out.
open  README, '>', $readme;
  print README @readme;
close README;

