#!/usr/bin/perl
# 
#
# Authors:
#  Petr Blahos <pblahos@suse.cz>
#  Martin Vidner <mvidner@suse.cz>
#
# $Id: ycpdoc 20885 2005-01-24 17:29:30Z mvidner $

=head1 NAME

ycpdoc - Creates html files based on comments in ycp file.

=head1 SYNOPSIS

  ycpdoc -h|--help|--man
  ycpdoc [-d <dir>] [-s <dir>] [-f html|xml] [-i] [-] [-o] [-wr] files.ycp...

=head1 OPTIONS AND ARGUMENTS

=over

=item B<-h>

Show this help screen

=item B<-d> I<dir>, B<--outputdir>=I<dir>

Output files are placed to directory I<dir>

=item B<-s> I<dir>, B<--strip>=I<dir>

Strip only I<dir> when generating output files (default all).
Remaining slashes are converted to double underscores.

=item B<-f> I<format>, B<--format>=I<format>

Produce output in given format, html or xml. The option may be repeated.
HTML is the default. XML produces ycpdoc.xml, the DTD is not stable yet.

=item B<-i>, B<--noindex>

Do not generate index.html (intro.html, files.html)

=item B<->

Write output to stdout. Do not generate indexes.
If there are more input files, generate only one
output html file

=item B<-o>, B<--oldindex>

Old style of index: creates only index.html

=item B<-wr>

Do not warn about undeclared return types

=item B<--state>

For debugging, prints the parsing state for each line.

=back

=head1 DESCRIPTION

Processes special comments in ycp file and creates
html file from them. Uses the same comment syntax as
kdoc/ydoc.

	Supported tags:
            @short very short description
            @descr complete description
	    @param name description	html allowed
	    @return type description	html allowed
	    @since version		html allowed
	    @example anything		html allowed, <pre>
	    @example_file file path
	    @see function
	    @see #function
	    @see file#function
	    @see file#
	    @see <a href="uri">text</a>
	    @deprecated replacement
	    @struct name		begins a struct description, <pre>
	    @ref function		(inline, otherwise like @see)

First line is automatically taken as short if it has no tag. Empty line after
the first line indicates begin of the description. Every following new line
indicates a new paragraph.

All tags except @see can be multiline.
Also processes initial comment of file if it starts at the
first line, html allowed.
Supports intro via /*** , html allowed.

See YaST2 Documentation public/Developers/Coding/rules.html
for example.

=head1 EXAMPLES

The most common use (I believe):
   cd doc/autodocs
   ycpdoc -d. ../../src/printconf*ycp
Creates index.html and one html file for each ycp file.

Generate html file to stdout. Skip index:
   ycpdoc - file.ycp

For example of comments in ycp file, please see example.ycp and modules.ycp.
You can also look at generated index.html, intro.html, files.html, example.html
and modules.html.

=head1 PARANOISM

ycpdoc reports functions without comment and functions that have
undocumented arguments and arguments that are documented but do not
exist.

=cut

use strict;
use warnings;
use File::Basename;
use Getopt::Long;
use Pod::Usage;
use XML::Writer;
use Tie::Hash;
use Tie::Array;

sub main
{
    parse_arguments ();

    parse_sources ();
    write_docs ();
}


my @sources = ();

my @formats_wanted = ();
my $help = 0;
my $man = 0;
my $skip_index = 0;
my $output_stdout = 0;
my $output_dir = ".";
my $strip_prefix = "";		# both with a trailing slash
my $new_index_style = 1;
my $warning_level = 2;
my $xml_output = "ycpdoc.xml";
my $warn_return_types = 1;
my $show_state = 0;		# show which state we are in for each line

sub parse_arguments
{
##
## find switches
##
    Getopt::Long::Configure ("bundling");
    GetOptions (
		"help|h" => \$help,
		"man" => \$man,
		"noindex|i" => \$skip_index,
		"" => \$output_stdout,
		"outputdir|d=s" => \$output_dir,
		"strip|s=s" => \$strip_prefix,
		"oldindex|o" => sub { $new_index_style = 0; },
		"xml-output|O=s" => \$xml_output,
		"w=i" => \$warning_level,
		"wr" => sub { $warn_return_types = 0; },
		"format|f=s" => \@formats_wanted,
		"state" => \$show_state,
	       ) or pod2usage (2);
    pod2usage (1) if $help;
    pod2usage (-exitstatus => 0, -verbose => 2) if $man;


    if ($output_stdout)
    {
	$skip_index = 1;
    }
    if ($output_dir !~ /\/$/ )
    {
	$output_dir .= "/";
    }
    if ($strip_prefix !~ /\/$/ )
    {
	$strip_prefix .= "/";
    }
    if (@formats_wanted == 0)
    {
	@formats_wanted = ("html");
    }

    @sources = @ARGV;
    if (@sources == 0)
    {
	pod2usage (2);
    }
}

my %formats =
    (
     "html" => "ycpdoc::HTML",
     "xml" => "ycpdoc::XML",
    );

sub write_docs
{
    no strict "refs";
    foreach my $format (@formats_wanted)
    {
	my $fun = $formats{$format} ."::write_docs";
	&$fun;
    }
}


###
### information shared between parsing and writing
###

my $any_module = "";		# module to be put on index pages

# global map:
#   intro_html string, concatenated contents of (/*** */), leading * stripped
#   files map keyed by filenames
my $g;

