#***************************************************************************
#                            kalyptusCxxToPerl.pm -  Generates perl .pig templates
#                             -------------------
#    begin                : Fri Jan 25 12:00:00 2000
#    copyright            : (C) 2002 Lost Highway Ltd. All Rights Reserved.
#    email                : Richard_Dale@tipitina.demon.co.uk
#    author               : Richard Dale.
#***************************************************************************/

#/***************************************************************************
# *                                                                         *
# *   This program is free software; you can redistribute it and/or modify  *
# *   it under the terms of the GNU General Public License as published by  *
# *   the Free Software Foundation; either version 2 of the License, or     *
# *   (at your option) any later version.                                   *
# *                                                                         *
#***************************************************************************/

package kalyptusCxxToPerl;

use File::Path;
use File::Basename;

use Carp;
use Ast;
use kdocAstUtil;
use kdocUtil; 
use Iter;
use kalyptusDataDict;

use strict;
no strict "subs";

use vars qw/ @clist $host $who $now $gentext %functionId $parentClass $qtdocTop $kdedocTop
	$lib $rootnode $outputdir $opt $debug $typeprefix 
	$signalCount $eventHandlerCount $constructorCount $hasDestructor $virtualFnCount $protectedFnCount *PIGSOURCE  /;


sub writeDoc
{
	( $lib, $rootnode, $outputdir, $opt ) = @_;

	$debug = $main::debug;

	mkpath( $outputdir ) unless -f $outputdir;


	# Document all compound nodes
	Iter::LocalCompounds( $rootnode, sub { writeClassDoc( shift ); } );

}




=head2 writeClassDoc

	Write documentation for one compound node.

=cut

sub writeClassDoc
{
	my( $node ) = @_;

	print "Enter: $node->{astNodeName}\n" if $debug;

	my $typeName = $node->{astNodeName}."*";

	if ( kalyptusDataDict::ctypemap($typeName) eq () ) {
		$typeprefix = ($typeName =~ /^Q/ ? "qt_" : "kde_");
		kalyptusDataDict::setctypemap($typeName, $typeprefix.$node->{astNodeName}."*");
		print "'$typeName' => '$typeprefix$typeName',\n";
	} elsif ( kalyptusDataDict::ctypemap($typeName) =~ /^qt_/ ) {
		$typeprefix = "qt_";
	} elsif ( kalyptusDataDict::ctypemap($typeName) =~ /^kde_/ ) {
		$typeprefix = "kde_";
	}

	my $docnode = $node->{DocNode};
	my @list = ();
	my $version = undef;
	my $author = undef;


	if( $#{$node->{Kids}} < 0 || $node->{Access} eq "private" || exists $node->{Tmpl} ) {
		return;
	}

	my $file = "$outputdir/".join("__", kdocAstUtil::heritage($node)).".pig";
	open( PIGSOURCE, ">$file" ) || die "Couldn't create $file\n";


	my $short = "";
	my $extra = "";
	my $sourcename = $node->{Source}->{astNodeName};
	$sourcename =~ s!.*/(.*)!$1!m;

	print PIGSOURCE "#include <",$sourcename , ">\n\n";

		# ancestors
	my @ancestors = ();
	Iter::Ancestors( $node, $rootnode, undef, undef,
		sub { # print
			my ( $ances, $name, $type, $template ) = @_;
			if ( $name ne "Qt" ) {
				push @ancestors, $name;
			}
			},
			undef
		);

	%functionId = ();
	$signalCount = 0;
	$eventHandlerCount = 0;
	$constructorCount = 0;
	$hasDestructor = 0;
	$virtualFnCount = 0;
	$protectedFnCount = 0;

	Iter::MembersByType ( $node,
		sub {  $_[0], ""; print PIGSOURCE "", $_[0], "";  },
		sub {	my ($node, $kid ) = @_;
                 preParseMember( $node, $kid );
               },
		sub {  print PIGSOURCE ""; }
	);
	
	my $ancestor;

	if ( $virtualFnCount == 0 ) {
		print PIGSOURCE (scalar keys %functionId ? "struct " : "namespace "), $node->{astNodeName};  	
		if ( $#ancestors < 0 ) {
			print PIGSOURCE " ";
		} else {
			print PIGSOURCE " : ";
			foreach $ancestor ( @ancestors ) {
				print PIGSOURCE "$ancestor ";
			}
		}
	} else {
		print PIGSOURCE "suicidal virtual class ", $node->{astNodeName};
		if ( $#ancestors < 0 ) {
			print PIGSOURCE " ";
		} else {
			print PIGSOURCE " : virtual ";
			foreach $ancestor ( @ancestors ) {
				print PIGSOURCE "$ancestor ";
			}
		}
	}

	print PIGSOURCE "{\n";

	Iter::MembersByType ( $node,
		sub { print PIGSOURCE "", $_[0], ""; print PIGSOURCE "", $_[0], "";  },
		sub {	my ($node, $kid ) = @_;
                 generateEnums( $node, $kid );
               },
		sub { print PIGSOURCE ""; print PIGSOURCE ""; }
	);

	Iter::MembersByType ( $node,
		sub { print PIGSOURCE "", $_[0], ""; print PIGSOURCE "", $_[0], "";  },
		sub {	my ($node, $kid ) = @_;
                 generatePigMethods( $node, $kid, "public" );
               },
		sub { print PIGSOURCE ""; print PIGSOURCE ""; }
	);

	if ( $node->{astNodeName} =~ /^(QBrush|QColor|QCursor|QFont|QImage|QPalette|QPixmap|QPoint|QPointArray|QRect|QRegion|QSize|QWMatrix)$/ ) {
		print PIGSOURCE "    const char *{serial} operator << () const : pig_serialize(\$this);\n";
		print PIGSOURCE "    void operator >> (const char *{serial}) : pig_deserialize(\$this, \$1);\n";
	}

	if ( $protectedFnCount > 0 ) {
		print PIGSOURCE "protected:\n";
	}

	Iter::MembersByType ( $node,
		sub { print PIGSOURCE "", $_[0], ""; print PIGSOURCE "", $_[0], "";  },
		sub {	my ($node, $kid ) = @_;
                 generatePigMethods( $node, $kid, "protected" );
               },
		sub { print PIGSOURCE ""; print PIGSOURCE ""; }
	);
	if ( $node->{astNodeName} eq 'Qt' ) {
		print PIGSOURCE "} Qt;\n";
	} elsif ( kalyptusDataDict::ctypemap($typeName) =~ /^qt_/ && $node->{astNodeName} =~ /^Q(.*)/ ) {
		print PIGSOURCE "} Qt::", $1, ";\n";
	} elsif ( kalyptusDataDict::ctypemap($typeName) =~ /^kde_/  && $node->{astNodeName} =~ /^K(.*)/  ) {
		print PIGSOURCE "} KDE::", $1, ";\n";
	}

	print PIGSOURCE "\n";
	close PIGSOURCE;


}


