src/game/server/database/packages/make_purge_script.pl

   1 #!/usr/bin/perl
   2
   3 while (<>)
   4 {
   5     if (/\-\- BEGIN GENERATED CODE \(make_purge_script.pl\)/)
   6     {
   7         print;
   8         &generateCode;
   9         do
  10         {
  11             last unless ($_=<>);
  12         } until (/\-\- END GENERATED CODE/)
  13     }
  14     print;
  15 }
  16
  17 sub generateCode
  18 {
  19     open (TABLIST,"ls -b ../schema/*.tab|");
  20
  21     $tabs="\t\t";
  22
  23     while (<TABLIST>)
  24     {
  25         chop;
  26         s/\.tab//;
  27         s/\.\.\/schema\///;
  28         if (/objects/ && ($_ ne "objects"))
  29         {
  30             &makeCommand($_);
  31         }
  32     }
  33
  34     close (TABLIST);
  35 }
  36
  37 sub makeCommand
  38 {
  39     my ($tablename)=@_;
  40
  41     print $tabs."delete from ${tablename} where not exists (select * from objects where ${tablename}.object_id = objects.object_id);\n";
  42 }