One Hat Cyber Team

Your IP: 216.73.216.177
Server IP: 50.6.168.112
Server: Linux server-617809.webnetzimbabwe.com 5.14.0-570.25.1.el9_6.x86_64 #1 SMP PREEMPT_DYNAMIC Wed Jul 9 04:57:09 EDT 2025 x86_64
Server Software: Apache
PHP Version: 8.4.10
Buat File | Buat Folder
Dir : ~/home/.cpan/build/DBD-mysql-5.008-0/t/
View File Name : lib.pl

use strict;
use warnings;

use Test::More;
use DBI::Const::GetInfoType;
use vars qw($mdriver $dbdriver $childPid $test_dsn $test_user $test_password);

$| = 1; # flush stdout asap to keep in sync with stderr

#
#   Driver names; EDIT THIS!
#
$mdriver = 'mysql';
$dbdriver = $mdriver; # $dbdriver is usually just the same as $mdriver.
                      # The exception is DBD::pNET where we have to
                      # to separate between local driver (pNET) and
                      # the remote driver ($dbdriver)


#
#   DSN being used; do not edit this, edit "$dbdriver.dbtest" instead
#


$::COL_NULLABLE = 1;
$::COL_KEY = 2;


my $file;
if (-f ($file = "t/$dbdriver.dbtest")  ||
    -f ($file = "$dbdriver.dbtest")    ||
    -f ($file = "../tests/$dbdriver.dbtest")  ||
    -f ($file = "tests/$dbdriver.dbtest")) {
    eval { require $file; };
    if ($@) {
	print STDERR "Cannot execute $file: $@.\n";
	print "1..0\n";
	exit 0;
    }
    $::test_dsn      = $::test_dsn || $ENV{'DBI_DSN'} || 'DBI:mysql:database=test';
    $::test_user     = $::test_user|| $ENV{'DBI_USER'}  ||  '';
    $::test_password = $::test_password || $ENV{'DBI_PASS'}  ||  '';
}
if (-f ($file = "t/$mdriver.mtest")  ||
    -f ($file = "$mdriver.mtest")    ||
    -f ($file = "../tests/$mdriver.mtest")  ||
    -f ($file = "tests/$mdriver.mtest")) {
    eval { require $file; };
    if ($@) {
	print STDERR "Cannot execute $file: $@.\n";
	print "1..0\n";
	exit 0;
    }
}

sub DbiTestConnect {
    return (eval { DBI->connect(@_) } or do {
        my $err;
        if ( $@ ) {
            $err = $@;
            $err =~ s/ at \S+ line \d+\s*$//;
        }
        if ( not $err ) {
            $err = $DBI::errstr;
            $err = "unknown error" unless $err;
            my $user = $_[1];
            my $dsn = $_[0];
            $dsn =~ s/^DBI:mysql://;
            $err = "DBI connect('$dsn','$user',...) failed: $err";
        }
        if ( $ENV{CONNECTION_TESTING} ) {
            BAIL_OUT "no database connection: $err";
        } else {
            plan skip_all => "no database connection: $err";
        }
    });
}

#
#   Print a DBI error message
#
# TODO - This is on the chopping block
sub DbiError ($$) {
    my ($rc, $err) = @_;
    $rc ||= 0;
    $err ||= '';
    $::numTests ||= 0;
    print "Test $::numTests: DBI error $rc, $err\n";
}

sub connection_id {
    my $dbh = shift;
    return 0 unless $dbh;

    # Paul DuBois says the following is more reliable than
    # $dbh->{'mysql_thread_id'};
    my @row = $dbh->selectrow_array("SELECT CONNECTION_ID()");

    return $row[0];
}

# nice function I saw in DBD::Pg test code
sub byte_string {
    my $ret = join( "|" ,unpack( "C*" ,$_[0] ) );
    return $ret;
}

sub SQL_VARCHAR { 12 };
sub SQL_INTEGER { 4 };

=item CheckRoutinePerms()

Check if the current user of the DBH has permissions to create/drop procedures

    if (!CheckRoutinePerms($dbh)) {
        plan skip_all =>
            "Your test user does not have ALTER_ROUTINE privileges.";
    }

=cut

sub CheckRoutinePerms {
    my $dbh = shift @_;

    # check for necessary privs
    local $dbh->{PrintError} = 0;
    eval { $dbh->do('DROP PROCEDURE IF EXISTS testproc') };
    return if $@ =~ qr/alter routine command denied to user/;

    return 1;
};

=item MinimumVersion()

Check to see if the database where the test run against is
of a certain minimum version

    if (!MinimumVersion($dbh, '5.0')) {
        plan skip_all =>
            "You must have MySQL version 5.0 and greater for this test to run";
    }

=cut

sub MinimumVersion {
    my $dbh = shift @_;
    my $version = shift @_;

    my ($major, $minor) = split (/\./, $version);

    if ( $dbh->get_info($GetInfoType{SQL_DBMS_VER}) =~ /(^\d+)\.(\d+)\./ ) {

        # major version higher than requested
        return 1 if $1 > $major;

        # major version too low
        return if $1 < $major;

        # check minor version
        return 1 if $2 >= $minor;
    }

    return;
}

1;