mirror of
https://bitbucket.org/theswgsource/src-1.2.git
synced 2026-07-15 00:08:07 -04:00
451 lines
12 KiB
Perl
Executable File
451 lines
12 KiB
Perl
Executable File
#!/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";
|
|
|
|
}
|
|
|
|
}
|