Index: trunk/cgi-bin/IPDB.pm
===================================================================
--- trunk/cgi-bin/IPDB.pm	(revision 727)
+++ trunk/cgi-bin/IPDB.pm	(revision 728)
@@ -32,5 +32,5 @@
 	&getMasterList &getTypeList &getPoolSelect &findAllocateFrom
 	&ipParent &subParent &blockParent &getBreadCrumbs &getRoutedCity
-	&allocateBlock &updateBlock &splitBlock &shrinkBlock &deleteBlock &getBlockData
+	&allocateBlock &updateBlock &splitBlock &shrinkBlock &mergeBlocks &deleteBlock &getBlockData
 	&getBlockRDNS &getRDNSbyIP
 	&getNodeList &getNodeName &getNodeInfo
@@ -48,5 +48,5 @@
 		&getMasterList &getTypeList &getPoolSelect &findAllocateFrom
 		&ipParent &subParent &blockParent &getBreadCrumbs &getRoutedCity
-		&allocateBlock &updateBlock &splitBlock &shrinkBlock &deleteBlock &getBlockData
+		&allocateBlock &updateBlock &splitBlock &shrinkBlock &mergeBlocks &deleteBlock &getBlockData
 		&getBlockRDNS &getRDNSbyIP
 		&getNodeList &getNodeName &getNodeInfo
@@ -1998,4 +1998,161 @@
 
 
+## IPDB::mergeBlocks()
+# Merges two or more adjacent allocations, optionally including relevant
+# free space, into one allocation.
+# Takes a "base" block ID and a hash with a mask length and a scope argument to decide
+# how much existing allocation data to delete.
+## Merge scope:
+# Merge to container
+#   keepall
+#     Move all mergeable allocations into the new block
+#     Move all mergeable free blocks into the new block
+#   mergepeer
+#     Move subs of mergeable containers into the updated primary.
+#     Reparent free blocks in mergeable containers to the updated primary.
+#     Convert assigned IPs from pools into subs.
+#     Convert unused IPs from pools into free blocks.
+#     Convert leaf allocations into free blocks.
+#   clearpeer
+#     Keep subs of the original
+#     Convert assigned IPs from pools into subs.
+#     Convert unused IPs from pools into free blocks.
+#     Convert leaf allocations into free blocks.
+#   clearall
+#     Delete all peers, subs and IPs.
+#     Add single free block for new container.
+# Merge to pool
+#   keepall
+#     Convert all leaf allocations in the merge range to groups of used IPs
+#   mergepeer
+#     Effectively equal to keepall
+#   clearpeer
+#     Only convert IPs from the original allocation to used IPs
+#   clearall
+#     Delete any existing IPs, and reinitialize the new pool entirely
+# Merge to leaf type
+#   Remove all subs
+sub mergeBlocks {
+  my $dbh = shift;
+  my $prime = shift;  # "base" block ID to use as a starting point
+  if (!$prime) {
+    $errstr = "Missing block ID to base merge on";
+    return;
+  }
+
+  my %args = @_;
+
+  # check key arguments.
+  if (!$args{scope} || $args{scope} !~ /^(keepall|mergepeer|clearpeer|clearall)$/) {
+    $errstr = "Bad or missing merge scope";
+    return;
+  }
+  if (!$args{newmask} || $args{newmask} !~ /^\d+$/) {
+    $errstr = "Bad or missing new netmask";
+    return;
+  }
+
+  # Retrieve info about the base allocation we're munging
+  my $binfo = getBlockData($dbh, $prime);
+  my $block = new NetAddr::IP $binfo->{block};
+  my ($basetype) = ($binfo->{type} =~ /^.(.)$/);
+  $binfo->{id} = $prime;  # preserve for later, just in case
+
+  # proposed block
+  my $newblock = new NetAddr::IP $block->addr."/$args{newmask}";
+  $newblock = $newblock->network;
+  $args{newtype} = $binfo->{type} if !$args{newtype};
+  # if the "primary" block being changed is a master, it must remain one.
+  $args{newtype} = 'mm' if $binfo->{type} eq 'mm';
+  my ($newcontainerclass) = ($args{newtype} =~ /^(.).$/);
+
+  # build an info hash for the "new" allocation we're creating
+  my $pinfo = {
+      id => $prime,
+      block => "$newblock",
+      type => $args{newtype},
+      parent_id =>
+      $binfo->{parent_id},
+      city => $binfo->{city},
+      vrf => $binfo->{vrf},
+      master_id => $binfo->{master_id}
+    };
+
+  my @retlist;
+
+  # Want to do all of the DB stuff in a transaction, to minimize data changing underfoot
+  eval {
+
+    # We always update the "prime" block passed in...
+    $dbh->do("UPDATE allocations SET cidr = ?, type = ? WHERE id = ?", undef,
+        ($newblock, $args{newtype}, $prime) )
+        # ... but only on existing container or pool types.  Leaf -> container conversions
+        # may need a new parent inserted instead.
+        if $basetype =~ /[cm]/;
+
+    # For leaf blocks, we may need to create a new parent as the "primary" instead
+    # of updating the existing block
+    my $newparent = $dbh->prepare(q{
+        INSERT INTO allocations (
+                cidr, type, city, description, notes, circuitid, createstamp, modifystamp,
+                privdata, custid, swip, vrf, vlan, rdns, parent_id, master_id
+            )
+        SELECT
+                ? AS cidr, ? AS type, city, description, notes, circuitid, createstamp, modifystamp,
+                privdata, custid, swip, vrf, vlan, rdns, parent_id, master_id
+            FROM allocations
+            WHERE id = ?
+        });
+
+    # Convert a bunch of pool IP allocations into "normal" netblock allocations
+    my $pool2alloc = $dbh->prepare(q{
+        INSERT INTO allocations (
+                cidr,type,city, description, notes, circuitid, createstamp, modifystamp,
+                privdata, custid, vrf, vlan, rdns, parent_id, master_id
+            )
+        SELECT
+                ip, ? AS type, city, description, notes, circuitid, createstamp, modifystamp,
+                privdata, custid, vrf, vlan, rdns, parent_id, master_id
+            FROM poolips
+            WHERE parent_id = ? AND available = 'n'
+        });
+
+    # Common actions
+    my $peersth = $dbh->prepare("SELECT cidr,id,type,master_id FROM allocations WHERE parent_id = ? AND cidr <<= ?");
+    $peersth->execute($binfo->{parent_id}, "$newblock");
+    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 $fbreparentsth = $dbh->prepare(q{
+        UPDATE freeblocks
+            SET parent_id = ?, master_id = ?, city = ?, routed = ?, vrf = ?
+            WHERE parent_id = ? AND cidr <<= ?
+        });
+
+    if ($args{newtype} =~ /.[cm]/) {
+      ## Container
+
+    } elsif ($args{newtype} =~ /.[dp]/) {
+      ## Pool
+
+    } elsif ($args{newtype} =~ /.[enr]/) {
+      ## Leaf
+
+    } # new type if()
+
+    $dbh->commit;
+  };
+  if ($@) {
+    my $msg = $@;
+    $errstr = $msg;
+    $dbh->rollback;
+    return ('FAIL',$msg);
+  }
+
+  return \@retlist;
+
+} # end mergeBlocks()
+
+
 ## IPDB::deleteBlock()
 # Removes an allocation from the database, including deleting IPs