#!/usr/bin/perl -w
#
#

use strict;
use Data::Dumper;
use XML::Writer;
use Tie::Hash;
use Tie::Array;
use Getopt::Long;
use File::Basename;
use FileHandle;


my $xml_output = "output.xml";
my $debug = 0;
my $supported = "builtin|widget";
my $prog;
my ($filename,$filepath,$filesuffix);
my $file_summary;
my $namespace; # The namespace to use when referencing the functions
my $screenshot_dir = "examples/screenshots";

my $f = {};

sub parse_arguments
{
##
## find switches
##
    Getopt::Long::Configure ("bundling");
    GetOptions (
		"output-file|o=s" => \$xml_output,
		"debug|d=i" => \$debug,
	       );

}
sub scan_file ($)
{
    my ($file) = @_;

    my $in_comment = 0;
    my $line = '';                      # collected input line
    my $comment = '';                   # last comment block
    my $kind;
    my @comments = ();
    my $parse = 0;

    print "## processing $file\n" if $debug > 0;
    open FILE, '<', $file or die "$prog: cannot open $file: $!\n";

    my $valid_comment = 0;
    while (<FILE>)
    {
        while (s/\\\n$//)               # line continuation
        {
            last unless defined (my $line = <FILE>);
            $line =~ s%^\s*//+\s?%% unless $in_comment;
            $line =~ s/^\s*(?:\*\s|\*$)?// if $in_comment;
            $_ .= $line;
        }

        s/^\s+//;                       # trim whitespace
        s/\s+$//;

        if ($in_comment)                # inside multi-line comment
        {
            s/^\*(?:\s|$)//;
            if (s%\s*\*+/%%)            # end of multi-line comment
            {
                $in_comment = 0;
                $parse = 1;
            }
            if ( /Summary:(.*)/ )
            {
                $file_summary=$1;
                $file_summary=~ s/^\s+//;
            }
            elsif ( /Namespace:(.*)/ )
            {
                $namespace=$1;
                $namespace=~ s/^\s+//;
            }
            elsif( /\@(widget|builtin)(.*)/)
            {
                $valid_comment = 1;
            }
            push @comments, $_;
        }
        elsif (s%^/\*+\s*%%)               # begin of multi-line comment
        {
            $in_comment = 1;
        }             

        if ($parse==1)
        {
            if ($valid_comment == 1 )
            {
	        push (@{$f->{"entries"}}, parse_comments ( @comments));
            }
            $parse = 0;
            $valid_comment = 0;
            @comments = ();
        }
    }

    print Dumper($f) if $debug > 5;

    close FILE;
}


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

    my $lastwas = "";

    my $oex = {};
    $oex->{"example"} = "";
    $oex->{"screenshot"} = "";

    my $oentry = {};
    $oentry->{"type"} = "";
    $oentry->{"name"} = "";
    $oentry->{"description"} = [];
    tie @{$oentry->{"description"}}, "odescription";

    my $entry = {};
    $entry->{"names"} = [];
    tie @{$entry->{"names"}}, "names";

    $entry->{"return"} = {};
    tie %{$entry->{"return"}}, "return";

    $entry->{"filename"} = $filename;
    $entry->{"file_summary"} = $file_summary;
    $entry->{"namespace"} = $namespace;
    $entry->{"type"} = "";
    $entry->{"parameters"} = [$oentry];
    tie @{$entry->{"parameters"}}, "parameters";

    $entry->{"since"} = "";
    $entry->{"id"} = "";
    $entry->{"usage"} = "";
    $entry->{"class"} = "";
    $entry->{"screenshot"} = "";

    $entry->{"optargs"} = [$oentry];
    tie @{$entry->{"optargs"}}, "optargs";

    $entry->{"options"} = [$oentry];
    tie @{$entry->{"options"}}, "options";

    $entry->{"properties"} = [$oentry];
    tie @{$entry->{"properties"}}, "properties";

    $entry->{"examples"} = [];
    tie @{$entry->{"examples"}}, "examples";
    $entry->{"see"} = [];
    tie @{$entry->{"see"}}, "see";
    $entry->{"short"} = "";
    $entry->{"note"} = [];
    tie @{$entry->{"note"}}, "note";

    $entry->{"description"} = [];
    tie @{$entry->{"description"}}, "description";
    $entry->{"deprecated"} = "";
    my @entries = ($entry);

    my @param_incomment = ();	# parameter descriptions
    my @option_incomment = ();	# option descriptions
    my @optarg_incomment = ();	# optarg descriptions
    my @properties_collect = ();	# optarg descriptions

    my @description = ();
    my @note = ();
    my @examples = ();


    my $last_param;
    my $last_option;
    my $last_optarg;
    my $para = "";
    my $param_para = "";
    my $keepformat = 0;
    my $newpara = 0;
    my $widget_name = "";

    my ($pre, $post);

    # add newlines before all tags
    # multiline tags then can be proceeded one by one
    # even more descriptions or examples can be supported
    my @new_comments = ();
    foreach my $line (@comments) {
	if ($line =~ /^[ \t]*\@(note|description|example|examples|arg|optarg|param|builtin|widget|widgets|return|returns|id|since|class|short|usage|deprecated)( |\t|$)/) {
	    push @new_comments, "\n";
	}
	push @new_comments, $line;
    }
    push @new_comments, "\n";

    foreach my $line (@new_comments)
    {
        my $empty_line = $line;
        $empty_line =~ s/\s+//;

        if ($line =~ /<code>/ )
        {
            $keepformat = 1;
            $newpara =1 ;
        }
        elsif ($line =~ /<\/code>/ )
        {
            $keepformat = 0;
        }

	if($line =~ /\@(param|arg)\s+(.*)/o)
	{
	    $lastwas = "param";

            $oentry = {};
            my @odescr = ();
            ( $oentry->{'type'}, $oentry->{'name'}, my $d) = split ( '\s+', $2, 3 );
	    $last_param =  $oentry->{'name'};
            print "LASTPARAM " . $last_param . "\n" if $debug > 5;

            push @odescr, $d;
            $oentry->{'description'} = [];
            push @{$oentry->{'description'}},  @odescr;
	    push @param_incomment, $oentry;
            print Dumper(@param_incomment) if $debug > 2;
	}
	elsif($line =~ /\@option\s+(.*)/)
	{
	    $lastwas = "option";  
            $oentry = {};
            my @odescr = ();
            my $d;
            ( $oentry->{'name'}, $d) = split ( '\s+', $1, 2 );
	    $last_option =  $oentry->{'name'};
            push @odescr, $d;
            $oentry->{'description'} = [];
            push @{$oentry->{'description'}}, @odescr;
	    push @option_incomment, $oentry;
	}
	elsif($line =~ /\@optarg\s+(.*)/)
	{
            $oentry = {};
	    $lastwas = "optargs";  
            my @odescr = ();
            my $d;
            ( $oentry->{'type'}, $oentry->{'name'},  $d) = split ( '\s+', $1, 3 );
            $last_optarg = $oentry->{'name'};
            push @odescr, $d;
            $oentry->{'description'} = [];
            push @{$oentry->{'description'}}, @odescr;
	    push @optarg_incomment, $oentry;
	}
	elsif($line =~ /\@return\s+(.*)/)
	{
	    $lastwas = "return";  
            my ( $type, $descr) = split ( '\s+', $1, 2 );
            my $r= { "type" => $type, "description" => $descr};
	    $entry->{"return"} =  $r;
	}
	elsif ($line =~ /\@(widget|widgets)\s+(.*)/)
	{
	    $lastwas = "widget";
            $widget_name = $2;
            my @w = ();
            (@w) =  split( '\s+', $widget_name);
            push @{$entry->{"names"}}, @w;
	    $entry->{"type"} = "widget";
	}
	elsif ($line =~ /\@(builtin)\s+(.*)/)
	{
	    $lastwas = "builtin";
            my @w = ();
            (@w) =  split( '\s+', $2);
            push @{$entry->{"names"}}, @w;
	    $entry->{"type"} = "builtin";
	}
	elsif ($line =~ /\@id\s+(.*)/)
	{
	    $lastwas = "id";
	    $entry->{"id"} = $1;
	}
	elsif ($line =~ /\@since\s+(.*)/)
	{
	    $lastwas = "since";
	    $entry->{"since"} = $1;
	}
	elsif ($line =~ /\@class\s+(.*)/)
	{
	    $lastwas = "class";
            my $c = $1;
            my @props;
            if ( $c =~ '\(.*\)' )       # don't read Y(class-file).cc
            {
                # If we found a @class keyword with its contents in parentheses,
                # this means we are not supposed to read a
                # corresponding C++ source file (because there isn't one).

                @props = ();
                $c =~ s:\( *([^ ]*) *\):$1:
            }
            else        # read Yclass-file.cc
            {
                # Read the C++ source file corresponding to the widget class.
                # Assume a file name Y*.cc for it.

                @props = read_class_file ( $widget_name, $c );
                foreach my $property ( @props )
                {
                    $oentry = {};     
                    my @prop = split ( '\s+', $property, 3 );
                    $oentry->{type} = $prop[0]; shift @prop;
                    $oentry->{name} = $prop[0]; shift @prop;
                    $oentry->{description} = $prop[0]; 
                    push @properties_collect, $oentry;
                }
                push @{$entry->{"properties"}}, @properties_collect

            }
            $entry->{"class"} = $c;

	}
	elsif ($line =~ /\@short\s+(.*)/)
	{
	    $lastwas = "short";
	    $entry->{"short"} = $1;
	}
	elsif ($line =~ /\@note\s+(.*)/)
	{
	    $lastwas = "note";
	    $para = $1;
	}
	elsif ($line =~ /\@description\s*(.*)/)
	{
	    $lastwas = "description";
	    $para = $1;
	}
	elsif($line =~ /\@see\s+(.*)/)
	{
	    $lastwas = "see";  
	    $line = $1;

	    push @{$entry->{"see"}}, $line;
	}
	elsif($line =~ /\@examples?(.*)/)
	{
	    $lastwas = "examples";
	    $line =~ s/\@examples//; # remove it if it's there
	    $line =~ s/\@example//; # remove it if it's there
	    $line =~ s/\s+/ /; # remove empty spaces
            foreach my $e (split(/ /, $line)) {
                if ($e ne '')
                {
                    $oex = ();
                    my $screenshot = $e;
                    $screenshot =~ s/\.ycp$/.png/;
                    if ( -s "$screenshot_dir/$screenshot" )   # exists and non-zero size
                    {
                        $oex->{'example'} = $e;
                        $oex->{'screenshot'} = $screenshot;
                    } else {
                        $oex->{'example'} = $e;
                    }

                    push @examples, $oex;
                }
            }
	}
	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 =~ /\@usage(.*)/ || $lastwas eq "usage")
	{
	    $lastwas = "usage";
	    $line =~ s/\@usage//; # remove it if it's there
	    $entry->{"usage"} .= "\n $line";
	}
	elsif($line =~ /\@deprecated\s*(.*)/)
	{
	    $lastwas = "deprecated";
	    if( ($1) ne "" )
	    {
		$entry->{"deprecated"} .= $1;
	    }
	    else
	    {
		$entry->{"deprecated"} .= "magicnumber";
	    }
	}

	# continues on next line
	elsif($lastwas eq "optargs")
	{
            $lastwas = "optargs";
            $oentry = pop @optarg_incomment;
            if ($keepformat == 0)
            {
                $line =~ s/^\s+//;
                if ($line ne '') {
                    $line = " $line";
                }
            } 
            else 
            {
                $line = "\n$line";
            }
            my @a = ();
            my @b = ();


            if ($line eq "" || $newpara == 1 ) 
            { 
                if ($newpara == 1)
                {
                    push  @a, $line;
                    push @{$oentry->{'description'}} , @a;
                    push @optarg_incomment, $oentry;
                    $newpara = 0;
                } else {
                    $newpara = 1;
                    push @optarg_incomment, $oentry;
                }
            }
            else 
            {
                my $last =  pop @{$oentry->{'description'}};
                $last .= " $line";
                push  @a, $last;
                push @{$oentry->{'description'}} , @a;
                push @optarg_incomment, $oentry;
                $newpara = 0;
            }
	}
	elsif($lastwas eq "option")
	{
            $lastwas ="option";
            $oentry = pop @option_incomment;
            if ($keepformat == 0)
            {
                $line =~ s/^\s+//;
                if ($line ne '') {
                    $line = " $line";
                }
            } 
            else 
            {
                $line = "\n$line";
            }
            my @a = ();
            my @b = ();
            if ($line eq "" || $newpara == 1 ) 
            { 
                if ($newpara == 1)
                {
                    push  @a, $line;
                    push @{$oentry->{'description'}} , @a;
                    push @option_incomment, $oentry;
                    $newpara = 0;
                } else {
                    $newpara = 1;
                    push @option_incomment, $oentry;
                }
            }
            else 
            {
                my $last =  pop @{$oentry->{'description'}};
                $last .= " $line";
                push  @a, $last;
                push @{$oentry->{'description'}} , @a;
                push @option_incomment, $oentry;
                $newpara = 0;
            }
	}
	elsif($lastwas eq "param")
	{
            $lastwas = "param";
            $oentry = pop @param_incomment;
            $line =~ s/^\s+//;
            my @a = ();
            # UGLY 
            if ($line eq "" || $newpara == 1)
            { 
                if ($newpara == 1)
                {
                    push  @a, $line;
                    push @{$oentry->{'description'}} , @a;
                    push @param_incomment, $oentry;
                    $newpara = 0;
                } else {
                    $newpara = 1;
                    push @param_incomment, $oentry;
                }
            }
            else 
            {
                my $last =  pop @{$oentry->{'description'}};
                $last .= " $line";
                push  @a, $last;
                push @{$oentry->{'description'}} , @a;
                push @param_incomment, $oentry;
                $newpara = 0;
            }
	}
	elsif($lastwas eq "return")
	{
            $lastwas = "return";
            $line =~ s/^\s+//;
            $entry->{'return'}->{'description'} .= " $line";
	}
	elsif($lastwas eq "option")
	{
            my $o = $option_incomment[$#option_incomment]; # last element
            $line =~ s/^\s+//;
            $o->{"description"} .=$line;
	}
	elsif($lastwas eq "examples")
        {
            $lastwas = "examples";
            $oex = ();
	    $line =~ s/\s+/ /; # remove empty spaces
            foreach my $e (split(/ /, $line)) {
                if ($e ne '')
                {
                    my $screenshot = $e;
                    $screenshot =~ s/\.ycp$/.png/;
                    if ( -s "$screenshot_dir/$screenshot" )   # exists and non-zero size
                    {
                        $oex->{'example'} = $e;
                        $oex->{'screenshot'} = $screenshot;
                    } else {
                        $oex->{'example'} = $e;
                    }

                    push @examples, $oex;
                }
            }
        }
	elsif($lastwas eq "short" && $empty_line ne "")
        {
            $lastwas = "short";
	    $entry->{"short"} .= $line;
        }
	elsif($lastwas eq "note")
	{
            if ($empty_line eq "")
            { 
                if ($para ne "")
                {
	            push @note, $para;
                }
                $para = "";
            }
            else 
            {
                if ($keepformat == 0)
                {
                    $line =~ s/^\s+//;
                    if ($line ne '') {
                        $para .= " $line";
                    }
                } 
                else 
                {
                    $para .= "\n$line";
                }
            }
	}
	elsif($lastwas eq "short" || $lastwas eq "description")
	{
            if ($empty_line eq "")
            { 
                if ($para ne "")
                {
	            push @description, $para;
                }
                $para = "";
            }
            else 
            {
                if ($keepformat == 0)
                {
                    $line =~ s/^\s+//;
                    if ($line ne '') {
                        $para .= " $line";
                    }
                } 
                else 
                {
                    $para .= "\n$line";
                }
            }
	}
	elsif ($lastwas eq "")
	{
            $lastwas = "short";
	    $entry->{"short"} .= $line;
	}
        else {
        }
    }

    push @{$entry->{"description"}}, @description;
    push @{$entry->{"note"}}, @note;
    push @{$entry->{"examples"}}, @examples;


    # for commented parameters
    push @{$entry->{"parameters"}}, @param_incomment;

    # for commented options
    push @{$entry->{"options"}}, @option_incomment;

    # for commented optargs
    print "Final Optargs " . Dumper(@optarg_incomment) ."\n" if $debug > 3;

    push @{$entry->{"optargs"}}, @optarg_incomment;


    return @entries;
}


