view release on metacpan or  search on metacpan

t/errors.t  view on Meta::CPAN

}

#--------
# a file that is a PDB but a damaged one.  Damage is not the caller-s fault
# and must not be fatal: half a structure is usually still worth having, and
# the counts say what was in it.
#--------
{
	my $truncated = "HEADER    TEST                                    01-JAN-20   9ABC\n"
	              . "ATOM      1  N   MET A   1      11.104  13.207  10.000  1.00 15.00           N\n"
	              . "ATOM      2  CA  MET A   1";     # cut off before the coordinates
	my $i;
	lives_ok { $i = structure_info_string($truncated) } 'a file cut off mid-record does not die';
	is($i->{stats}{n_atoms}, 2, 'the half record is still an atom');
	is($i->{chains}{A}{residues}{1}{atoms}{CA}{name}, 'CA', 'with the fields it did have');
	is($i->{chains}{A}{residues}{1}{atoms}{CA}{x}, undef, 'and the ones it lost undef');
	is($i->{chains}{A}{residues}{1}{atoms}{CA}{y}, undef, 'all of them');
	is($i->{chains}{A}{residues}{1}{atoms}{N}{x}, 11.104, 'and the whole records unharmed');
	ok(defined $i->{stats}{bbox}, 'the atom that did have coordinates is still in the bounding box');
}
{
	# a record cut off in the middle of a coordinate, which is the nastier
	# case: x has a number in it and y has nothing
	my $i;
	lives_ok { $i = structure_info_string(
		"ATOM      1  N   MET A   1      11.104  13.2") }
		'a record cut off mid-coordinate does not die either';
	is($i->{chains}{A}{residues}{1}{atoms}{N}{z}, undef, 'the coordinate that is gone is undef');
	ok(!defined $i->{chains}{A}{residues}{1}{center},
		'and a residue with an incomplete coordinate has no centre rather than a wrong one');
}
{
	# a record whose numeric fields are not numbers
	my $junk = "ATOM      1  CA  ALA A   1         abc     def     ghi  1.00 20.00           C\n";
	my $i;
	lives_ok { $i = structure_info_string($junk) } 'unreadable coordinates do not die';
	is($i->{chains}{A}{residues}{1}{atoms}{CA}{x}, undef, 'they come back undef');
	ok(!defined $i->{stats}{bbox}, 'and there is no bounding box to speak of');
}
{
	# an atom with no chain id, which is legal and common in ligand-only files
	my $i = structure_info_string(
		"HETATM    1  C1  LIG     1      10.000  10.000  10.000  1.00 20.00           C\n");
	is_deeply($i->{chain_order}, [''], 'an atom with no chain id lands in a chain named the empty string');
	is($i->{chains}{''}{type}, 'hetero', 'and the chain is a heterogen chain');
}

#--------
# structure_info_string
#--------
throws_ok { structure_info_string(undef) } qr/undefined/, 'undefined text dies';
lives_ok  { structure_info_string('') } 'empty text does not die';
is(structure_info_string('')->{stats}{n_atoms}, 0, 'and reads as nothing');

#--------
# unreadable files
#--------
SKIP: {
	skip 'running as root, which can read anything', 2 if $> == 0;
	my $dir = tempdir(CLEANUP => 1);
	open my $fh, '>', "$dir/locked.pdb" or die $!;
	print {$fh} "ATOM      1  CA  ALA A   1      10.000  10.000  10.000\n";
	close $fh;
	chmod 0000, "$dir/locked.pdb";
	skip 'file is still readable', 2 if -r "$dir/locked.pdb";
	throws_ok { structure_info("$dir/locked.pdb") } qr/cannot read/,
		'a file that cannot be opened dies';
	throws_ok { structure_info("$dir/locked.pdb") } qr/locked\.pdb/,
		'and names the file';
	chmod 0600, "$dir/locked.pdb";
}

done_testing();