sub preParseMember
{
	my( $class, $m ) = @_;
	my $name = $m->{astNodeName};

	if( $m->{NodeType} eq "method" ) {
		if ( $functionId{$name} eq "" ) {
			$functionId{$name} = 0;
		} else {
			$functionId{$name}++;
		}

		if ( $name eq $class->{astNodeName} && $m->{Access} ne "private" ) {
			$constructorCount++;
			if ( $m->{Type} =~ /~/ ) {
				$hasDestructor = 1;
			}
		}
		
		if ( $name =~ /~$class->{astNodeName}/ && $m->{Access} ne "private" ) {
			$hasDestructor = 1;
		}
		
		if ( $m->{Flags} =~ "v" ) {
			$virtualFnCount++;
		}
		
		if ( $m->{Access} =~ /^protected/ or $m->{Flags} =~ "n") {
			$protectedFnCount++;
		}
    }

	if( $m->{NodeType} eq "enum" ) {
		# Add a C++ to C type mapping for this enum - an int in C
		$name =~ s/\s//g;
		kalyptusDataDict::setctypemap($name, 'int');
		$name = $class->{astNodeName}."::".$name;
		kalyptusDataDict::setctypemap($name, 'int');
	}
}


sub generatePigMethods
{
	my( $class, $m, $access ) = @_;
	my $name;
	my $function;

	$name = $m->{astNodeName} ;
	my $type = $m->{NodeType};
	my $docnode = $m->{DocNode};
	
	if( $type eq "method"
		&& ($m->{Access} =~ /^$access/ || ($m->{Access} =~ /signals/ && $access eq "protected")) )
	{
		if ( $m->{ReturnType} =~ /[<>]/ || $m->{Params} =~ /[<>]/ ) {
			return;
		}

		my $returnType = $m->{ReturnType};
		$returnType =~ s/friend|inline//g;
		$returnType =~ s/^\s*//g;
		$returnType =~ s/\s*$//g;
		my $cparams = $m->{Params};
		my $cplusplusparams;
		if ( $cparams =~ /\s*\)\s*:\s*/ ) {
			$cparams =~ s/(.*)\s*\)\s*:\s*.*$/$1/;
		}

		$cparams =~ s/\s+/ /g;
		$cparams =~ s/\s*([,\*\&])\s*/$1 /g;
		$cparams =~ s/^\s*void\s*$//;
		$cparams =~ s/^\s*$//;
		my $argId = 0;
		my @cargs = split(",", $cparams);
		$cparams = "";
		foreach my $arg ( @cargs ) {
			my $argType;
			my $cargType;
			my $defaultparam;
			$arg =~ s/\s*([^\s].*[^\s])\s*/$1/;
			$arg =~ s/(\w+)\[\]/\* $1/;

			if ( $arg =~ s/=\s*(("[^"]*")|(\'.\')|(([-\w:]*)\s*(\|\s*[-\w]*)*(\(\w*\))?))// ) {
				$defaultparam = $1;

				if ( $defaultparam =~ /(.*)::(.*)/ && kalyptusDataDict::ctypemap($defaultparam) eq ()) {
					$defaultparam = "$1::$2";
				} else {
					if ( kalyptusDataDict::ctypemap($defaultparam) eq () ) {
						if ( $defaultparam =~ /^[A-Z].*[^\)]$/ ) {
							$defaultparam = $class->{astNodeName}."::".$defaultparam;
                   				}
					}
				}

				$defaultparam = " = ".$defaultparam;
			}

			$argId++;
			
			if ( $arg =~ /(.*)\s+(\w+)\s*$/ ) {
				$argType = $1;
				$arg = $2;
			} else {
				$argType = $arg;
				$arg = "arg".$argId;
			}
			                        			
			$cargType = kalyptusDataDict::ctypemap($argType);

			if ( $argType =~ /^[A-Z][^:]*$/ && $cargType eq "int" && kalyptusDataDict::ctypemap($class->{astNodeName}."::".$argType) ne "" ) {
				$cplusplusparams .= $class->{astNodeName}."::$argType$defaultparam, ";
			} elsif ( $argType =~ /^\s*WFlags\s*$/ ) {
				$cplusplusparams .= "QWidget::WFlags$defaultparam, ";
			} elsif ( $argType =~ /^\s*ArrowType\s*$/ ) {
				$cplusplusparams .= "Qt::ArrowType$defaultparam, ";
			} elsif ( $argType =~ /^\s*Orientation\s*$/ ) {
				$cplusplusparams .= "Qt::Orientation$defaultparam, ";
			} elsif ( $argType =~ /^\s*BrushStyle\s*$/ ) {
				$cplusplusparams .= "Qt::BrushStyle$defaultparam, ";
			} elsif ( $argType =~ /^\s*BGMode\s*$/ ) {
				$cplusplusparams .= "Qt::BGMode$defaultparam, ";
			} elsif ( $argType =~ /^\s*PenCapStyle\s*$/ ) {
				$cplusplusparams .= "Qt::PenCapStyle$defaultparam, ";
			} elsif ( $argType =~ /^\s*PenStyle\s*$/ ) {
				$cplusplusparams .= "Qt::PenStyle$defaultparam, ";
			} elsif ( $argType =~ /^\s*PenJoinStyle\s*$/ ) {
				$cplusplusparams .= "Qt::PenJoinStyle$defaultparam, ";
			} elsif ( $argType =~ /^\s*RasterOp\s*$/ ) {
				$cplusplusparams .= "Qt::RasterOp$defaultparam, ";
			} elsif ( $argType =~ /^\s*TextFormat\s*$/ ) {
				$cplusplusparams .= "Qt::TextFormat$defaultparam, ";
			} elsif ( $argType =~ /^\s*QDragMode\s*$/ ) {
				$cplusplusparams .= "QDragObject::DragMode$defaultparam, ";
			} elsif ( $argType =~ /^\s*GUIStyle\s*$/ ) {
				$cplusplusparams .= "Qt::GUIStyle$defaultparam, ";
			} elsif ( $argType =~ /^\s*Type\s*$/ ) {
				$cplusplusparams .= "QEvent::Type$defaultparam, ";
			} elsif ( $argType =~ /^\s*(const\s+)?QObject\s*\*\s*$/ && $arg eq 'receiver') {
				$cplusplusparams .= $argType."{".($name =~/disconnect/i ? 'unreceiver' : 'receiver')."(".($argId+1).")}$defaultparam, ";	
			} elsif ( $argType =~ /^\s*const\s+char\s*\*\s*$/ && ($arg eq 'member' || $arg eq 'slot') ) {
				$cplusplusparams .= $argType."{member(".($argId-1).")}$defaultparam, "; 
			} else {
				$cplusplusparams .= $argType.$defaultparam.", ";
			}
		}
		$cplusplusparams =~ s/\s*,\s*$//g;
		$cplusplusparams =~ s/\s*,/,/g;

		if ( $returnType =~ /^[A-Z][^:]*$/ && kalyptusDataDict::ctypemap($returnType) eq "int" && kalyptusDataDict::ctypemap($class->{astNodeName}."::".$returnType) ne "" ) {
			$returnType = $class->{astNodeName}."::$returnType";
		} elsif ( $returnType =~ /^\s*WFlags\s*$/ ) {
			$returnType = "QWidget::WFlags";
		} elsif ( $returnType =~ /^\s*ArrowType\s*$/ ) {
			$returnType = "Qt::ArrowType";
		} elsif ( $returnType =~ /^\s*Orientation\s*$/ ) {
			$returnType = "Qt::Orientation";
		} elsif ( $returnType =~ /^\s*BrushStyle\s*$/ ) {
			$returnType = "Qt::BrushStyle";
		} elsif ( $returnType =~ /^\s*BGMode\s*$/ ) {
			$returnType = "Qt::BGMode";
		} elsif ( $returnType =~ /^\s*PenCapStyle\s*$/ ) {
			$returnType = "Qt::PenCapStyle";
		} elsif ( $returnType =~ /^\s*PenStyle\s*$/ ) {
			$returnType = "Qt::PenStyle";
		} elsif ( $returnType =~ /^\s*PenJoinStyle\s*$/ ) {
			$returnType = "Qt::PenJoinStyle";
		} elsif ( $returnType =~ /^\s*RasterOp\s*$/ ) {
			$returnType = "Qt::RasterOp";
		} elsif ( $returnType =~ /^\s*TextFormat\s*$/ ) {
			$returnType = "Qt::TextFormat";
		} elsif ( $returnType =~ /^\s*QDragMode\s*$/ ) {
			$returnType = "QDragObject::DragMode";
		} elsif ( $returnType =~ /^\s*GUIStyle\s*$/ ) {
			$returnType = "Qt::GUIStyle";
		} elsif ( $returnType =~ /^\s*Type\s*$/ ) {
			$returnType = "QEvent::Type";
		}

		my $flags = $m->{Flags};

		if ( !defined $flags ) {
			warn "Method ".$m->{astNodeName}.  " has no flags\n";
		}

		my $extra = "";
		$extra .= "static " if $flags =~ "s";

		if ( $m->{Flags} =~ "v" ) {
			if ( $m->{Flags} =~ "p" ) {
				print PIGSOURCE "    abstract ";
			} else {
				print PIGSOURCE "    virtual ";
			}
		} else {
			print PIGSOURCE "    ";
		}

		if ( $name eq $class->{astNodeName} ) {
			if ( $returnType =~ "~" ) {
				print PIGSOURCE ($m->{Flags} =~ "v" ?"":"virtual")," ~", $name, "();\n";
			} else {
				print PIGSOURCE $extra, $name, "(", $cplusplusparams, ");\n";
			}
		} else {
			if ( $m->{Access} =~ /slots/ ) {
				print PIGSOURCE "$extra$returnType $name(", $cplusplusparams, ") slot;\n",
			} elsif ( $m->{Access} =~ /signals/ ) {
				print PIGSOURCE "$extra$returnType $name(", $cplusplusparams, ") signal;\n",
			} elsif ( $name =~ /operator(.*)/ ) {
				if ( $argId == 2 ) {
					print PIGSOURCE "$extra$returnType operator $1 (", $cplusplusparams, ") : operator $1 (\$0, \$1);\n",
				} else {
					print PIGSOURCE "$extra$returnType operator $1 (", $cplusplusparams, ")", ($m->{Flags} =~ "c" ? " const" : ""), ";\n",
				}
			} else {
				print PIGSOURCE "$extra$returnType $name(", $cplusplusparams, ")", ($m->{Flags} =~ "c" ? " const" : ""), ";\n",
			}
		}
	}

}


