- Timestamp:
- 03/12/13 11:44:32 (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/DNSDB.pm
r464 r465 218 218 219 219 ## 220 ## Constructor and destructor 221 ## 222 223 sub new { 224 my $this = shift; 225 my $class = ref($this) || $this; 226 my %args = @_; 227 ##fixme? to ponder: do we do some magic if the caller sets eg dbname to prevent parsing of the config file? 228 if (!loadConfig(basename => $args{configfile})) { 229 warn "Using default configuration; unable to load custom settings: $errstr\n"; 230 } 231 my $self = \%config; 232 $self->{configfile} = $args{configfile}; 233 bless $self, $class; 234 $self->{dbh} = connectDB($self->{dbname}, $self->{dbuser}, $self->{dbpass}, $self->{dbhost}) or return; 235 $self->initGlobals(); 236 237 return $self; 238 } 239 240 sub DESTROY { 241 my $self = shift; 242 $self->{dbh}->disconnect; 243 } 244 245 ## 220 246 ## utility functions 221 247 ## … … 1195 1221 ## 1196 1222 1197 1198 1223 ## DNSDB::loadConfig() 1199 1224 # Load the minimum required initial state (DB connect info) from a config file … … 1201 1226 # Takes an optional hash that may contain: 1202 1227 # - basename and config path to look for 1203 # - RPC flag (saves parsing the more complex RPC bits if not needed)1204 1228 # Populates the %config and %def hashes 1205 1229 sub loadConfig { 1206 1230 my %args = @_; 1207 $args{basename} = '' if !$args{basename}; 1208 $args{rpcflag} = '' if !$args{rpcflag}; 1209 ##fixme $args{basename} isn't doing what I think I thought I was trying to do. 1231 $args{configfile} = '' if !$args{configfile}; 1232 1233 ##fixme this is *intended* to load a system-default config template, and allow 1234 # overriding on a per-tool or per-web-UI-instance basis with a secondary config 1235 # file. The "default" config file can't be deleted in the current form. 1210 1236 1211 1237 my $deferr = ''; # place to put error from default config file in case we can't find either one 1212 1238 1213 1239 my $configroot = "/etc/dnsdb"; ##CFG_LEAF## 1214 $configroot = '' if $args{ basename} =~ m|^/|;1215 $args{ basename} .= ".conf" if $args{basename} !~ /\.conf$/;1240 $configroot = '' if $args{configfile} =~ m|^/|; # allow passed siteconfig to specify an arbitrary absolute path 1241 $args{configfile} .= ".conf" if $args{configfile} !~ /\.conf$/; 1216 1242 my $defconfig = "$configroot/dnsdb.conf"; 1217 my $siteconfig = "$configroot/$args{ basename}";1243 my $siteconfig = "$configroot/$args{configfile}"; 1218 1244 1219 1245 # System defaults 1220 __cfgload("$defconfig" , $args{rpcflag}) or $deferr = $errstr;1246 __cfgload("$defconfig") or $deferr = $errstr; 1221 1247 1222 1248 # Per-site-ish settings. 1223 if ($args{ basename} ne '.conf') {1224 unless (__cfgload("$siteconfig") , $args{rpcflag}) {1249 if ($args{configfile} ne '.conf') { 1250 unless (__cfgload("$siteconfig")) { 1225 1251 $errstr = ($deferr ? "Error opening default config file $defconfig: $deferr\n" : ''). 1226 1252 "Error opening site config file $siteconfig"; … … 1254 1280 ## DNSDB::__cfgload() 1255 1281 # Private sub to parse a config file and load it into %config 1256 # Takes a file handle on an open config file1282 # Takes a filename 1257 1283 sub __cfgload { 1258 1284 $errstr = ''; 1259 1285 my $cfgfile = shift; 1260 my $rpcflag = shift;1261 1286 1262 1287 if (open CFG, "<$cfgfile") { … … 1297 1322 $config{exportcache} = $1 if m{^exportcache\s*=\s*([a-z0-9/_.-]+)}i; 1298 1323 # RPC options 1299 if ($rpcflag && /^rpc/) { 1300 if (my ($tmp) = /^rpc_iplist\s*=\s*(.+)/i) { 1301 my @ips = split /[,\s]+/, $tmp; 1302 my $rpcsys = shift @ips; 1303 push @{$config{rpcacl}{$rpcsys}}, @ips; 1304 } 1305 $config{rpcmode} = $1 if /^rpc_mode\s*=\s*(socket|HTTP|XMLRPC)\s*$/i; 1324 $config{rpcmode} = $1 if /^rpc_mode\s*=\s*(socket|HTTP|XMLRPC)\s*$/i; 1325 if (my ($tmp) = /^rpc_iplist\s*=\s*(.+)/i) { 1326 my @ips = split /[,\s]+/, $tmp; 1327 my $rpcsys = shift @ips; 1328 push @{$config{rpcacl}{$rpcsys}}, @ips; 1306 1329 } 1307 1330 } … … 1318 1341 # Creates connection to DNS database. 1319 1342 # Requires the database name, username, and password. 1320 # Returns a handle to the db .1343 # Returns a handle to the db or undef on failure. 1321 1344 # Set up for a PostgreSQL db; could be any transactional DBMS with the 1322 1345 # right changes. 1346 # Called by new(); not intended to be called publicly. 1323 1347 sub connectDB { 1324 1348 $errstr = ''; … … 1337 1361 AutoCommit => 1, 1338 1362 PrintError => 0 1339 }) 1340 or return (undef, $DBI::errstr) if(!$dbh); 1341 1363 }); 1364 if (!$dbh) { 1365 $errstr = $DBI::errstr; 1366 return; 1367 } 1368 #) if(!$dbh); 1369 1370 local $dbh->{RaiseError} = 1; 1371 1372 eval { 1342 1373 ##fixme: initialize the DB if we can't find the table (since, by definition, there's 1343 1374 # nothing there if we can't select from it...) 1344 my $tblsth = $dbh->prepare("SELECT count(*) FROM pg_catalog.pg_class WHERE relkind='r' AND relname=?");1345 my ($tblcount) = $dbh->selectrow_array($tblsth, undef, ('misc'));1346 return (undef,$DBI::errstr) if $dbh->err;1375 my $tblsth = $dbh->prepare("SELECT count(*) FROM pg_catalog.pg_class WHERE relkind='r' AND relname=?"); 1376 my ($tblcount) = $dbh->selectrow_array($tblsth, undef, ('misc')); 1377 # return (undef,$DBI::errstr) if $dbh->err; 1347 1378 1348 1379 #if ($tblcount == 0) { … … 1351 1382 #} 1352 1383 1353 1354 1384 # Return here if we can't select. 1355 1385 # This should retrieve the dbversion key. 1356 my $sth = $dbh->prepare("SELECT key,value FROM misc WHERE misc_id=1");1357 $sth->execute();1358 return (undef,$DBI::errstr) if ($sth->err);1386 my $sth = $dbh->prepare("SELECT key,value FROM misc WHERE misc_id=1"); 1387 $sth->execute(); 1388 # return (undef,$DBI::errstr) if ($sth->err); 1359 1389 1360 1390 ##fixme: do stuff to the DB on version mismatch … … 1365 1395 # See if the select returned anything (or null data). This should 1366 1396 # succeed if the select executed, but... 1367 $sth->fetchrow(); 1368 return (undef,$DBI::errstr) if ($sth->err); 1369 1370 $sth->finish; 1397 $sth->fetchrow(); 1398 # return (undef,$DBI::errstr) if ($sth->err); 1399 1400 $sth->finish; 1401 1402 }; # wrapped DB checks 1403 if ($@) { 1404 $errstr = $@; 1405 return; 1406 } 1371 1407 1372 1408 # If we get here, we should be OK. 1373 return ($dbh,"DB connection OK");1409 return $dbh; 1374 1410 } # end connectDB 1375 1411 … … 1379 1415 # Requires a database handle 1380 1416 sub finish { 1381 my $ dbh = $_[0];1382 $ dbh->disconnect;1417 my $self = shift; 1418 $self->{dbh}->disconnect; 1383 1419 } # end finish 1384 1420 … … 1387 1423 # Initialize global variables 1388 1424 # NB: this does NOT include web-specific session variables! 1389 # Requires a database handle1390 1425 sub initGlobals { 1391 my $dbh = shift; 1426 my $self = shift; 1427 my $dbh = $self->{dbh}; 1392 1428 1393 1429 # load record types from database
Note:
See TracChangeset
for help on using the changeset viewer.