#!/usr/bin/perl 
#
# make-tooltips - parse all the plugin files, generate tooltips.txt
#
# FIXME: rename to "make-fault-dictionary"? And write to file, not stdout
# FIXME: invoke this from Build.PL
#
# $Id$
#
package RpmGrill::MakeToolTips;

use strict;
use warnings;

(our $ME = $0) =~ s|.*/||;
our $VERSION = '0.0';

# For debugging, show data structures using DumpTree($var)
#use Data::TreeDumper; $Data::TreeDumper::Displayaddress = 0;

###############################################################################
# BEGIN user-customizable section

# END   user-customizable section
###############################################################################

use Pod::POM;
use Pod::POM::View::HTML;
use RPM::Grill;

###############################################################################
# BEGIN boilerplate args checking, usage messages

sub usage {
    print  <<"END_USAGE";
Usage: $ME [OPTIONS] ARGS [...]

blah blah blah

OPTIONS:

  -v, --verbose  show verbose progress indicators
  -n, --dry-run  make no actual changes

  --help         display this message
  --man          display program man page
  --version      display program name and version
END_USAGE

    exit;
}

sub man {
    # Read the POD contents.  If it hasn't been filled in yet, abort.
    my $pod = do { local $/; <DATA>; };
    if ($pod =~ /=head1 \s+ NAME \s+ FIXME/xm) {
        warn "$ME: No man page available.  Please try $ME --help\n";
        exit;
    }

    # Use Pod::Man to convert our __DATA__ section to *roff
    eval { require Pod::Man }
        or die "$ME: Cannot generate man page; Pod::Man unavailable: $@\n";
    my $parser = Pod::Man->new(name => $ME, release => $VERSION, section => 1);

    # If called without output redirection, man-ify.
    my $out_fh;
    if (-t *STDOUT) {                           ## no critic
        my $pager = $ENV{MANPAGER} || $ENV{PAGER} || 'less';
        open $out_fh, "| nroff -man | $pager";  ## no critic
    }
    else {
        open $out_fh, '>&STDOUT';       ## no critic
    }

    # Read the POD contents, and have Pod::Man read from fake filehandle.
    # This requires 5.8.0.
    open my $pod_handle, '<', \$pod;
    $parser->parse_from_filehandle($pod_handle, $out_fh);
    exit;
}


# Command-line options.  Note that this operates directly on @ARGV !
our $debug   = 0;
our $force   = 0;
our $verbose = 0;
our $NOT     = '';              # print "blahing the blah$NOT\n" if $debug
sub handle_opts {
    use Getopt::Long;
    GetOptions(
        'debug!'     => \$debug,
        'dry-run|n!' => sub { $NOT = ' [NOT]' },
        'force'      => \$force,
        'verbose|v'  => \$verbose,

        help         => \&usage,
        man          => \&man,
        version      => sub { print "$ME version $VERSION\n"; exit 0 },
    ) or die "Try `$ME --help' for help\n";
}

# END   boilerplate args checking, usage messages
###############################################################################

############################## CODE BEGINS HERE ###############################

# The term is "modulino".
__PACKAGE__->main()                                     unless caller();