sub generateEnums
{
	my( $class, $m ) = @_;
	
	if( $m->{NodeType} eq "enum" ) {
		my $enumtext = "    enum".$m->{astNodeName}." { "; 

		my @enums = split(",", $m->{Params});
		foreach my $enum ( @enums ) {
			$enum =~ s/\s//g;
			if ( $enum =~ /(.*)=(.*)/ ) {
				$enumtext .= "$1, "; 
			} else {
				$enumtext .= "$enum, "; 
			}
		}

		$enumtext =~ s/, $//;
		print PIGSOURCE "$enumtext };\n"; 
	}
	
	if ( $class->{astNodeName} eq 'Qt' && $m->{NodeType} eq 'var' ) {
		my $type = $m->{Type};
		$type =~ s/QT_STATIC_CONST\s+([\w-]+).*$/$1/ or return;		
		print PIGSOURCE "    extern const $type $m->{astNodeName};\n";
	}
		
}


=head2 printIndexEntry

	Parameters: member node

	Prints an index entry for a single node.

	TODO: stub

=cut

sub printIndexEntry
{
	my ( @node ) = @_;
}



sub writeSrcHTML
{
	my ( $outfile, $infile ) = @_;

	open ( OUT, ">$outfile" ) || die "Couldn't open $outfile for".
			"writing.\n";


	close OUT;
}

1;




