#!/usr/bin/perl

# This script helps create persister.plsql.

$header = "N";

print "-- GENERATED PLSQL FOLLOWS\n";
print "-- generated by makepersister.pl\n\n";


while (<>)
{
	if (/create table (\w+)_objects/)
    {
	$tablename = $1;
	

	&parseTable($tablename);
	
	$procname = $tablename;
	$procname =~ s/harvester\_installation/harvester\_inst/g;
	$procname =~ s/manufacture\_installation/manufacture\_inst/g;
	$procname =~ s/manufacture\_schematic/manf\_schematic/g;

	if ($tablename ne "player")
 	{
 		if ($header eq "Y")
		{
			&printSaveProcHeader($tablename);
			&printCreateProcHeader($tablename);
			&printRemoveProcHeader($tablename);
		}
		else
		{
			&printSaveProcBody($tablename);
			&printCreateProcBody($tablename);
			&printRemoveProcBody($tablename);
		}
  }

	reset columns;
	reset tags;
    }

    if (/create table objects/)
    {
	$tablename = "object";
	&parseTable($tablename);
#	&printSaveProc($tablename);
#	&printCreateProc($tablename);
	reset columns;
	reset tags;
    }
}

sub parseTable
{  

   my ($line);

   while (!/\;/)
    { 

	if ((!/key/) && (!/object_id/) && (/^\s+(\w+\s+\w.*)/) && (!/\-\-\s*NO_BIND/))
	{   
		$line = $1;
		/(\w+\s+\w+)/;
 	    push(@columns,$1);
		
		if ($line =~ /BindableNetworkId/) 
		{	push(@tags, 1); }
		else
		{	push(@tags, 0); }

	}
	$_=<>;
    }
}

sub printSaveProcBody
{ 
    my($tablename)=@_;
    my($notfirst,$name,$type, $i);
  
    print "\tprocedure save_${procname}_obj( ";
    $i=0;
  	print "p_object_id VAOFSTRING, ";
		foreach $column (@columns)
    {	
    	($name,$type)=split(" ",$column);
			if (!($tablename eq "player" and $name eq "num_lots"))
  		{	print "p_".VAType($column, $tags[$i]).", ";
   		}
			$i++;
    }

		print "p_chunk_size number )\n";
    print "\tas\n\n";
    print "\tm_enable_db_logging INTEGER := 0;\n";
    print "\tm_error_index INTEGER :=0;\n";
    
    print "\tbegin\n";
    if (@columns == 0)
    { print "\t\tnull;\n"; }
    else
    {
	print "\t\tFORALL i IN 1..p_chunk_size\n";
	print "\t\tupdate ${tablename}_objects set\n";
	foreach $column (@columns)
	{
	    ($name,$type)=split(" ",$column);
	    if ($notfirst!=0)
	    	{	print ",\n"; }
	    else
	    	{ $notfirst=1; }
	    	
	    print "\t\t\t${tablename}_objects.$name = nvl(p_$name(i),${tablename}_objects.$name)";
     	
	}
	print "\n";
	print "\t\twhere\n";
	print "\t\t\t${tablename}_objects.object_id=p_object_id(i);\n";
    
    print "\texception\n";
    print "\t\twhen others then\n";
    print "\t\t\tbegin\n";\
    print "\t\t\t\tFOR i IN 1..p_chunk_size LOOP\n";
    print "\t\t\t\t\tm_error_index := i;\n";
    	print "\t\t\t\t\tupdate ${tablename}_objects set\n";
    	$notfirst =0;
    	foreach $column (@columns)
    	{
    	    ($name,$type)=split(" ",$column);
    	    if ($notfirst!=0)
    	    	{	print ",\n"; }
    	    else
    	    	{ $notfirst=1; }
    	    	
    	    print "\t\t\t\t\t${tablename}_objects.$name = nvl(p_$name(i),${tablename}_objects.$name)";
         	
    	}
    	print "\n";
    	print "\t\t\t\t\twhere\n";
	print "\t\t\t\t\t${tablename}_objects.object_id=p_object_id(i);\n";
    print "\t\t\t\tend LOOP;\n";
    print "\t\t\texception\n";
    print "\t\t\t\twhen others then\n";
    print "\t\t\t\t\tbegin\n";
    print "\t\t\t\t\t\tm_enable_db_logging := db_error_logger.getLogLevel();\n";
    
    print "\t\t\t\t\t\tIF (m_enable_db_logging > 0) THEN\n";
    print "\t\t\t\t\t\t\tdb_error_logger.dblogerror(SQLCODE,";
    print "'persister.save_${procname}_obj : update error.');\n";
    print "\t\t\t\t\t\t\tIF (m_enable_db_logging > 1) THEN\n";
    print "\t\t\t\t\t\t\t\tdb_error_logger.dblogerror_values('persister.save_${procname}_obj','object_id','number',p_object_id(m_error_index));\n"; 
       	$i=0;
        foreach $column (@columns)
        {
            ($name,$type)=split(" ",$column);
                            if (!($tablename eq "player" and $name eq "num_lots"))
                    {       print "\t\t\t\t\t\t\t\tdb_error_logger.dblogerror_values('persister.save_${procname}_obj','$name','$type',".OracleValue($column, $tags[$i]).");\n"; 
                    }
                            $i++;
        }
    
    print "\t\t\t\t\t\t\tEND IF;\n";
    print "\t\t\t\t\t\tEND IF;\n";  
    print "\t\t\t\t\t\tIF (db_error_logger.reraisecheck('persister','save_${procname}_obj') = 1) THEN\n";
    print "\t\t\t\t\t\t\tRAISE;\n";  
    print "\t\t\t\t\t\tEND IF;\n";  
  
    print "\t\t\t\t\tend;\n";
    print "\t\t\tend;\n";
    
    }
    print "\tend;\n\n";
}