# Main code.
sub main {
    # Note that we operate directly on @ARGV, not on function parameters.
    # This is deliberate: it's because Getopt::Long only operates on @ARGV
    # and there's no clean way to make it use @_.
    handle_opts();                      # will set package globals

    die "$ME: Too many arguments; try $ME --help\n"                 if @ARGV;

    my $separator = '#' x 79 . "\n";    # Line of bars

    printf <<"END_HEADER", scalar(CORE::localtime);
#
# This file contains descriptions for rpmgrill message codes.
# (FIXME: clarify)
#
# This file is automatically generated. DO NOT EDIT.
#
# Generated %s by $ME v$VERSION
#------------------------------------------------------------------------------
# The file below contains a series of stanzas of the form:
#
#    |<Plugin>
#    |  <description of this plugin>
#    |  <vertical bar, two spaces, then text>
#
#    <Code>
#      <description of this test code>
#      <exactly two leading spaces should be stripped>
END_HEADER

    print $separator;

    # FIXME: do code here
    for my $p (RPM::Grill->plugins) {
        eval "use $p";          ## no critic
        die "$ME: $@" if $@;

        (my $x = "$p.pm") =~ s{::}{/}g;
        die "No INC{$x}" if ! exists $INC{$x};
        my $pom_parser = Pod::POM->new;
        my $pom = $pom_parser->parse_file($INC{$x})
            or die $pom_parser->error();

        print "# BEGIN $p\n\n";

        # Documentation about the plugin itself
        (my $p_basename = $p) =~ s/^.*:://;
        my $obj = bless {}, $p;
        my $doc = $obj->doc();
        print "|$p_basename\n";
        print "|  $_\n"         for split "\n", $doc;
        print "\n";

        # FIXME: keep a hash of the codes we've seen, xref to 'code =>'
        my @diags = grep { $_->title eq 'DIAGNOSTICS' } $pom->head1;
        if (@diags) {
            for my $section (@diags) {
#                for my $c ($section->content) {
#                    print "* ", $c->type, " ", $c;
#                }

                for my $over ($section->over) {
                    for my $item ($over->item) {
#                        use Data::Dumper; print Dumper($item);
                        print MyView->print($item->title), "\n";

                        # Glom together all paragraphs of the content
                        my $content = join("\n", map {
                            MyView->print($_) || ''
                        } $item->content) || '';
                        $content =~ s/^/  /gms;         # Indent 2 spaces
                        print $content;
                        print "\n";
                    }
                }
            }
        }
        else {
            warn "$ME: No DIAGNOSTICS section in $x\n";
            print "#     [no DIAGNOSTICS section found]\n\n";
        }

        print "# END   $p\n";
        print $separator;
    }
}


package MyView;

use parent qw(Pod::POM::View::HTML);


# ARGH.
#
# This is needed because /usr/share/perl5/Pod/POM/View/HTML.pm (0.27-1.fc14)
# does not properly handle L<links>. It's completely FUBAR. Two examples:
#
#    1) in view_seq_link():
#           if ($link =~ m|^ (.*?) / "? (.*?) "? $|x) { # [name]/"section"
#               ($page, $section) = ($1, $2);
#       Ummmmm.... that splits 'http://redhat.com' as ('http:/', '/redhat.com')
#
#    2) view_seq_link_transform_path(), which is supposed to return
#       its $page input untransformed, returns undef.
#
sub view_seq_link {
    my ($self, $link) = @_;

    return $link if $link =~ /^<a href/;

    # e.g. L<Red Hat|http://www.redhat.com/>
    if ($link =~ m{^(.*?)\|(\w+://.*)}) {
        return "<a href=\"$2\">$1</a>";
    }

    # e.g. L<http://www.redhat.com/>
    if ($link =~ m{^(\w+://\w.*)$}) {
        return "<a href=\"$1\">$1</a>";
    }

    # ARGH! I can't figure this out, but somehow this:
    #    The L<BitDefender antivirus tool|http://www.bitdefender.com/> has
    # ...gets passed to us as:
    #    'BitDefender|<a href="http://.../">http://www.bitdefender.com/</a>'
    if ($link =~ m{^(.*)\|<a href="(.*)">\2</a>}) {
        return "<a href=\"$2\">$1</a>";
    }


    die "FIXME: Cannot grok '$link'";
}


package RpmGrill::MakeToolTips;

1;

__DATA__

###############################################################################
#
# Documentation
#

=head1	NAME

FIXME - description of what this script does

=head1	SYNOPSIS

FIXME [B<--foo>]  [B<--bar>]  [B<--verbose>] ARG1 [ARG2...] FIXME

FIXME  B<--help>  |  B<--version> | B<--man>

=head1	DESCRIPTION

B<FIXME> grobbles the frobniz on alternate Tuesdays, except where
prohibited by law.

=head1	OPTIONS

=over 4

=item B<--foo>

FIXME

=item B<--verbose>

Show progress messages.

=item B<--help>

Emit usage hints.

=item B<--version>

Display program version.

=item B<--man>

Display this man page.

=back


=head1	DIAGNOSTICS

FIXME

=head1	ENVIRONMENT

FIXME

=head1	FILES

FIXME

=head1	RESTRICTIONS

FIXME

=head1	SEE ALSO

FIXME

e.g. L<Foo::Bar|Foo::Bar>

=head1	AUTHOR

Your Name <ed@edsantiago.com>

Please report bugs or suggestions to <ed@edsantiago.com>

=cut