# Log a message to stderr.
#
# Parameters:
#	Messages to write (any number).

sub warning()
{
    my $msg;

    foreach $msg ( @_ )
    {
	print STDERR $msg . " ";
    }

    print STDERR "\n";
}

# Read the widget class file.
# Search through it for '@property' or '@properties' lines.
#
# Parameters:
#	$widget_name	The widget name(s).
#	$class_name	Widget C++ class name.
#
# Return value:
#	A list of properties for the widget.

sub read_class_file()
{
    my ( $widget_name, $class_name ) = @_;
    my $line;
    my $line_no = 0;
    my $keyword;
    my $contents;
    my @prop;

    if ( $class_name eq "" )
    {
        #warning ( "ERROR: Empty \@class specified for $widget_name" );
	return @prop;
    }

    my $class_file = FileHandle->new();

    my $class_file_name = $class_name . ".cc";
    $class_file_name	= $filepath . "/" . $class_file_name unless $filepath eq "";

    if ( ! open ( $class_file, $class_file_name ) )
    {
        #warning ( "ERROR: Can't open $class_file_name required for $widget_name" );
	return @prop;
    }


    $line = <$class_file>;
    $line_no++;

    while ( $line )
    {
	# Check for '@xyz' keywords

	if ( $line =~ '^\s*\*?\s*@.*' )
	{
	    # '@xyz' keyword found

	    $line =~ s/^\s*\*?\s*@//;	# remove '  * @' at beginning of line
	    ( $keyword, $contents ) = split ( '\s+', $line, 2 );


	    # Read follow-up lines for contents

	    $line = <$class_file>;
	    $line_no++;

	    while ( $line &&				# have one more line
		    ! ( $line =~ '^\s*\*?\s*@.*' ) &&	# no '@xyz' line
		    ! ( $line =~ '\s*\*/' ) )		# no */ line
	    {
		$line =~ s/^\s*\*?\s*//;	# remove '  * ' at beginning of line
		$contents .= $line;
		$line = <$class_file>;
		$line_no++;
	    }

	    chomp ( $contents );

	    if ( $keyword eq 'property'  ||
		 $keyword eq 'properties'   )
	    {
		push @prop, $contents;
	    }
	    else
	    {
                #warning ( "$class_file_name:$line_no: " .
                #	  "WARNING: Undefined keyword \@$keyword - ignored" );
	    }
        }
        else
        {
	    # no keyword found

	    $line = <$class_file>;
        }
    }

    # $class_file will be closed automatically by its destructor.

    return @prop;
}



sub main () 
{
    tie @{$f->{"entries"}}, "entries";
    parse_arguments();
    foreach my $arg (@ARGV) {
	($filename,$filepath,$filesuffix) = fileparse($arg,qr{\.cc});
	scan_file($arg);
    }
    yastdoc::XML::write_docs();

}

package yastdoc::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 ("yast2doc");
    dump_data ($f);
    $writer->endTag ();
    $writer->end ();
    $output->close ();
}

sub dump_data
{
    my $node = shift;
    if (!defined($node))
    {
	return;
    }

    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 entries;
@entries::ISA = ("Tie::StdArray");

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

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

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

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


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

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

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

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

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

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

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


package main;
main ();

