Changeset 737 for trunk/cgi-bin

Timestamp:

05/28/15 13:30:15 (10 years ago)

Author:

Kris Deugau

Message:

/trunk

Fill in merge-to-pool. See #8.

File:

• trunk/cgi-bin/IPDB.pm (modified) (2 diffs)

trunk/cgi-bin/IPDB.pm

@@ -2209 +2209 @@
     my $reparentsth = $dbh->prepare("UPDATE allocations SET parent_id = ?, master_id = ? WHERE id = ?");
     my $insfbsth = $dbh->prepare("INSERT INTO freeblocks (cidr,city,routed,vrf,parent_id,master_id) VALUES (?,?,?,?,?,?)");
+    my $delsth = $dbh->prepare("DELETE FROM allocations WHERE id = ?");
 
     my $fbreparentsth = $dbh->prepare(q{
@@ -2325 +2326 @@
     } elsif ($args{newtype} =~ /.[dp]/) {
       ## Pool
+      # Snag the new parent info for the return list
+      push @retlist, { block => "$newblock", type => $disp_alloctypes{$args{newtype}}, id => $prime };
+
+      if ($args{scope} eq 'keepall') {
+        # Convert all mergeable allocations and subs to chunks of pool IP assignments
+        push @retlist, @{ _toPool($dbh, $prime, $newblock, $args{newtype}) };
+
+      } elsif ($args{scope} =~ /^clear/) {
+        # Clear it all out for a fresh (mostly?) empty IP pool
+        while (my ($peercidr, $peer_id, $peertype, $m_id) = $peersth->fetchrow_array) {
+          next if $peer_id == $prime;
+          # Push existing allocations down a level before deleting,
+          # so that when they're deleted the parent info is correct
+          $reparentsth->execute($prime, $binfo->{master_id}, $peer_id);
+          _deleteCascade($dbh, $peer_id, 0);
+          # Capture block for return
+          push @retlist, { block => $peercidr, mtype => $disp_alloctypes{$peertype} };
+        }
+        if ($args{scope} eq 'clearall') {
+          # Delete any subs of $prime as well
+          my $substh = $dbh->prepare("SELECT cidr,id FROM allocations WHERE parent_id = ?");
+          $substh->execute($prime);
+          while (my ($scidr, $s_id) = $substh->fetchrow_array) {
+            _deleteCascade($dbh, $s_id);
+          }
+        } else {
+          # Convert (subs of) self if not a leaf.
+          _toPool($dbh, $prime, $newblock, $args{newtype}) unless $binfo->{type} =~ /.[enr]/;
+        } # scope ne 'clearall'
+
+      } elsif ($args{scope} eq 'mergepeer') {
+        # Try to match behaviour from (target type == container) by deleting immediate peer leaf allocations
+        while (my ($peercidr, $peer_id, $peertype, $m_id) = $peersth->fetchrow_array) {
+          next if $peer_id == $prime;  # don't delete the block we're turning into the pool allocation
+          # Capture block for return
+          push @retlist, { block => $peercidr, mtype => $disp_alloctypes{$peertype} };
+          next unless $peertype =~ /.[enr]/;
+          # Don't need _deleteCascade(), since we'll just be deleting the freshly
+          # added free block a little later anyway
+          $delsth->execute($peer_id);
+        }
+        # Convert self if not a leaf, to match behaviour with a container type as target
+        _toPool($dbh, $prime, $newblock, $args{newtype}) unless $binfo->{type} =~ /.[enr]/;
+      }
+      # Update the primary allocation info.
+      $dbh->do("UPDATE allocations SET cidr = ?, type = ? WHERE id = ?", undef, ($newblock, $args{newtype}, $prime) );
+      # Delete any lingering free blocks
+      $dbh->do("DELETE FROM freeblocks WHERE parent_id = ? AND cidr <<= ?", undef, $binfo->{parent_id}, $newblock);
+      # Fix up the rest of the pool IPs
+      my ($code,$msg) = initPool($dbh, $newblock, $args{newtype}, $binfo->{city},
+              ($args{newtype} =~ /.p/ ? 'all' : 'normal'), $prime);
 
     } elsif ($args{newtype} =~ /.[enr]/) {