The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
#! /bin/perl

$specs_dir = '/home/ken/src/Quilt/specs';


use Getopt::Long;
use SGML::SPGroveBuilder;
use SGML::Grove;
use Quilt;
use Quilt::Writer::Ascii;
use Quilt::Writer::HTML;
use Quilt::XRef;
use Quilt::TOC;

use SGML::Simple::SpecBuilder;
use SGML::Simple::BuilderBuilder;

$| = 1;

$usage = "aack! don't grok!\n";
die "$usage" if !GetOptions("--html"         => \$to_html,
			    "--ascii"        => \$to_ascii,
			    "--sgml"         => \$to_sgml,
			    "--linuxdoc"     => \$linuxdoc,
			    "--docbook"      => \$docbook,
			    "--teilite"      => \$teilite,
			    "--debug"        => sub { $debug ++ },
			    "--help"         => \&help,
			    "--version"      => \&version);

$debug && do {$time = localtime; warn "$time  -- loaded\n"};

my $doc_builder;
$linuxdoc && do {$doc_builder = spec_builder("$specs_dir/linuxdoc.spec")};
$docbook  && do {$doc_builder = spec_builder("$specs_dir/docbook.spec")};
$teilite  && do {$doc_builder = spec_builder("$specs_dir/teilite.spec")};
if ($to_ascii) {
    $to_ascii_builder = spec_builder("$specs_dir/toAscii.spec");
    $wr_ascii_builder = spec_builder("$specs_dir/wrAscii.spec");
}
if ($to_html) {
    $to_html_builder = spec_builder("$specs_dir/toHTML.spec");
    $wr_html_builder = spec_builder("$specs_dir/wrHTML.spec");
    # XXX ooh, this is a hack
    my $ref = ref ($wr_html_builder->new);
    eval "use SGML::Writer";
    eval <<EOF;
{
  package WR_HTML;
  use vars qw{\@ISA};
  \@ISA = qw{$ref SGML::Writer};
  sub new { shift; &SGML::Writer::new ('WR_HTML', @_)}
}
EOF
    $wr_html_builder = bless {}, 'WR_HTML';
}

my $base_name = $ARGV[0];
$base_name =~ s|.*/||;

if ($to_sgml) {
    my $doc = SGML::SPGroveBuilder->new ($ARGV[0]);
    $debug && do {$time = localtime; warn "$time  -- $base_name - loaded\n"};
    my $errors = $doc->errors;
    warn ("errors parsing $ARGV[0]\n" . join ("", @$errors))
	if ($#$errors != -1);
    eval "use SGML::Writer";
    $to_sgml_writer = SGML::Writer->new;
    $doc->accept ($to_sgml_writer);
    exit (0);
}

my $doc_builder_inst = $doc_builder->new;
my $doc_ot = load_doc ($ARGV[0], $doc_builder_inst);

my $context = {};
my $xref_builder = Quilt::XRef->new;
$doc_ot->iter->accept ($xref_builder, $context);
$debug && do {$time = localtime; warn "$time  -- $base_name - build xrefs\n"};

if ($to_ascii) {
    $fot = Quilt::Flow->new();
    $fot_b = $to_ascii_builder->new;
    # XXX hack
    $fot_b->{references} = $context->{references};
    $doc_ot->iter->accept ($fot_b, $fot, {});
    $debug && do {$time = localtime; warn "$time  -- $base_name - build fot\n"};
    $out_b = $wr_ascii_builder->new;
    $fot->iter->accept ($out_b, Quilt::Writer::Ascii->new, {});
}
if ($to_html) {
    $fot = Quilt::Flow->new();
    $fot_b = $to_html_builder->new;
    # XXX hack
    $fot_b->{references} = $context->{references};
    $doc_ot->iter->accept ($fot_b, $fot, {});
    $debug && do {$time = localtime; warn "$time  -- $base_name - build fot\n"};
    $out_b = $wr_html_builder->new;
    $fot->iter->accept ($out_b, Quilt::Writer::HTML->new, {});
}

exit (0);

sub spec_builder {
    my $spec_file = shift;

    my $base_name = $spec_file;
    $base_name =~ s|.*/||;

    my $spec_grove = SGML::SPGroveBuilder->new ("$spec_file");
    $debug && do {my $time = localtime; warn "$time  -- $base_name - loaded\n"};
    my $errors = $spec_grove->errors;
    die ("errors parsing $ARGV[0]\n" . join ("", @$errors))
	if ($#$errors != -1);
    my $spec = SGML::Simple::Spec->new;
    $spec_grove->accept (SGML::Simple::SpecBuilder->new, $spec);
    $debug && do {$time = localtime; warn "$time  -- $base_name - build spec\n"};
    my $builder = SGML::Simple::BuilderBuilder->new (spec => $spec);
    $debug && do {$time = localtime; warn "$time  -- $base_name - build builder\n"};

    return ($builder);
}

sub load_doc {
    my $doc = shift;
    my $builder = shift;

    my $base_name = $doc;
    $base_name =~ s|.*/||;

    my $grove = SGML::SPGroveBuilder->new ($doc);
    $debug && do {$time = localtime; warn "$time  -- $base_name - loaded\n"};
    my $errors = $grove->errors;
    warn ("errors parsing $ARGV[0]\n" . join ("", @$errors))
	if ($#$errors != -1);
    my $ot = Quilt::Flow->new();
    $grove->accept ($builder, $ot->iter, {});
    $debug && do {$time = localtime; warn "$time  -- $base_name - build ot\n"};

    return $ot;
}

# XXX awaiting SPGrove classes using Class::Visitor
package SGML::Element;

package SGML::SData;

package SGML::PI;

package Class::Iter;

sub children_accept_ports {
    my $self = shift;
    my $delegate = $self->delegate;

    # ` "$delegate" =~ /=HASH\(/ ' checks to see if a blessed
    # reference is a hash thanks to the way Perl formats references in
    # string context.  An unblessed hash won't match (no `=').
    # Derived from Data::Dumper
    # XXX in 5.004 we can use `isa()'
    if ("$delegate" =~ /=HASH\(/) {
	my $key;
	foreach $key (keys %$delegate) {
	    if (ref ($delegate->{$key}) eq 'ARRAY') {
		my $method = "children_accept_$key";
		eval {$self->$method (@_)};
	    }
	}
    }
}