# file map:
#   header map
#   requires list of maps
#   provides list of maps

# header map:
#   module
#   file
#   authors: list
#   descr
#   summary
#   depends
# requires map:
#   kind: include or import or (yuck! provides!) module
#   name
# provides map:
#   file => "routines"
#   kind: "function", "variable", "scruple" - struct or tuple ;-), ("info")
#    scruple is just a stub to generate index entries,
#    the description itself is in "scruple" fields (below)
#   global: boolean
#   name
#   return (description) @ref expanded
#   type   (variable type or return type)
#   parameters: list of maps
#   signature => formatted name (and parameters) FIXME: filled only by html
#   since => version
#   see => list of "see" strings
#   scruple => [ name, "blahblah...\nblahhy" ] # will be <pre>'d, @ref expanded
#   example => "<pre>blahblah...</pre>"
#   body => description text, @ref expanded
#   deprecated => what to use instead (or "magicnumber" if not specified)
# see string: one of
#   #item
#   file
#   file#item
#   <a href...>foo</a>

# parameters map:
#   name
#   type
#   description => @ref expanded


###
### parsing
###


# quick and dirty: warn about the previous line
my $pathname;
my $lines_read;
# 1:debug 2:hint 3:warning 4:error
my @kind = ("InTeRnAl", "Debug", "Hint", "Warning", "Error");
sub warning ($;$)
{
    my $text = shift;
    my $level = shift || 3;
    if ($level >= $warning_level)
    {
	printf(STDERR "$pathname: %d: $kind[$level]: $text\n", $lines_read-1);
    }
}

