The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package TDBICOptions;

use File::Path qw!rmtree!;

my $keep_db = $ENV{KEEP_DB};
my $base_dir = $ENV{BASE_DIR};

sub notify{
    if ($keep_db || $base_dir){
        emit(
            'This test is designed to exercise the keep_db and base_dir options of',
            'the Test::DBIx::Class module. By setting either of these via enviroment',
            'variables you are restricting the coverage of these tests. We will',
            'adapt the tests as required to accommodate these settings.',
            '',
        );
    }
    if ($keep_db){
        emit(
            'keep_db is set to true. We will not delete any databases created by',
            'these tests. We cannot test the automatic cleanup usually done when',
            'keep_db is not true',
            '',
        );
    }
    if($base_dir){
        emit(
            'base_dir is set. We will create all databases in this directory. We',
            'cannot test automatic tmp dir creation.',
            '',
        );
    }
}

sub check_base_dir{
    if (!$keep_db && $base_dir){
        if (-d $base_dir){
            opendir(my $dh, $base_dir) || die "can't opendir $base_dir: $!";
            my @content = grep { !/^\.\.?$/ } readdir($dh);
            die "\n\nWe will not use an existing directory with contents as base_dir without\nkeep_db set, otherwise we will delete existing contents"
                if @content;
            closedir $dh;
        }
    }
}

sub emit{
    foreach(@_){
        print "# $_\n";
    }
}

sub print_dirs_created{
    my ($dirs) = @_;
    if($keep_db){
        print "# tmp dirs created:\n";
        foreach(keys %$dirs){
            print "#\t$_\n";
        }
    }
}

sub dir_created{
    my ($dirs_created, $regex, $diag) = @_;

    if ($base_dir){
        $dir = $base_dir;
    } else {
        ($dir) = $diag =~ $regex;
    }

    if (!$keep_db){
      rmtree($dir) if $dir;
    } else {
        $dirs_created->{$dir} = 1;
    }

    return $dir;
}

1;