sub printSaveProcHeader
{ 
    my($tablename)=@_;
    my($notfirst,$name,$type, $i);
  
    print "\tprocedure save_${procname}_obj( ";
		$i=0;
 		print "p_object_id VAOFSTRING, ";
    foreach $column (@columns)
    {
      ($name,$type)=split(" ",$column);
  		print "p_".VAType($column, $tags[$i]).", ";
			$i++;
    }

		print "p_chunk_size number );\n";
}

sub printCreateProcBody
{ 
    my($tablename)=@_;
    my($notfirst,$name,$type, $i);
  
    print "\tprocedure add_${procname}_obj( ";
		$i=0;
 		print "p_object_id VAOFSTRING, ";
    foreach $column (@columns)
    {
      ($name,$type)=split(" ",$column);
  		print "p_".VAType($column, $tags[$i]).", ";
			$i++;
    }

		print "p_chunk_size number )\n";
    print "\tas\n";
    print "\tm_enable_db_logging INTEGER := 0;\n";
    print "\tm_error_index INTEGER :=0;\n";

    print "\tbegin\n";

		print "\t\tFORALL i IN 1..p_chunk_size\n";
    print "\t\tinsert into ${tablename}_objects\n";
    print "\t\t(\n";
    foreach $column (@columns)
    {
		($name,$type)=split(" ",$column);
		print "\t\t\t${tablename}_objects.$name,\n";
    }
    print "\t\t\t${tablename}_objects.object_id\n";
    print "\t\t)\n";
    print "\t\tVALUES\n";
		print "\t\t(\n";
    foreach $column (@columns)
    {
			($name,$type)=split(" ",$column);
			print "\t\t\tp_$name(i),\n";
    }
    print "\t\t\tp_object_id(i)\n";
    print "\t\t);\n";
		print "\n";

    print "\texception\n\t\twhen dup_val_on_index then\n";
    print "\t\tbegin\n";
    
    	    print "\t\t\tm_enable_db_logging := db_error_logger.getLogLevel();\n";
    	    
    	    print "\t\t\tIF (m_enable_db_logging > 0) THEN\n";
    	    print "\t\t\t\tdb_error_logger.dblogerror(SQLCODE,";
    	    print "'persister.add_${procname}_obj : dup_val_on_index error.');\n";
	    print "\t\t\tEND IF;\n";
    
    if (@columns > 0) 
    {
    
    print "\t\t\tfor i in 1..p_chunk_size loop\n";
    print "\t\t\t\tm_error_index := i;\n";
  	print "\t\t\t\tUPDATE ${tablename}_objects Set\n";
		foreach $column (@columns)
		{
		    ($name,$type)=split(" ",$column);
		    if ($notfirst!=0)
		    	{	print ",\n"; }
		     else
		    	{ $notfirst=1; }
 	    	print "\t\t\t\t\t${tablename}_objects.$name = nvl(p_$name(i),${tablename}_objects.$name)";
		}
		print "\n";
		print "\t\t\t\twhere\n";
		print "\t\t\t\t\t${tablename}_objects.object_id=p_object_id(i);\n\n";
   	print "\t\t\t\tif SQL%ROWCOUNT=0 then\n";
    print "\t\t\t\t\tinsert into ${tablename}_objects\n";
    print "\t\t\t\t\t(\n";
    foreach $column (@columns)
    {
		($name,$type)=split(" ",$column);
		print "\t\t\t\t\t${tablename}_objects.$name,\n";
    }
    print "\t\t\t\t\t${tablename}_objects.object_id\n";
    print "\t\t\t\t\t)\n";
    print "\t\t\t\t\tVALUES\n";
		print "\t\t\t\t\t(\n";
    foreach $column (@columns)
    {
			($name,$type)=split(" ",$column);
			print "\t\t\t\t\tp_$name(i),\n";
    }
    print "\t\t\t\t\tp_object_id(i)\n";
    print "\t\t\t\t\t);\n";
		print "\t\t\t\tend if;\n";
  	print "\t\t\tend loop;\n";
    }	
	
	print "\t\tend;\n";	    
    
	print "\t\twhen others then\n";
	print "\t\tbegin\n";
	
	print "\t\t\tfor i in 1..p_chunk_size loop\n";
	print "\t\t\tm_error_index := i;\n";
	print "\t\t\tinsert into ${tablename}_objects\n";
	print "\t\t\t(\n";
	foreach $column (@columns)
	{
		($name,$type)=split(" ",$column);
		print "\t\t\t\t${tablename}_objects.$name,\n";
	}
	print "\t\t\t\t${tablename}_objects.object_id\n";
	print "\t\t\t)\n";
	print "\t\t\tVALUES\n";
	print "\t\t\t(\n";
	foreach $column (@columns)
	{
		($name,$type)=split(" ",$column);
		print "\t\t\t\tp_$name(i),\n";
	}
	print "\t\t\t\tp_object_id(i)\n";
	print "\t\t\t);\n";
	print "\n";
	print "\t\t\tend loop;\n";
   	
	print "\t\texception\n";
	print "\t\t\twhen others then\n";
	print "\t\t\tbegin\n";
	
	    print "\t\t\t\tm_enable_db_logging := db_error_logger.getLogLevel();\n";
		    
		    print "\t\t\t\tIF (m_enable_db_logging > 0) THEN\n";
		    print "\t\t\t\t\tdb_error_logger.dblogerror(SQLCODE,";
		    print "'persister.add_${procname}_obj : error.');\n";
		    print "\t\t\t\t\tIF (m_enable_db_logging > 1) THEN\n";
		    print "\t\t\t\t\t\tdb_error_logger.dblogerror_values('persister.add_${procname}_obj','object_id','number',p_object_id(m_error_index));\n"; 
		       	$i=0;
		        foreach $column (@columns)
		        {
		            ($name,$type)=split(" ",$column);
		                            if (!($tablename eq "player" and $name eq "num_lots"))
		                    {       print "\t\t\t\t\t\tdb_error_logger.dblogerror_values('persister.add_${procname}_obj','$name','$type',".OracleValue($column, $tags[$i]).");\n"; 
		                    }
		                            $i++;
		        }
		    
		    print "\t\t\t\t\tEND IF;\n";
		    print "\t\t\t\tEND IF;\n";
    	    print "\t\t\t\tIF (db_error_logger.reraisecheck('persister','add_${procname}_obj') = 1) THEN\n";
	    print "\t\t\t\t\tRAISE;\n";  
	    print "\t\t\t\tEND IF;\n";  

	print "\t\t\tend;\n";
	print "\t\tend;\n";	
				
    print "\tend;\n\n";
}

