source: branches/cname-collision/t/DNSTest.pm@ 1002

# -*- Perl -*-

# Base class for DNSDB.pm unit testing
# Sets up DB connection and repopulates it for a consistent test reference
##
# $Id: DNSTest.pm 999 2026-01-23 21:00:29Z kdeugau $
# Copyright 2025 Kris Deugau <kdeugau@deepnet.cx>
# 
#    This program is free software: you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation, either version 3 of the License, or
#    (at your option) any later version. 
# 
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
# 
#    You should have received a copy of the GNU General Public License
#    along with this program.  If not, see <http://www.gnu.org/licenses/>.
##

package DNSTest;
use strict;
use warnings;
use Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
@ISA            = qw(Exporter);
@EXPORT         = qw($dnsdb $dbh);

use Test::More;

use lib '.';
use DNSDB;

our $dnsdb;
our $dbh;
our $debug;

sub new {
  my $this = shift;
  my $class = ref($this) || $this;
  my %args = @_;

  $dnsdb = new DNSDB(
        dbhost => 'localhost',
        dbname => 'dnstest',
        dbuser => 'dnstest',
        dbpass => 'dnstestpwd',

        # This exercises more branches of the CNAME collision check with more fine-grained results.
        coerce_cname_timestamp => 'adjust',
  );
  ok( defined $dnsdb );
  ok( $dnsdb->isa('DNSDB') );

  $debug = 1 if $args{debug};

  ## Prepare the DB
  # Check that we aren't in an obviously production DB before blowing it away.
  # A DB instantiated for these tests should have a known set of domains and records.

  $dbh = $dnsdb->{dbh};

  my ($dcount) = $dbh->selectrow_array("SELECT count(*) FROM domains WHERE NOT domain IN ".
        "('example.com','example.net','example.org','expiry1.test','expiry2.test')");
  BAIL_OUT("# DB looks like it may not be a test DB, found $dcount > 0 non-test domains!\n")
        if $dcount > 0;
  cmp_ok( $dcount, '==', 0, "non-test domain count ($dcount): looks like a test DB" );

  my ($rcount) = $dbh->selectrow_array(qq{SELECT count(*) FROM records WHERE NOT (
        host like '%example.com' or host like '%example.net' or host like '%example.org' or
        host like '%expiry1.test' or host like '%expiry2.test' or inetlazy(val) << '192.168.2.0/27'
        )});
  my $maxrecs = 0;
  BAIL_OUT("# DB looks like it may not be a test DB, found $rcount > $maxrecs records!\n")
        if $rcount > $maxrecs;
  cmp_ok( $rcount, '<=', $maxrecs, "non-test record ($rcount): looks like a test DB" );

  # drop all tables etc
  $ENV{PGPASSWORD} = $dnsdb->{dbpass};
# neither diag or note seem to suppress output from qx
  my $dropdata = qx( psql -h $dnsdb->{dbhost} -U $dnsdb->{dbuser} $dnsdb->{dbname} 2>&1 < t/dropall.sql );
  diag( $dropdata ) if $debug;
  # load some standard test data
  my $reload = qx( psql -h $dnsdb->{dbhost} -U $dnsdb->{dbuser} $dnsdb->{dbname} 2>&1 < t/dns-unitbase.sql );
  diag( $reload ) if $debug;
  # Set timestamps to a sliding window
  my $stampwindow = qx( psql -h $dnsdb->{dbhost} -U $dnsdb->{dbuser} $dnsdb->{dbname} 2>&1 < t/test-cname-timestamps.sql );
  diag( $stampwindow ) if $debug;
  undef $ENV{PGPASSWORD};
} # new()

sub DESTROY {
  $dnsdb->finish;
}

1;