Index: trunk/cgi-bin/IPDB.pm
===================================================================
--- trunk/cgi-bin/IPDB.pm	(revision 69)
+++ trunk/cgi-bin/IPDB.pm	(revision 77)
@@ -14,34 +14,90 @@
 use warnings;
 use Exporter;
+use DBI;
 use Net::SMTP;
 use POSIX;
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
 
-$VERSION	= 1.0;
+$VERSION	= 2.0;
 @ISA		= qw(Exporter);
-@EXPORT_OK	= qw(&connectDB &checkDBSanity &allocateBlock &mailNotify);
+@EXPORT_OK	= qw(&initIPDBGlocals &connectDB &finish &checkDBSanity &allocateBlock
+			&initPool &mailNotify);
 
 @EXPORT		= (); # Export nothing by default.
-%EXPORT_TAGS	= ( ALL => [qw( &connectDB &checkDBSanity &allocateBlock &mailNotify)]
+%EXPORT_TAGS	= ( ALL => [qw( &initIPDBGlocals &connectDB &checkDBSanity
+				&allocateBlock &initPool &mailNotify)]
 		  );
 
-
+##
+## Global variables
+##
+our %disp_alloctypes;
+our %list_alloctypes;
+
+# Let's initialize the globals.
+## IPDB::initIPDBGlobals()
+# Initialize all globals.  Takes a database handle, returns a success or error code
+sub initIPDBGlobals {
+  my $dbh = $_[0];
+  my $sth;
+
+  $sth = $dbh->prepare("select type,dispname from alloctypes");
+  $sth->execute;
+  return (undef,$sth->errstr) if $sth->err;
+
+  while (my @data = $sth->fetchrow_array) {
+    $disp_alloctypes{$data[0]} = $data[1];
+  }
+  return (1,"OK");
+} # end initIPDBGlobals
+
+
+## IPDB::connectDB()
 # Creates connection to IPDB.
-# Default is a PostgreSQL db;  could be any DBMS with the
-# right changes.  MySQL in comments.  Note that some DBMS's don't
-# support transactions, this is a Bad Thing!
+# Requires the database name, username, and password.
 # Returns a handle to the db.
+# Set up for a PostgreSQL db;  could be any transactional DBMS with the
+# right changes.
+# This definition should be sub connectDB($$$) to be technically correct,
+# but this breaks.  GRR.
 sub connectDB {
+  my ($dbname,$user,$pass) = @_;
   my $dbh;
-  my $DSN = "DBI:Pg:dbname=ipdb";
-  my $user = 'ipdb';
-  my $pw   = 'ipdbpwd';
+  my $DSN = "DBI:Pg:dbname=$dbname";
+#  my $user = 'ipdb';
+#  my $pw   = 'ipdbpwd';
 
 # Note that we want to autocommit by default, and we will turn it off locally as necessary.
-  $dbh = DBI->connect($DSN, $user, $pw, { AutoCommit => 1 } )
-    or return undef if(!$dbh);
-
-  return $dbh;
+# We may not want to print gobbledygook errors;  YMMV.  Have to ponder that further.
+  $dbh = DBI->connect($DSN, $user, $pass, {
+	AutoCommit => 1,
+	PrintError => 0
+	})
+    or return (undef, $DBI::errstr) if(!$dbh);
+
+# Return here if we can't select.  Note that this indicates a
+# problem executing the select.
+  my $sth = $dbh->prepare('select cidr from masterblocks');
+  $sth->execute();
+  return (undef,$DBI::errstr) if ($sth->err);
+
+# See if the select returned anything (or null data).  This should
+# succeed if the select executed, but...
+  $sth->fetchrow();
+  return (undef,$DBI::errstr)  if ($sth->err);
+
+# If we get here, we should be OK.
+  return ($dbh,"DB connection OK");
 } # end connectDB
+
+
+## IPDB::finish()
+# Cleans up after database handles and so on.
+# Requires a database handle
+sub finish {
+  my $dbh = $_[0];
+  $dbh->disconnect;
+} # end finish
+
 
 # Quick check to see if the db is responding.  A full integrity
@@ -69,11 +125,216 @@
 
 
-# allocateBlock()
+## IPDB::allocateBlock()
 # Does all of the magic of actually allocating a netblock
-sub allocateBlock($) {
-}
-
-
-# mailNotify()
+# Requires database handle, block to allocate, custid, type, city,
+#	description, notes, circuit ID, block to allocate from, 
+# Returns a success code and optional error message.
+sub allocateBlock {
+  my ($dbh,undef,undef,$custid,$type,$city,$desc,$notes,$circid) = @_;
+  
+  my $cidr = new NetAddr::IP $_[1];
+  my $alloc_from = new NetAddr::IP $_[2];
+  my $sth;
+
+  # Enable transactions and error handling
+  local $dbh->{AutoCommit} = 0;	# These need to be local so we don't
+  local $dbh->{RaiseError} = 1;	# step on our toes by accident.
+
+  if ($type =~ /^[cdsmw]i$/) {
+    eval {
+      # We'll just have to put up with the oddities caused by SQL (un)sort order
+      $sth = $dbh->prepare("select * from poolips where pool='$alloc_from'".
+	" and available='y' order by ip");
+      $sth->execute;
+
+# update poolips set custid='$custid',city='$city',available='n',
+#	description='$desc',notes='$notes',circuitid='$circid'
+#	where ip=(select ip from poolips where pool='$alloc_from'
+#	and available='y' order by ip limit 1);
+##err Need better handling here;  what if there's no free IPs when this sub gets called?
+      my @data = $sth->fetchrow_array;
+      my $cidr = $data[1];
+
+      $sth = $dbh->prepare("update poolips set custid='$custid',".
+	"city='$city',available='n',description='$desc',notes='$notes'".
+	"circuitid='$circid'".
+	" where ip='$cidr'");
+      $sth->execute;
+##err handle the error
+    };
+    if ($@) {
+      # failure
+    } else {
+      # success
+    }
+
+  } else { # end IP-from-pool allocation
+    # Set $cidr here as it may not be a valid IP address elsewhere.
+#    my $cidr = new NetAddr::IP $webvar{fullcidr};
+
+    if ($cidr == $alloc_from) {
+      # Easiest case- insert in one table, delete in the other, and go home.  More or less.
+      # insert into allocations values (cidr,custid,type,city,desc) and
+      # delete from freeblocks where cidr='cidr'
+      # For data safety on non-transaction DBs, we delete first.
+
+      eval {
+	if ($type eq 'rr') {
+	  $sth = $dbh->prepare("update freeblocks set routed='y',city='$city'".
+	    " where cidr='$cidr'");
+	  $sth->execute;
+	  $sth = $dbh->prepare("insert into routed values ('$cidr',".
+	    $cidr->masklen.",'$city')");
+	  $sth->execute;
+	} else {
+	  # common stuff for end-use, dialup, dynDSL, pools, etc, etc.
+##err How to handle pools?
+##workhere
+#print "IPDB.pm: $cidr\n";
+	  $sth = $dbh->prepare("delete from freeblocks where cidr='$cidr'");
+	  $sth->execute;
+
+	  $sth = $dbh->prepare("insert into allocations values ('$cidr',".
+		"'$custid','$type','$city','$desc','$notes',".
+		$cidr->masklen.",'$circid')");
+	  $sth->execute;
+## if $type =~ /^[cdsmw]p$/ initpool($dbh,$cidr,$type)
+	} # routing vs non-routing netblock
+	$dbh->commit;
+      };  # end of eval
+##err
+      if ($@) {
+	eval { $dbh->rollback; };
+	return (2,$@);
+      } else {
+## do we return here or ?
+	return (1,"OK");
+	# Success
+      } # error handler
+
+    } else { # cidr != alloc_from
+
+      # Hard case.  Allocation is smaller than free block.
+      my $wantmaskbits = $cidr->masklen;
+      my $maskbits = $alloc_from->masklen;
+
+      my @newfreeblocks;	# Holds free blocks generated from splitting the source freeblock.
+
+      # This determines which blocks will be left "free" after allocation.  We take the
+      # block we're allocating from, and split it in half.  We see which half the wanted
+      # block is in, and repeat until the wanted block is equal to one of the halves.
+      my $i=0;
+      my $tmp_from = $alloc_from;	# So we don't munge $alloc_from
+      while ($maskbits++ < $wantmaskbits) {
+	my @subblocks = $tmp_from->split($maskbits);
+	$newfreeblocks[$i++] = (($cidr->within($subblocks[0])) ? $subblocks[1] : $subblocks[0]);
+	$tmp_from = ( ($cidr->within($subblocks[0])) ? $subblocks[0] : $subblocks[1] );
+      } # while
+
+      # Begin SQL transaction block
+      eval {
+	# Delete old freeblocks entry
+	$sth = $dbh->prepare("delete from freeblocks where cidr='$alloc_from'");
+	$sth->execute();
+
+	# now we have to do some magic for routing blocks
+	if ($type eq 'rr') {
+	  # Insert the new freeblocks entries
+	  # Note that non-routed blocks are assigned to <NULL>
+	  $sth = $dbh->prepare("insert into freeblocks values (?, ?, '<NULL>','n')");
+	  foreach my $block (@newfreeblocks) {
+ 	    $sth->execute("$block", $block->masklen);
+	  }
+	  # Insert the entry in the routed table
+	  $sth = $dbh->prepare("insert into routed values ('$cidr',".
+	    $cidr->masklen.",'$city')");
+	  $sth->execute;
+	  # Insert the (almost) same entry in the freeblocks table
+	  $sth = $dbh->prepare("insert into freeblocks values ('$cidr',".
+	    $cidr->masklen.",'$city','y')");
+	  $sth->execute;
+
+	} else { # done with alloctype == rr
+
+	  # Insert the new freeblocks entries
+	  $sth = $dbh->prepare("insert into freeblocks values (?, ?, ".
+		"(select city from routed where cidr >>= '$cidr'),'y')");
+	  foreach my $block (@newfreeblocks) {
+ 	    $sth->execute("$block", $block->masklen);
+	  }
+	  # Insert the allocations entry
+	  $sth = $dbh->prepare("insert into allocations values ('$cidr',".
+		"'$custid','$type','$city','$desc','$notes',".$cidr->masklen.
+		",'$circid')");
+	  $sth->execute;
+##err do we initPool here, or force the caller to do it?
+# Flexibility says we let the caller do it, to allow more options.
+	} # done with netblock alloctype != rr
+        $dbh->commit;
+      }; # end eval
+      if ($@) {
+	eval { $dbh->rollback; };
+	return (2,$@);
+      } else {
+##err
+	return (1,"OK");
+      }
+
+    } # end fullcidr != alloc_from
+
+  } # end static-IP vs netblock allocation
+
+} # end allocateBlock()
+
+
+## IPDB::initPool()
+# Initializes a pool
+# Requires a database handle, the pool CIDR, type, city, and a parameter
+# indicating whether the pool should allow allocation of literally every
+# IP, or if it should reserve network/gateway/broadcast IPs
+sub initPool {
+  my ($dbh,undef,$type,$city,$class) = @_;
+  my $pool = new NetAddr::IP $_[1];
+
+  my $pooltype = ($type =~ /^(.)p$/);
+  my $sth;
+
+  # Enable transactions and error handling
+  local $dbh->{AutoCommit} = 0;	# These need to be local so we don't
+  local $dbh->{RaiseError} = 1;	# step on our toes by accident.
+
+  # Begin SQL transaction block
+  eval {
+    # have to insert all pool IPs into poolips table as "unallocated".
+    $sth = $dbh->prepare("insert into poolips values ('$pool',".
+	" ?, '6750400', '$city', '$pooltype', 'y', '', '', '')");
+    my @poolip_list = $pool->hostenum;
+    if ($class) { # (real netblock)
+      for (my $i=1; $i<=$#poolip_list; $i++) {
+	$sth->execute($poolip_list[$i]->addr);
+      }
+    } else { # (DSL-ish block - *all* IPs available
+      $sth->execute($pool->addr);
+      for (my $i=0; $i<=$#poolip_list; $i++) {
+	$sth->execute($poolip_list[$i]->addr);
+      }
+      $pool--;
+      $sth->execute($pool->addr);
+    }
+    $dbh->commit;
+  }; # end eval
+  if ($@) {
+    eval { $dbh->rollback; };
+print "$@\n";
+    return (2,"$@");
+  } else {
+##err
+    return (1,"OK");
+  }
+
+} # end initPool()
+
+
+## IPDB::mailNotify()
 # Sends notification mail to recipients regarding an IPDB operation
 sub mailNotify ($$$) {