sub printCreateProcHeader
{ 
    my($tablename)=@_;
    my($notfirst,$name,$type, $i);
  
    print "\tprocedure add_${procname}_obj( ";
		$i=0;
  	print "p_object_id VAOFSTRING, ";
    foreach $column (@columns)
    {
      ($name,$type)=split(" ",$column);
  		print "p_".VAType($column, $tags[$i]).", ";
			$i++;
    }

	print "p_chunk_size number );\n";
}

sub printRemoveProcBody
{ 
    my($tablename)=@_;
    my($notfirst,$name,$type);
  
    print "\tprocedure remove_${procname}_obj( ";
    print "p_object_id VAOFSTRING, ";
		print "p_chunk_size number )\n";
    print "\tas\n";
    print "\tbegin\n";
    if (@columns == 0)
    {
		print "\t\tnull;\n";
    }
    else
    {
		print "\t\tFORALL i IN 1..p_chunk_size\n";
		print "\t\tdelete ${tablename}_objects\n";
		print "\t\twhere\n";
		print "\t\t\tobject_id=p_object_id(i);\n";
    }
    print "\tend;\n\n";
}

sub printRemoveProcHeader
{ 
    my($tablename)=@_;
    my($notfirst,$name,$type);
  
    print "\tprocedure remove_${procname}_obj( ";
    print "p_object_id VAOFSTRING, ";
		print "p_chunk_size number );\n";
}

