#!/usr/bin/perl
#   $Id$
#
#   File:   ppd-doc-extractor
#   Date:   27 Jan 2022 16:28:17
#   Author:   Alexander Zangerl <az@snafu.priv.at>
#
#   Abstract:
#    very minimal recreation of the PPD documentation extractor
#    of foomatic-rip 3.x (which you got with foomatic-rip -o docs), which
#    is not part of the rewritten 4.x versions despite the documentation's
#    claims and the broken option code that doesn't reject what it cannot
#    handle.
#
#   copyright (c) 2022 Alexander Zangerl <az@snafu.priv.at>
#
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License version 2
#   as published by the Free Software Foundation.
#
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software
#   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
use strict;
use File::Slurp;
use Data::Dumper;

my ($ppdfile,@a2ps) = @ARGV;
die "usage: $0 <ppdfile> [a2ps args]\n
no a2ps args: print to stdout
automatically added: --center-title, --footer\n\n" if (!-f $ppdfile);

my @stuff = read_file($ppdfile);

# parse everything but massage and handle just the relevant parts
my (%x, $curopengroup);
for (my $i = 0; $i <= $#stuff; ++$i)
{
  my $line = $stuff[$i];
  $line =~ s/\r\n$//;           # de-dos
  chomp $line;

  my ($key, $value, $option, $xlatoption);

  next if ($line =~ /^(\*%.*)?$/ or $line eq "*End");
  if ($line =~ /^\*([^:]+):\s*(.+)\s*$/)
  {
    ($key, $value) = ($1,$2);
    if ($key  =~ /^(\S+)\s+(.+)$/)
    {
      $key = $1;
      $option = $2;

      if ($option =~ m!^([^/]+)/(.+)$!)
      {
        ($option,$xlatoption) = ($1,$2);
        undef $xlatoption if ($xlatoption eq $option); # unnecessary ones
      }
    }
    # invocationvalue and quotedvalue allow continuation
    if ($value =~ /^"([^"]+)"\s*$/)
    {
      $value = $1;
    }
    elsif ($value =~ /^"([^"]*)*$/)
    {
      $value = $1;
      while ((my $nextline = $stuff[++$i]) !~ /"/)
      {
        $value .= $nextline;
      }
      if ($stuff[$i] =~ /^([^"]+)"\s*$/)
      {
        $value .= $1;
      }
    }

    # orderdependency is laid out extraspecially stupidly
    if ($key =~ /^(NonUI)?OrderDependency$/)
    {
      $key = "OrderDependency"; # we lump these together
      my ($num,$dontcare,$appliesto) = split(/\s+/,$value);
      ($option = $appliesto) =~ s/^\*//;
      $value = $num;
    }
    # want the options under openui w/o fluff
    elsif ($key eq "OpenUI")
    {
      $option =~ s/^\*//;
    }
    # another instance of shitty structural layout
    elsif ($key eq "OpenGroup")
    {
      if ($value =~ m!^\s*(\S+)/(.+)$!)
      {
        ($option,$xlatoption) = ($1,$2);
      }
      else
      {
        $xlatoption = $option = $value;
      }
      $curopengroup = $value = $option;
    }
    elsif ($key eq "CloseGroup")
    {
      undef $curopengroup;
    }

    if (defined $option)
    {
      # for option entries add a sequence number for sorting - simply use the line number
      $x{$key}->{$option} = { xlat => $xlatoption,
                              value => $value,
                              sequence => $i,
                              ingroup => $curopengroup, };

    }
    else
    {
      $x{$key} = $value;
    }
  }
  else
  {
    die "unrecognized line nr. $i\n";
  }
}

# print Dumper(\%x);

if (@a2ps)
{
  push @a2ps, ("--center-title=Documentation for $x{ModelName}","--footer=");

  # lazy me: just duping the pipe fd...
  open(P, "|-", "a2ps", @a2ps) or die "cannot pipe to a2ps: $!\n";
  open(STDOUT, ">&", \*P) or die "cannot dup: $!\n";
}

print qq|
Invocation summary for $x{ModelName}:
Command line: lpr [-Z opt=value, opt=value...] [lpr options] <file>

List of available options:\n\n|;

# meh...orderdependency is not in all ppds or all sections :-(
my $odep = $x{OrderDependency};
my @onames = sort { $odep->{$a}->{ingroup} cmp $odep->{$a}->{ingroup}
                    || $odep->{$a}->{sequence} <=> $odep->{$b}->{sequence}
                    || $odep->{$a}->{value} <=> $odep->{$b}->{value}
                    || $x{OpenUI}->{$a}->{sequence} <=> $x{OpenUI}->{$b}->{sequence} } keys %{$x{OpenUI}};

for my $oname (@onames)
{
  my $label = $x{OpenUI}->{$oname}->{xlat} // $oname;
  my $type = $x{OpenUI}->{$oname}->{value} // "Unknown";

  # one choice is no choice
  next if ($type eq "PickOne" && keys %{$x{$oname}} == 1);

  my $this = $x{$oname};
  my $example = (keys %$this)[0];
  my $sectionname = $x{OpenGroup}->{$this->{$example}->{ingroup}}->{xlat};
  my $sectionlabel = $sectionname ? "  Section: $sectionname\n":"";

  print "Option '$oname': $label\n$sectionlabel  Type: $type\n  Choices:\n";
  for my $choice (sort { $this->{$a}->{sequence} <=> $this->{$b}->{sequence} } keys %$this)
  {
    my $choicelabel = $x{$oname}->{$choice}->{xlat};
    print "   o '$choice'".($choicelabel? ": $choicelabel":"")."\n";
  }
  print "  Default: ".$x{"Default$oname"}."\n  Example: -Z $oname=$example\n\n";
}

if (@a2ps)
{
  close(STDOUT);
  close(P);
}