view release on metacpan or  search on metacpan

t/remote.t  view on Meta::CPAN

# count
is($dao->count(), 3,         'count() returns 3');
is($dao->count(name => 'Bob'), 1, 'count(name=>Bob) returns 1');
is($dao->count(name => 'Nobody'), 0, 'count for non-existent name returns 0');

# AUTOLOAD
is($dao->name(entry => 'one'), 'Alice', 'AUTOLOAD name(entry=>one) returns Alice');
my @names = $dao->name();
is(scalar @names, 3, 'AUTOLOAD name() list context returns 3');
ok((grep { $_ eq 'Bob' } @names), 'list includes Bob');

# columns / schema
my $cols = $dao->columns();
is(ref($cols), 'ARRAY', 'columns() returns arrayref');
ok((grep { $_ eq 'entry' } @{$cols}), 'columns includes entry');
ok((grep { $_ eq 'name'  } @{$cols}), 'columns includes name');
ok((grep { $_ eq 'score' } @{$cols}), 'columns includes score');

# Query builder
my $q_all = $dao->query()->all();
is(scalar @{$q_all}, 3, 'query()->all() returns all rows');

my $q_first = $dao->query()->where(name => 'Alice')->first();
is($q_first->{'entry'}, 'one', 'query()->where()->first() correct entry');

my $q_count = $dao->query()->where(name => 'Carol')->count();
is($q_count, 1, 'query()->where()->count() returns 1');

# type is set to DBI (CSV goes via DBI::CSV, not slurp for larger files;
# for tiny fixtures it may slurp — just verify the object works)
ok(defined($dao->{'type'}), 'type is set after first data access');

# ---------------------------------------------------------------------------
# Section 2: no_entry CSV remote backend
# ---------------------------------------------------------------------------

my $ne = new_ok('Database::remotene' => [
	host      => 'myhost',
	directory => '/data',
	no_entry  => 1,
	sep_char  => ',',
]);

my $ne_all = $ne->selectall_arrayref();
is(scalar @{$ne_all}, 2, 'no_entry remote CSV: 2 rows');

my ($london) = grep { $_->{'city'} eq 'London' } @{$ne_all};
ok(defined $london, 'London row found');
is($london->{'pop'}, 9000000, 'London pop correct');

# ---------------------------------------------------------------------------
# Section 3: DESTROY cleans up temp directory
# ---------------------------------------------------------------------------

my $tmpdir_path;
{
	my $tmp_dao = Database::remote->new(host => 'myhost', directory => '/data');
	$tmp_dao->selectall_arrayref();	# trigger _open
	my $obj = $tmp_dao->{'_remote_tmpdir'};
	$tmpdir_path = ref($obj) ? $obj->dirname() : undef;
	ok(defined($tmpdir_path) && -d $tmpdir_path, 'remote tmpdir exists while object alive');
}	# DESTROY fires here

ok(!-d $tmpdir_path, 'remote tmpdir removed after object destroyed')
	if defined($tmpdir_path);

# ---------------------------------------------------------------------------
# Section 4: Input validation — unsafe host name
# ---------------------------------------------------------------------------

throws_ok(
	sub { Database::remote->new(host => 'bad host; rm -rf /', directory => '/data') },
	qr/unsafe host/,
	'hostile host name with spaces/semicolon is rejected',
);

throws_ok(
	sub { Database::remote->new(host => '../../etc/passwd', directory => '/data') },
	qr/unsafe host/,
	'path-traversal host name is rejected',
);

throws_ok(
	sub { Database::remote->new(host => '$(evil)', directory => '/data') },
	qr/unsafe host/,
	'shell-expansion host name is rejected',
);

# Valid host forms accepted (no croak at construction time)
ok(
	eval { Database::remote->new(host => 'myserver.example.com', directory => '/data'); 1 },
	'plain hostname accepted',
);
ok(
	eval { Database::remote->new(host => 'user@myserver', directory => '/data'); 1 },
	'user@host form accepted',
);

done_testing();