sub VAType
{
	my ($param, $tag)=@_;
	my ($name,$type);

	($name,$type)=split(" ",$param);	

	SWITCH: {

		if ($tag == 1) {return $name." VAOFSTRING"; last SWITCH; }
		if ($type eq "number") {return $name." VAOFNUMBER"; last SWITCH; }
		if ($type eq "int") {return $name." VAOFNUMBER"; last SWITCH; }
		if ($type eq "float") {return $name." VAOFNUMBER"; last SWITCH; }
		if ($type eq "char") {return $name." VAOFSTRING"; last SWITCH; }
		if ($type eq "varchar2") {return $name." VAOFSTRING"; last SWITCH; }
		if ($type eq "varchar") {return $name." VAOFSTRING"; last SWITCH; }
		if ($type eq "objectid") {return $name." VAOFSTRING"; last SWITCH; }
		print "Warning unknown type: ".$type."\n";
		return "VAUNKNOWN";

		}

}

sub OracleValue 
{
        my ($param, $tag)=@_;
        my ($name,$type);

        ($name,$type)=split(" ",$param);

        SWITCH: {

                if ($tag == 1) {return "p_".$name."(m_error_index)"; last SWITCH; }
                if ($type eq "number") {return "to_char(p_".$name."(m_error_index))"; last SWITCH; }
                if ($type eq "int") {return "to_char(p_".$name."(m_error_index))"; last SWITCH; }
                if ($type eq "float") {return "to_char(p_".$name."(m_error_index))"; last SWITCH; }
                if ($type eq "char") {return "p_".$name."(m_error_index)"; last SWITCH; }
                if ($type eq "varchar2") {return "p_".$name."(m_error_index)"; last SWITCH; }
                if ($type eq "varchar") {return "p_".$name."(m_error_index)"; last SWITCH; }
                if ($type eq "objectid") {return "p_".$name."(m_error_index)"; last SWITCH; }
                print "Warning unknown type: ".$type."\n";
                return "VAUNKNOWN";

                }

}