# convert a source file name to a form used as a key
sub base_source_name ($)
{
    my $source = shift;
    if ($strip_prefix ne "" && $source =~ s/^$strip_prefix//)
    {
	return $source;
    }
    else
    {
	return basename ($source);
    }
}

sub parse_sources ()
{
    $g->{"intro_html"} = "";
    tie %{$g->{files}}, "file";
    foreach my $source (@sources)
    {
	print STDERR "Parsing $source\n";
	my $b = base_source_name ($source);
	$g->{"files"}->{$b} = parse_file ($source);
    }
}

# see scanner.ll and parser.yy in libycp
# (?:foo) makes a grouping but not a backreference as (foo) does

# like "[[:alpha:]_][[:alnum:]_]*" except a single _
my $ycp_symbol = "(?:[[:alpha:]_][[:alnum:]_]+|[[:alpha:]][[:alnum:]_]*)";
my $ycp_quad = "(?:::)";
my $ycp_qualified_symbol = "(?:$ycp_quad?$ycp_symbol(?:$ycp_quad$ycp_symbol)*)";

my $ycp_simple_type = "(?:any|void|boolean|integer|float|string|byteblock"
    . "|list|map"		# _syntactically_ simple types
    . "|${ycp_symbol}_t"	# if it ends with _t, it is a type
    . "|locale|term|path|block|declaration|symbol)";

sub recursive_type ($)
{
    my $t = shift;
    return qr{(?:
     list  \s* <  \s* $t \s* >
    |block \s* <  \s* $t \s* >
    |map   \s* <  \s* $t \s* , \s* $t \s* >
    | $t	# must come last otherwise "list<foo>" would not
		# be parsed because of "list"
    )}x;
}

#3 levels of type nesting
my $ycp_typedecl =
    recursive_type (recursive_type (recursive_type ($ycp_simple_type)));

# Matches any string not containing '*/'.
# Helpful for the line-oriented parser not to slurp everything when it
# sees /*****/
my $no_comment_end = '(?:[^*]|\*[^*/])*';

##
## read file
##
sub parse_file ($)
{
    $pathname = shift;
    my $state = "firstline"; # aftercomment, fistcomment, firstline, incomment, intro, start,

    my $f = {};
    tie @{$f->{"provides"}}, "provides";
    tie @{$f->{"requires"}}, "requires";

    my @header_lines = ();	# list of header lines (first /** */)

    my @comments = (); # list of comment lines (presumably before a define)
    my $isglobal = 0;
    my $declared_type = "";
    my $name = "";
    my $params = "";
    my $shipout = 0; # 1 when we got a comment and optionally a define


    $lines_read = 0;
    open(INYCP, $pathname) or die "Cannot open file $pathname: $!";
    while (<INYCP>)
    {
	$lines_read = $lines_read + 1;
	chomp;
	print STDERR "--$state\n" if ($show_state);

	if ("aftercomment" eq $state)
	{
	    # function definition
	    if (/^\s*(global\s+)?(?:define\s+)?($ycp_typedecl)\s*($ycp_qualified_symbol)(\s*\(.*)/o)
	    {
		$isglobal = defined $1;
		$declared_type = $2 || "";
		$name = $3;
		$params = $4;
		if ($params =~ s/(;|(``)?\{).*//)
		{
		    $state = "start";
		    $shipout = 1;
		}
		else
		{
		    $state = "longdefine";
		}
	    }
	    # variable declaration
	    elsif (/^\s*(global\s+)?($ycp_typedecl)\s*($ycp_qualified_symbol)\s*=/o)
	    {
		  $isglobal = defined $1;
		  $declared_type = $2;
		  $name = $3;

		  $state = "start";
		  $shipout = 1;
	    }
	    elsif( /^\s*$/ )
	    {
		# allow empty lines between comment and declaration
	    }
	    else
	    {
		#info
		# ship out
		$state = "start";
		$shipout = 1;
	    }
	}
	elsif ($state eq "longdefine")
	{
	    if (s/(;|(``)?\{).*//)
	    {
		$state = "start";
		$shipout = 1;
	    }
	    $params .= $_;
	}
	elsif ($state eq "firstline")
	{
	    # skip empty lines, enter firstcomment or start
	    if(/^\s*\/\*\*\s*$/)
	    {
		$state = "firstcomment";
	    }
	    elsif ($_ ne "")
	    {
		$state = "start";
	    }
	}
	elsif ($state eq "firstcomment")
	{
	    if(/\*\//)
	    {
		$state = "start";
	    }
	    else
	    {
		s/^\s*\*//; # remove leading whitespace with asterisk
		push (@header_lines, $_);
	    }
	}
	elsif ($state eq "start")
	{
	    if(/^\s*\/\*\*\*\s*$/)
	    {
		$state = "intro";
		$g->{"intro_html"} .= "<!-- $pathname -->\n";
	    }

	    elsif(/^\s*\/\*\*\s*$/)
	    {
		$state = "incomment";
	    }
	    elsif (/^\s*(include|import)\s*\"([^\"]+)\"/) # "emacs
	    {
		my $req = { "kind" => $1, "name" => $2 };
		push (@{$f->{"requires"}}, $req);
	    }
	    elsif (/^\s*(module)\s*\"([^\"]+)\"/)
	    {
		my $prov = { "kind" => $1, "name" => $2 };
		push (@{$f->{"requires"}}, $prov);
	    }

	    # function, but not a declaration (;)
	    if (/^\s*(?:global\s+)?(?:define\s+)?(?:$ycp_typedecl)\s*(${ycp_qualified_symbol})\s*\([^;]*$/o)
	    {
		warning ("Function $1 has no comment.");
	    }
	}
	elsif ("incomment" eq $state)
	{
	    if (/\*\//)
	    {
		$state = "aftercomment";
	    }
	    else
	    {
		s/^\s*\*//;	# remove leading whitespace with asterisk
		push @comments, $_;
	    }
	}
	elsif ("intro" eq $state)
	{
	    if (/\*\//)
	    {
		$state = "start";
	    }
	    else
	    {
		# remove * from the beg. of line if there is any.
		s/^\s*\*//;
		$g->{"intro_html"} .= "$_\n";
	    }
	}

	if(0!=$shipout)
	{
	    push (@{$f->{"provides"}}, do_shipout (base_source_name ($pathname), $isglobal, $declared_type, $name, $params, @comments));
	    $shipout = 0;
	    $isglobal = 0;
	    $declared_type = "";
	    $name = "";
	    $params = "";
	    @comments = ();
	}
    }
    close(INYCP);

    $f->{"header"} = parse_header (@header_lines);
    return $f;
}

# parse_entry
# returns one entry, or, if there are scruples, a list of them!
sub do_shipout ($$$$$@)
{
    # file name,
    my ($file, $isglobal, $declared_type, $name, $params, @comments) = @_;

    my $lastwas = "";

    my $entry = {};
    $entry->{"file"} = $file;
    $entry->{"name"} = $name;
    $entry->{"global"} = $isglobal;
    $entry->{"return"} = "";
    $entry->{"type"} = "";
    $entry->{"signature"} = ""; #TODO better place
    $entry->{"parameters"} = [];
    tie @{$entry->{"parameters"}}, "parameters";
    $entry->{"since"} = "";
    $entry->{"example"} = "";
    $entry->{"screenshot"} = "";
    $entry->{"example_file"} = [];
    tie @{$entry->{"example_file"}}, "example_file";
    $entry->{"scruple"} = [];
    $entry->{"see"} = [];
    tie @{$entry->{"see"}}, "see";
    $entry->{"body"} = "";
    $entry->{"short"} = "";
    $entry->{"descr"} = [];
    tie @{$entry->{"descr"}}, "descr";
    $entry->{"deprecated"} = "";
    my @entries = ($entry);

    my %param_infunc;	# (declared) parameter names, keyed by themselves
    my %param_incomment; # parameter descriptions

    my @parameters = ();
    my @descr = ();
    my @example_file = ();

    if ($name eq "")
    {
	$entry->{"kind"} = "info";
    }
    elsif ($params eq "")
    {
	$entry->{"kind"} = "variable";
    }
    else
    {
	my $ok;
	$entry->{"kind"} = "function";
	# just the things inside parens
	$ok = ($params =~ s/^\s*\(\s*(.*)\s*\)\s*$/$1/);
	warn "No parentheses? '$params'" unless $ok;

	my $last_comma = ',';
	while ($params =~ m/\G\s*($ycp_typedecl\s*?\&?)\s*($ycp_symbol)\s*(,?)/ogc)
	{
	    warn "Missing comma before '$1 $2'" unless $last_comma;
	    $last_comma = $3;
	    # later: "description"
	    push @parameters, { "name" => $2, "type" => $1 };
	    $param_infunc{$2} = $2;
	}
	$params =~ m/\G(.*)/;
	warn "Bad parameter? '$1'" unless $1 eq "";
    }

    my $last_param;
    my $documented_type = "";
    my $para = "";
    foreach my $line (@comments)
    {
        my $empty_line = $line;
        $empty_line =~ s/\s+//;
	if($line =~ /\@param\s+($ycp_symbol)\s+(.*)/o)
	{
	    $lastwas = "param";

	    $last_param = $1;
	    $param_incomment{$last_param} = almost_html ($2);
	}
	elsif($line =~ /\@return\s+($ycp_typedecl)?\s*(.*)/o)
	{
	    $lastwas = "return";
	    $documented_type = $1 || "";
	    $entry->{"return"} = almost_html ($2);
	}
	elsif ($line =~ /\@since\s+(.*)/)
	{
	    $lastwas = "since";
	    $entry->{"since"} = almost_html ($1);
	}
	elsif ($line =~ /\@short\s+(.*)/)
	{
	    $lastwas = "short";
	    $entry->{"short"} = almost_html ($1);
	}
	elsif ($line =~ /\@descr\s+(.*)/)
	{
	    $lastwas = "descr";
            $para .= almost_html("\n$1");
	}
	elsif($line =~ /\@see\s+(.*)/)
	{
	    $lastwas = "see";  # it is an error, we do not allow multiline see...
	    # see section
	    $line = $1;

	    # Simply copy it to the see list and let the backend do the work.
	    # Maybe do some syntax checks here?
	    push @{$entry->{"see"}}, $line;
	}
	elsif($line =~ /\@example_file(.*)/)
	{
	    $lastwas = "example_file";
	    $line =~ s/\@example_file//; # remove it if it's there
	    $line =~ s/\s+//; # remove empty spaces
            push @example_file, $line;
	}
	elsif($line =~ /\@screenshot(.*)/)
	{
	    $lastwas = "screenshot";
	    $line =~ s/\@screenshot//; # remove it if it's there
	    $line =~ s/\s+//; # remove empty spaces
	    $entry->{"screenshot"} .= $line;
	}
	elsif($line =~ /\@example(.*)/ || $lastwas eq "example")
	{
	    $lastwas = "example";
	    $line =~ s/\@example//; # remove it if it's there
	    $entry->{"example"} .= almost_html ("\n$line");
	}
	elsif($line =~ /\@deprecated\s*(.*)/)
	{
	    $lastwas = "deprecated";
	    if( ($1) ne "" )
	    {
		$entry->{"deprecated"} .= almost_html ($1);
	    }
	    else
	    {
		$entry->{"deprecated"} .= almost_html ("magicnumber");
	    }
	}
	elsif($line =~ /\@(struct|tuple)\s*(.*)/)
	{
	    $lastwas = "scruple";
	    $entry->{"scruple"} = [$2, ""];
	    push @entries, {"kind" => "scruple", "name" => $2,
			    "signature" => $2, "file" => $file};
	}
	elsif($lastwas eq "scruple")
	{
	    $entry->{"scruple"}->[1] .= almost_html ("\n$line");
	}
	elsif($lastwas eq "return")
	{
	    $entry->{"return"}.= almost_html ("\n$line");
	}
	elsif($lastwas eq "param")
	{
	    $param_incomment{$last_param} .= almost_html ("\n$line");
	}
	elsif($lastwas eq "short" && $empty_line ne "")
        {
            $lastwas = "short";
	    $entry->{"short"} .= almost_html ("\n$line");
        }
	elsif($lastwas eq "short" || $lastwas eq "descr")
	{
            $lastwas = "descr";
            if ($empty_line eq "")
            { 
                if ($para ne "")
                {
	            push @descr, $para;
                }
                $para = "";
            }
            else 
            {
                $para .= almost_html("\n$line");
            }
	}
	else
	{
            $lastwas = "short";
	    $entry->{"short"} .= almost_html ("\n$line");
	}
    }
    $entry->{"type"} = $declared_type || $documented_type;
    push @{$entry->{"descr"}}, @descr;
    push @{$entry->{"example_file"}}, @example_file;


    # check arguments

    # for actual parameters: add description or warn
    foreach my $param_mapref (@parameters)
    {
	my $name = $param_mapref->{"name"};
	my $cmt = $param_incomment{$name} || "";
	$param_mapref->{"description"} = $cmt;
	if ($cmt eq "")
	{
	    warning ("Parameter $name declared in function header but not documented.");
	}
	}
    # for commented parameters: warn if no such actual parameter
    foreach my $key (sort keys %param_incomment)
    {
	my $descr = $param_incomment{$key};
	if (!defined ($param_infunc{$key})) {
	    if ($entry->{"kind"} eq "function")
	    {
		warning ("Parameter $key documented but not declared in function header.");
	    }
	    else
	    {
		# info (oldmodule parameters (Args)): ad
		push @parameters, { "name" => $key, "description" => $descr };
	    }
	}
    }

    push @{$entry->{"parameters"}}, @parameters;


    if ($entry->{"kind"} eq "function")
    {
	if ($declared_type eq "")
	{
	    if ($warn_return_types)
	    {
		if ($documented_type eq "")
		{
		    warning ("Return type not specified.");
		}
		else
		{
		    warning ("It is better to declare the type in the code.", 2);
		}
	    }
	}
	else
	{
	    if ($documented_type)
	    {
		# remove wehitespace before comparing
		$documented_type =~ s/\s//g;
		$declared_type   =~ s/\s//g;
		if ($documented_type ne $declared_type)
		{
		    warning ("Declared and documented return types do not match ($declared_type != $documented_type).");
		}
	    }
	}

	if ($entry->{"return"} eq "" && $entry->{"type"} !~ /^(void)?$/) #/)
	{
	    warning ("Return value not documented.");
	}
    }

    return @entries;
}

##
## parse header (comment at the beginning of file)
##

#convert to
sub parse_header (@)
{
    my @lines = @_;

    my $parsed_header = {};
    $parsed_header->{"module"} = "";
    $parsed_header->{"authors"} = [];

    my $key = "descr";
    foreach my $a (@lines)
    {
	#TODO: warn on unknown key, missing field
	if ($a =~ s/^\s*(Module|Package|File|Summary|Depends|Authors|Author):\s*(.*)/$2/)
	{
	    $key = lc $1;
	    # Module is old style, Package is new style. TODO, define meaning
	    $key = "module" if $key eq "package";
	}
	elsif ($a =~ /^\s*\$Id/)
	{
	    $a = "";
	    $key = "descr";
	}

	if ( $key eq "authors")
	{
	    my $mail = $a;
	    $mail =~ s/[^<(]*[(<]([^>)]*).*/$1/g;
	    $a =~ s/[(<][^>)]*[>)]/&lt;<a href=\"mailto:$mail\">$mail<\/a>&gt;/g; # "emacs
	    if ($a !~ /^\s*$/)
	    {
		push @{$parsed_header->{$key}}, $a;
	    }
	}
	else
	{
	    if ( $key eq "module" )
	    {
		$any_module ||= $a;
	    }

	    if (defined $parsed_header->{$key})
	    {
		$parsed_header->{$key} .= almost_html ("\n$a");
	    }
	    else
	    {
		$parsed_header->{$key} = almost_html ($a);
	    }
	}
    }
    return $parsed_header;
}

sub almost_html ($)
{
    my $text = shift;
    $text =~ s/\&(?![A-Za-z])/\&amp;/g; # negative lookahead
    $text =~  s:<(?![A-Za-z/]):\&lt;:g;
    #$text =~ s/([[:space:]-])>/$1\&gt;/g;
    return $text;
}


###
### writing
###

package ycpdoc::HTML;

sub escape_ltgtamp ($)
{
    my $text = shift;
    # ampersand first!
    $text =~ s:\&:\&amp;:g;
    $text =~ s:<:\&lt;:g;
    $text =~ s:>:\&gt;:g;
    return $text;
}

# substituted strings: 1,2 = Module, 3,4,5 = links to other pages
my $intro = "<HTML>\n<HEAD>\n<TITLE>%s</TITLE>\n"
    . "<STYLE type=\"text/css\">\n"
    . "H1 {color: #e00000}\n"
    . "</STYLE>\n"
    . "</HEAD>\n"
    . "<BODY bgcolor=\"#c8c8c8\">\n"
    . "<TABLE WIDTH=\"100%%\"><TR><TD ALIGN=\"left\" VALIGN=\"top\"><i>YaST2 Developers Documentation:</i>\n"
    . "<a href=\"index.html\"><b>%s</b></a></TD>\n"
    . "<TD ALIGN=\"RIGHT\" VALIGN=\"TOP\"><img src=\"/usr/share/doc/packages/yast2-devtools/images/yast2-mini.png\" border=0></TD></TR></TABLE>\n"
    . "<hr>\n<TABLE><TR><td valign=top align=center>\n"
    . "<img src=\"/usr/share/doc/packages/yast2-devtools/images/yast2-half.png\"><br><br>\n"
    . "%s<br>\n%s<br>\n%s\n</td>\n"
    . "<TD VALIGN=TOP><TD VALIGN=TOP>\n";

my $outro = "</td></tr></table><HR>\n"
    . "<TABLE WIDTH=\"100%\"><TR><TD ALIGN=\"left\" VALIGN=\"top\"><i>YaST2 Developers Documentation </i></TD><TD ALIGN=\"RIGHT\" VALIGN=\"TOP\"><img src=\"/usr/share/doc/packages/yast2-devtools/images/yast2-mini.png\" border=0></TD></TR></TABLE>\n"
    . "</BODY>\n</HTML>\n";

my $infohead = "<p>\n"
    . "<table bgcolor=\"#f96500\" cellpadding=1 cellspacing=0 border=0 width=\"100%%\"><tr><td>\n"
    . "<table bgcolor=\"#ffc080\" cellpadding=3 cellspacing=0 border=0 width=\"100%%\"><tr><td>\n"
    . "Info:\n"
    . "</td></tr></table>\n"
    . "</td></tr></table>\n";
# 0: global/local 1:function, 2:anchor 3:-> 4:returntype
my $functionhead = "<p>\n"
    . "<table bgcolor=\"#f96500\" cellpadding=1 cellspacing=0 border=0 width=\"100%%\"><tr><td>\n"
    . "<table bgcolor=\"#ffc080\" cellpadding=3 cellspacing=0 border=0 width=\"100%%\"><tr><td><font size=\"+1\">\n"
    . "<tt>%s <b>%s<a name=\"%s\"></a><font color=\"#606060\"> %s </font><font color=\"#c05000\"> %s</font></b></tt>\n"
    . "</font></td></tr></table>\n"
    . "</td></tr></table>\n";

my $functiondescintro = "<p>";
my $functiondescoutro = "</p>\n";

my $functionparamsintro = "<dl><dt><b>Parameters</b>:<dd><table width=\"100%\" border=\"0\">\n";
my $functionparamsoutro = "</table></dl>\n";

my $functionparamintro = "<tr><td align=\"left\" valign=\"top\" width=\"20%\"><font color=\"#c05000\">\n";
my $functionparamfil = "</font></td>\n<td align=\"left\" valign=\"top\">";
my $functionparamoutro = "</td></tr>\n";

my $functionretintro = "<dl><dt><b>Return value</b>:<dd><table width=\"100%\" border=\"0\">\n"
    . "<tr><td align=\"left\" valign=\"top\" width=\"20%\"><font color=\"#c05000\">\n";
my $functionretfil = "</font></td>\n<td align=\"left\" valign=\"top\">";
my $functionretoutro = "</td></tr>\n</table></dl>\n";

# header of a ycp file, with a list of includes and exports
my $headintro = "\n<table cellspacing=0 BGCOLOR=\"#f96500\" width=\"100%\"><tr><td>\n"
    . "<table width=\"100%\" bgcolor=\"#ffc080\" cellpadding=10><TR><TD>\n"
    . "<table width=\"100%\" bgcolor=\"#ffc080\" cellpadding=10><TR>\n";
my $headfil = "</td></tr></table></td></tr></table>\n"
    . "<table width=\"100%\" bgcolor=\"#ffc080\" cellpadding=10><TR><td>\n"
    . "<table width=\"100%\" bgcolor=\"#ffc080\" cellpadding=10><TR><TD>\n";
my $headoutro = "\n</td></tr></table></td></tr></table></td></tr></table>\n";

# 1:title
my $genericintro = "<dl><dt><b>%s:</b><dd>\n"
    . "<table width=\"100%%\" border=\"0\"><tr><td align=\"left\" valign=\"top\">\n";
my $genericoutro = "</td></tr></table>\n</dl>\n";

##
##
##

##
## process files, create output files and possibly index.html
##
sub write_docs
{
    while (my ($file, $f) = each %{$g->{"files"}})
    {
	write_onefile ($file, $f);
    }

    if (!$output_stdout && !$skip_index)
    {
	create_index ($new_index_style);
    }
}

# make an output file name from a base_source_name, not including output_dir
sub html_name ($)
{
    my $base = shift;
    $base =~ s/.ycp$//;
    $base =~ s{/}{__}g;
    return $base . ".html";
}

##
## create index.html
##
sub create_index ($)
{
    my ($new) = @_;

    my $index = $output_dir."index.html";
    print STDERR "Writing $index\n";
    open(OUT,">$index") or die "Cannot open file $index: $!";

    if ($new)
    {
	printf OUT $intro , $any_module  , $any_module , "<a href=\"index.html\">functions</a>", "<a href=\"files.html\">files</a>", "<a href=\"intro.html\">intro</a>";
    }
    else
    {
	printf OUT $intro , $any_module  , $any_module , "" , "", "";
    }

    print OUT "<H3>Function index:</H3>";
    print OUT "<table><tr><td><b>Function name</b></td><td><b>File name</b></td></tr>";

    my @entries = ();
    foreach my $f (values %{$g->{"files"}})
    {
	push @entries, @{$f->{"provides"}};
    }

    for my $one ( sort {$a->{"signature"} cmp $b->{"signature"}} @entries )
    {
	if($one->{"kind"} ne "info")
	{
	    print OUT "<tr><td><a href=\"";
	    print OUT html_name ($one->{"file"});
	    print OUT "#";
	    print OUT $one->{"name"};
	    print OUT "\">";
	    print OUT escape_ltgtamp ($one->{"signature"});
	    print OUT "</a></td><td><a href=\"";
	    print OUT html_name ($one->{"file"});
	    print OUT "\">";
	    print OUT $one->{"file"};
	    print OUT "</a></td></tr>\n";
	}
    }
    print OUT "</table>";

    # files.html, or into index.html
    if ($new)
    {
	$index = $output_dir."files.html";

	print STDERR "Writing $index\n";
	open(FOUT,">$index") or die "Cannot open file $index: $!";
	printf FOUT $intro , $any_module  , $any_module , "<a href=\"index.html\">functions</a>", "<a href=\"files.html\">files</a>", "<a href=\"intro.html\">intro</a>";
    }
    else
    {
	open (FOUT, ">&OUT");
    }
    print FOUT "<H3>File index:</H3>";
    print FOUT "<table><tr><td><b>File name</b></td></tr>";
    for my $one ( sort keys %{$g->{"files"}} )
    {
	printf FOUT "<tr><td><a href=\"%s\">%s</a></td></tr>", html_name($one), $one;
    }
    if ($new)
    {
	print FOUT "</table>";
	print FOUT $outro;
    }
    close FOUT;

    print OUT "</table>";
    print OUT $outro;
    close OUT;

    # intro.html
    if ($new)
    {
	$index = $output_dir."intro.html";

	print STDERR "Writing $index\n";
	open(OUT,">$index") or die "Cannot open file $index: $!";

	printf OUT $intro , $any_module  , $any_module , "<a href=\"index.html\">functions</a>", "<a href=\"files.html\">files</a>", "<a href=\"intro.html\">intro</a>";
	print OUT "<H3>Introduction:</H3>";
	print OUT $g->{"intro_html"};
	print OUT $outro;
	close OUT;
    }
}

sub item_index ($@)
{
    my ($title, @items) = @_;
    if (@items > 0)
    {
	print OUT "<H1>$title</H1>\n<ul>\n";
	for my $one ( sort @items )
	{
	    print OUT "<li>$one</li>\n";
	}
	print OUT "</ul>\n";
    }
}

##
## write one html file (both header and functions)
##
sub write_onefile ($$)
{
    my ($file, $f) = @_;
    my $parsed_header = $f->{"header"};
    my $htmlfn = $output_dir . html_name ($file);

    if ( $output_stdout )
    {
	open(OUT,">>/dev/fd/1");
    }
    else
    {
	print STDERR "Writing $htmlfn\n";
	open(OUT,">$htmlfn") or die "Cannot open file $htmlfn: $!";
    }

    $parsed_header->{"module"} ||= "Unknown YCP Module";

    if($new_index_style)
    {
	printf OUT ($intro,
		    $parsed_header->{"module"}, $parsed_header->{"module"},
		    "<a href=\"index.html\">functions</a>",
		    "<a href=\"files.html\">files</a>",
		    "<a href=\"intro.html\">intro</a>");
    }
    else
    {
	printf OUT ($intro,
		    $parsed_header->{"module"} , $parsed_header->{"module"},
		    "", "", "");
    }

    #
    # create header
    #
    print OUT $headintro;

    print OUT "<TD><H1>$parsed_header->{\"module\"}</H1></TD>\n";
    if ( defined $parsed_header->{"file"} )
    {
	print OUT "<TD VALIGN=\"top\" ALIGN=\"right\"><TT>$parsed_header->{\"file\"}</TT></TD>\n";
    }
    print OUT "</tr>\n<tr><td>";
    if ( defined $parsed_header->{"summary"} )
    {
	print OUT "$parsed_header->{\"summary\"}";
    }
    print OUT "</td></tr>\n<tr><td>";
    if ( @{$parsed_header->{"authors"}} )
    {
	print OUT "<ul>\n";
	foreach ( @{$parsed_header->{"authors"}} )
	{
	    print OUT "<li>$_</li>\n";
	}
	print OUT "</ul>\n";
    }
    print OUT $headfil;
    if ( defined $parsed_header->{"descr"} )
    {
	print OUT "$parsed_header->{\"descr\"}\n";
    }

    if ( defined $parsed_header->{"depends"} )
    {
	print OUT "<H1>Depends on</H1>\n";
	print OUT "$parsed_header->{\"depends\"}\n";
    }

    #
    # Create include index
    #
    my @imports = ();
    my @includes = ();

    for my $one (@{$f->{"requires"}})
    {
	if ($one->{"kind"} eq "import")
	{
	    push (@imports, $one->{"name"});
	}
	elsif ($one->{"kind"} eq "include")
	{
	    push (@includes, $one->{"name"});
	}
	elsif ($one->{"kind"} eq "module" && !$output_stdout)
	{
	    my $n = $one->{"name"};
	    # a hack to write a part of module index:
	    (my $modhtmlfn = $htmlfn) =~ s/html$/mod.html/;
	    (my $htmlbase = $htmlfn) =~ s{.*/}{};
	    print STDERR "Writing $modhtmlfn\n";
	    open (MOUT,">$modhtmlfn") or die "Cannot open file $modhtmlfn: $!";
	    print MOUT "<a href=\"$htmlbase\">$n</a>\n";
	    close (MOUT);
	}
    }


    item_index ("Imports", @imports);
    item_index ("Includes", @includes);

    #
    # Create variable and function index
    #
    my @global_variables = ();
    my @global_functions = ();
    my @local_variables = ();
    my @local_functions = ();
    my @scruples = ();

    for my $one ( @{$f->{"provides"}} )
    {
	if ($one->{"kind"} eq "variable")
	{
	    my $n = $one->{"name"};
	    if ($one->{"global"})
	    {
		push (@global_variables, "<a href=\"#$n\">$n</a>");
	    }
	    else
	    {
		push (@local_variables, "<a href=\"#$n\">$n</a>");
	    }
	}
	elsif ($one->{"kind"} eq "function")
	{
	    my $n = $one->{"name"};
	    my @params = ();
	    foreach my $param (@{$one->{"parameters"}})
	    {
		push (@params, $param->{"type"}." ".$param->{"name"});
	    }
	    $one->{"signature"} = $n ." (". join (", ", @params) .")";
	    my $sig = escape_ltgtamp ($one->{"signature"});
	    if ($one->{"global"})
	    {
		push (@global_functions, "<a href=\"#$n\">$sig</a>");
	    }
	    else
	    {
		push (@local_functions, "<a href=\"#$n\">$sig</a>");
	    }
	}
	elsif ($one->{"kind"} eq "scruple")
	{
	    my $n = $one->{"name"};
	    push (@scruples, "<a href=\"#$n\">$n</a>");
	}
    }

    item_index ("Structures", @scruples);
    item_index ("Global Variables", @global_variables);
    item_index ("Global Functions", @global_functions);
    item_index ("Local Variables", @local_variables);
    item_index ("Local Functions", @local_functions);

    print OUT $headoutro;

    #
    # for each export...
    #
    for my $one ( @{$f->{"provides"}} )
    {
	# skip scruple stubs
	next if ($one->{"kind"} eq "scruple");

	if($one->{"kind"} eq "info")
	{
	    # if we did not print the header, the info text could be
	    # mistaken to belong to another function
	    printf OUT $infohead;
	}
	else
	{
	    my $gl = $one->{"global"} ? "global":"local";
	    $one->{"signature"} ||= $one->{"name"};
	    my $sep = $one->{"type"} ? "-&gt;" : "";
	    printf OUT $functionhead, $gl, escape_ltgtamp ($one->{"signature"}), $one->{"name"}, $sep , escape_ltgtamp ($one->{"type"});
	}

	if ($one->{"deprecated"} ne "")
	{
	    print OUT "<p><em>This function is deprecated.";
	    if( $one->{"deprecated"} ne "magicnumber" )
	    {
		print OUT " Use ";
		print OUT make_ahref ($one->{"deprecated"});
		print OUT " instead.";
	    }
	    print OUT "</em></p>\n";
	}

        print OUT $functiondescintro;
        print OUT subst_refs ($one->{"short"});
        print OUT $functiondescoutro;
        foreach my $para (@{$one->{"descr"}})
        {
            print OUT $functiondescintro;
            print OUT $para;
            print OUT $functiondescoutro;
        }

	if (@{$one->{"scruple"}} == 2)
	{
	    print OUT ("<p>Structure ",
		       "<b><a name=\"",
		       $one->{"scruple"}->[0],
		       "\">",
		       $one->{"scruple"}->[0],
		       "</a></b>\n");
	    print OUT "<pre>", subst_refs ($one->{"scruple"}->[1]), "</pre>\n";
	    print OUT "</p>\n";
	}

	if (@{$one->{"parameters"}} > 0)
	{
	    print OUT $functionparamsintro;
	    foreach my $param (@{$one->{"parameters"}})
	    {
		print OUT $functionparamintro;
		print OUT $param->{"name"};
		print OUT $functionparamfil;
		print OUT subst_refs ($param->{"description"});
		print OUT $functionparamoutro;
	    }
	    print OUT $functionparamsoutro;
	}
	if ($one->{"return"} ne "")
	{
	    print OUT $functionretintro;
#	    print OUT escape_ltgtamp ($one->{"type"}); # uncomment this to see return type in Returns:
	    print OUT $functionretfil;
	    print OUT subst_refs ($one->{"return"});
	    print OUT $functionretoutro;
	}

	if ($one->{"example"} ne "")
	{
	    printf OUT $genericintro, "Example";
	    print OUT '<pre>' . $one->{"example"} . '</pre>';
	    print OUT $genericoutro;
	}
	if ($one->{"since"} ne "")
	{
	    printf OUT $genericintro, "Since";
	    print OUT $one->{"since"};
	    print OUT $genericoutro;
	}
	if (@{$one->{"see"}} > 0)
	{
	    printf OUT $genericintro, "See";
	    for my $see (@{$one->{"see"}})
	    {
		print OUT make_ahref ($see), "\n";
	    }
	    print OUT $genericoutro;
	}
    }
    print OUT $outro;

    close(OUT);
}

sub subst_refs ($)
{
    $_[0] =~ s/\@ref\s+(\S+)/make_ahref($1)/eg;
    return $_[0];
}

sub make_ahref ($)
{
    my $see = shift;
    my $out;
    # <...
    # HTML ref.
    if ($see =~ /^</)
    {
	$out = $see;
    }
    # file#
    # ref. to file without function
    elsif ($see =~ /(.*)\#$/)
    {
	$out = "<a href=\"".html_name($1)."\">".$1."</a>";
    }
    # file#item
    elsif ($see =~ /(\S+)\#(.*)/)
    {
	$out = "<a href=\"".html_name($1)."#".$2."\">".$2." in ".$1."</a>";
    }
    # #item
    # item
    else
    {
	$see =~ /\#?(.*)/;
	$out = "<a href=\"#$1\">$1</a>";
    }
    return $out;
}


package ycpdoc::XML;

use IO qw(File);

my $writer;

sub write_docs
{
    my $output = new IO::File(">$xml_output");
    $writer = new XML::Writer (OUTPUT => $output, NEWLINES => 1);
    $writer->xmlDecl ();
    $writer->startTag ("ycpdoc");
    dump_data ($g);
    $writer->endTag ();
    $writer->end ();
    $output->close ();
}

sub dump_data
{
    my $node = shift;

    if (!ref ($node))
    {
	$writer->characters ($node);
    }
    elsif (ref ($node) eq "ARRAY")
    {
	my $t = tied(@{$node});
	foreach (@{$node})
	{
	    my $end = 1;
	    if (defined ($t))
	    {
		$writer->startTag (ref ($t)."_item");
	    }
	    elsif (!ref ($_))
	    {
		$writer->startTag ("ITEM");
	    }
	    else
	    {
		$end = 0;
	    }
	    dump_data ($_);
	    if ($end)
	    {
		$writer->endTag ();
	    }
	}
    }
    elsif (ref ($node) eq "HASH")
    {
	my $t = tied(%{$node});
	foreach (sort keys %{$node})
	{
	    next if (!defined $node->{$_} || $node->{$_} eq "");
	    if (defined ($t))
	    {
		$writer->startTag (ref ($t)."_item", "key" => $_);
	    }
	    else
	    {
		$writer->startTag ($_);
	    }
	    dump_data ($node->{$_});
	    $writer->endTag ();
	}
    }
    else
    {
	$writer->comment (ref($node));
    }
}

package file;
@file::ISA = ("Tie::StdHash");

package requires;
@requires::ISA = ("Tie::StdArray");

package provides;
@provides::ISA = ("Tie::StdArray");

package descr;
@descr::ISA = ("Tie::StdArray");

package example_file;
@example_file::ISA = ("Tie::StdArray");
package parameters;
@parameters::ISA = ("Tie::StdArray");

package see;
@see::ISA = ("Tie::StdArray");

package main;
main ();
