1 | # ipdb/cgi-bin/IPDB.pm
|
---|
2 | # Contains DB-related functions for IPDB
|
---|
3 | ###
|
---|
4 | # SVN revision info
|
---|
5 | # $Date$
|
---|
6 | # SVN revision $Rev$
|
---|
7 | # Last update by $Author$
|
---|
8 | ###
|
---|
9 |
|
---|
10 | # Split from CommonWeb.pm 08/13/2004 kdeugau@vianet
|
---|
11 |
|
---|
12 | package IPDB;
|
---|
13 |
|
---|
14 | use strict;
|
---|
15 | use warnings;
|
---|
16 | use Exporter;
|
---|
17 | use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
|
---|
18 |
|
---|
19 | $VERSION = 1.0;
|
---|
20 | @ISA = qw(Exporter);
|
---|
21 | @EXPORT_OK = qw(&connectDB &checkDBSanity);
|
---|
22 |
|
---|
23 | @EXPORT = (); # Export nothing by default.
|
---|
24 | %EXPORT_TAGS = ( ALL => [qw( &connectDB &checkDBSanity )]
|
---|
25 | );
|
---|
26 |
|
---|
27 | # Creates connection to IPDB.
|
---|
28 | # Default is a PostgreSQL db; could be any DBMS with the
|
---|
29 | # right changes. MySQL in comments. Note that some DBMS's don't
|
---|
30 | # support transactions, this is a Bad Thing!
|
---|
31 | # Returns a handle to the db.
|
---|
32 | sub connectDB {
|
---|
33 | my $dbh;
|
---|
34 | my $DSN = "DBI:Pg:dbname=ipdb";
|
---|
35 | my $user = 'ipdb';
|
---|
36 | my $pw = 'ipdbpwd';
|
---|
37 |
|
---|
38 | # Note that we want to autocommit by default, and we will turn it off locally as necessary.
|
---|
39 | $dbh = DBI->connect($DSN, $user, $pw, { AutoCommit => 1 } )
|
---|
40 | or return undef if(!$dbh);
|
---|
41 |
|
---|
42 | return $dbh;
|
---|
43 | } # end connectDB
|
---|
44 |
|
---|
45 | # Quick check to see if the db is responding. A full integrity
|
---|
46 | # check will have to be a separate tool to walk the IP allocation trees.
|
---|
47 | sub checkDBSanity {
|
---|
48 | my $dbh = connectDB();
|
---|
49 |
|
---|
50 | if (!$dbh) {
|
---|
51 | printError("Cannot connect to the database");
|
---|
52 | } else {
|
---|
53 | # it connects, try a stmt.
|
---|
54 | my $sth = $dbh->prepare('select cidr from masterblocks');
|
---|
55 | my $err = $sth->execute();
|
---|
56 |
|
---|
57 | if ($sth->fetchrow()) {
|
---|
58 | # all is well.
|
---|
59 | return 1;
|
---|
60 | } else {
|
---|
61 | printHeader('');
|
---|
62 | printError("Connected to the database, but could not execute test statement sth->errstr()");
|
---|
63 | }
|
---|
64 | }
|
---|
65 | # Clean up after ourselves.
|
---|
66 | $dbh->disconnect;
|
---|
67 | } # end checkDBSanity
|
---|
68 |
|
---|
69 | # Indicates module loaded OK. Required by Perl.
|
---|
70 | 1;
|
---|