source: trunk/cgi-bin/db-update.pl@ 920

#!/usr/bin/perl
# Quick sort of hack to populate new columns in DB

use strict;
use warnings;
use Data::Dumper;

# push "the directory the script is in" into @INC
use FindBin;
use lib "$FindBin::RealBin/";

use MyIPDB;

# run the tabledef update first.  This is "safe";  IPDB < 3.0 can still happily munch away at it.
##fixme
my $sqlcmd = "PGPASSWORD=".dbpass()." psql -h ".dbhost()." -U ".dbuser()." ".dbname()." <ipdb-2.7-3.0.sql";
print qx { $sqlcmd };

my $dbh;
my $errstr;
($dbh,$errstr) = connectDB_My;
my $verbose = 0;

die "db conn failed: $errstr\n" if !$dbh;

initIPDBGlobals($dbh);

local $dbh->{AutoCommit} = 0;
local $dbh->{RaiseError} = 1;

eval {

  my $get_id = $dbh->prepare("SELECT currval('allocations_id_seq')");

  # master blocks move to the allocations table
  my $getm = $dbh->prepare("SELECT cidr,ctime,mtime,rwhois FROM masterblocks");
  my $insm = $dbh->prepare("INSERT INTO allocations (cidr,type,vrf,createstamp,modifystamp,swip,custid) VALUES (?,'mm','DEFAULT',?,?,?,?)");

  # routed blocks move to the allocations table
  my $getr = $dbh->prepare("SELECT cidr,city FROM routed WHERE cidr <<= ?");
  my $insr = $dbh->prepare("INSERT INTO allocations (cidr,type,city,parent_id,custid) VALUES (?,'rm',?,?,?)");
  my $rfree = $dbh->prepare("UPDATE freeblocks SET parent_id = ?, routed='m' WHERE cidr <<= ? AND routed='y'");

  # update freeblocks with new parent relation info
  my $mfree = $dbh->prepare("UPDATE freeblocks SET parent_id = ?, routed='m' WHERE cidr <<= ? AND routed='n'");
  my $setm_f = $dbh->prepare("UPDATE freeblocks SET master_id = ? WHERE cidr <<= ?");
  my $cfree = $dbh->prepare("UPDATE freeblocks SET parent_id = ?, routed='c' WHERE cidr <<= ?");

  # update allocations with new parent relation info
  my $getc = $dbh->prepare("SELECT cidr,type,id FROM allocations WHERE cidr <<= ? AND type LIKE '_c'");
  my $setm_a = $dbh->prepare("UPDATE allocations SET master_id = ? WHERE cidr <<= ?");
  my $updalloc = $dbh->prepare("UPDATE allocations SET parent_id = ? WHERE cidr <<= ? AND NOT (type='rm' OR type='mm')");
  my $updc = $dbh->prepare("UPDATE allocations SET parent_id = ? WHERE cidr <<= ? AND type LIKE '_r'");

  # update poolips with new parent relation info
  my $getp = $dbh->prepare("SELECT cidr,id,master_id FROM allocations WHERE type LIKE '_d' OR type LIKE '_p'");
  my $updpool = $dbh->prepare("UPDATE poolips SET parent_id = ?, master_id = ? WHERE ip << ?");

  # "spare" freeblocks that are technically part of a container, but whose formal container parent
  # isn't actually present.  Arguably these could autoconvert the parent to a container, but IIRC
  # in some cases live data has a mix of types in a container.  *sigh*.
  my $sparef = $dbh->prepare("SELECT cidr,id FROM freeblocks WHERE parent_id = 0");
  my $fparent = $dbh->prepare("UPDATE freeblocks SET parent_id = ".
        "(SELECT id FROM allocations WHERE cidr >>= ? ORDER BY masklen(cidr) DESC LIMIT 1)".
        " WHERE id = ?");

  # Need to disable the update trigger on the allocations and poolips tables,
  # so we don't mangle the real mtimes on the data.
  $dbh->do("DROP TRIGGER up_modtime ON allocations");
  $dbh->do("DROP TRIGGER up_modtime ON poolips");

  $getm->execute;
  while (my ($master,$mctime,$mmtime,$mswip) = $getm->fetchrow_array()) {
    print "$master\t";
    # copy master to allocations table
    $insm->execute($master, $mctime, $mmtime, $mswip, $def_custids{'mm'});
    $get_id->execute;
    my ($mid) = $get_id->fetchrow_array();
    print "$mid\n";
    # parent relation for free blocks directly under the master
    $mfree->execute($mid, $master);

    $getr->execute($master);
    while (my ($routed,$rcity) = $getr->fetchrow_array()) {
      print "  $routed\t";
      # copy routed to allocations table
      $insr->execute($routed, $rcity, $mid, $def_custids{'rm'});
      $get_id->execute;
      my ($rid) = $get_id->fetchrow_array();
      print "$rid\n";
      # parent relation for free blocks directly under the routed block
      $rfree->execute($rid, $routed);
      # parent relation for allocations in the routed block
      $updalloc->execute($rid, $routed);
      $getc->execute($routed);
      while (my ($container, $ctype, $cid) = $getc->fetchrow_array()) {
        print "    $container";
        # container blocks are now functionally equivalent to routed blocks;
        # update the parent relations on the contained blocks to treat the
        # container as the parent, not the routed block
        $updc->execute($cid, $container);
        my $c = $cfree->execute($cid, $container);
      }
    }
    # Just In Case.  Bulk-set the master ID on all allocations, then freeblocks,
    # within the master.  This could theoretically be merged into the updates
    # above, but edge cases kept happening.
    $setm_a->execute($mid, $master);
    $setm_f->execute($mid, $master);
  }

  # Update poolips with new parent and master relation info
  $getp->execute();
  while (my ($pool, $pid, $pmaster) = $getp->fetchrow_array()) {
    $updpool->execute($pid, $pmaster, $pool);
  }

  # clean up "spare" freeblocks from formally-incorrect use of container types
  $sparef->execute();
  while (my ($free, $fid) = $sparef->fetchrow_array()) {
    $fparent->execute($free, $fid)
  }

  if ($ARGV[0] && $ARGV[0] == 'fetchdns') {
    # weesa gotsa BIIIIG job, gotta fetch all the current rDNS.  note this relies
    # on having had the DNS data imported and munged into the new pseudotypes.
    # ... never mind.  this will be opportunistic, since DNS data isn't viewed
    # unless adding (not present, we should hope!) or updating (where it should
    # be retrieved from the authoritative API in real time)
  }

  # Recreate modtime trigger on allocations, now that we're done monkeying with it.
  $dbh->do("CREATE TRIGGER up_modtime BEFORE UPDATE ON allocations FOR EACH ROW EXECUTE PROCEDURE up_modtime()");
  $dbh->do("CREATE TRIGGER up_modtime BEFORE UPDATE ON poolips FOR EACH ROW EXECUTE PROCEDURE up_modtime()");

  $dbh->commit;
}; # all wrapped up in an eval{} so we can roll it all back when we want to
if ($@) {
  print "ebbeh? $@\n";
}