Index: /trunk/cgi-bin/IPDB.pm
===================================================================
--- /trunk/cgi-bin/IPDB.pm	(revision 730)
+++ /trunk/cgi-bin/IPDB.pm	(revision 731)
@@ -2142,4 +2142,42 @@
 
       } elsif ($args{scope} =~ /^clear/) {
+        # clearpeer and clearall share a starting point
+        # update the primary allocation info
+        $dbh->do("UPDATE allocations SET cidr = ?, type = ? WHERE id = ?", undef, ($newblock, $args{newtype}, $prime) );
+        # Reparent the free blocks in the new block
+        $fbreparentsth->execute($prime, $binfo->{master_id}, $binfo->{city}, $newcontainerclass, $binfo->{vrf},
+            $binfo->{parent_id}, $newblock);
+        # Insert a free block if $prime is a leaf
+        if ($binfo->{type} =~ /.[enr]/) {
+          $insfbsth->execute($binfo->{block}, $binfo->{city}, $newcontainerclass, $binfo->{vrf}, $prime,
+              $binfo->{master_id});
+        }
+        # delete the peers
+        while (my ($pcidr,$peer_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);
+          # insert the freeblock _deleteCascade() (deliberately) didn't when deleting a master block.
+          # aren't special cases fun?
+          $dbh->do("INSERT INTO freeblocks (cidr,routed,parent_id,master_id) values (?,?,?,?)",
+                undef, ($pcidr, 'm', $prime, $prime) ) if $binfo->{type} eq 'mm';
+        }
+        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 {
+          # clearpeer
+          if ($basetype =~ /[dp]/) {
+            # Convert active IP pool entries to allocations if the original was an IP pool
+            _poolToAllocations($dbh, $binfo, $pinfo, newtype => $poolmap{$binfo->{type}});
+          }
+        } # clearall or clearpeer
+
       } elsif ($args{scope} eq 'mergepeer') { # should this just be an else?
       } # scope