[Bioperl-guts-l] bioperl-live/Bio/Structure/IO pdb.pm,1.17,1.18
Mauricio Herrera Cuadra
mauricio at dev.open-bio.org
Tue Sep 19 01:31:55 EDT 2006
Update of /home/repository/bioperl/bioperl-live/Bio/Structure/IO
In directory dev.open-bio.org:/tmp/cvs-serv30958/Bio/Structure/IO
Modified Files:
pdb.pm
Log Message:
Updating URLs
Index: pdb.pm
===================================================================
RCS file: /home/repository/bioperl/bioperl-live/Bio/Structure/IO/pdb.pm,v
retrieving revision 1.17
retrieving revision 1.18
diff -C2 -d -r1.17 -r1.18
*** pdb.pm 27 Jul 2006 17:41:44 -0000 1.17
--- pdb.pm 19 Sep 2006 05:31:53 -0000 1.18
***************
*** 8,12 ****
#
# Framework is a copy of Bio::SeqIO::embl.pm
! #
# You may distribute this module under the same terms as perl itself
--- 8,12 ----
#
# Framework is a copy of Bio::SeqIO::embl.pm
! #
# You may distribute this module under the same terms as perl itself
***************
*** 22,26 ****
rather go through the Bio::Structure::IO handler system. Go:
! $stream = Bio::Structure::IO->new(-file => $filename,
-format => 'PDB');
--- 22,26 ----
rather go through the Bio::Structure::IO handler system. Go:
! $stream = Bio::Structure::IO->new(-file => $filename,
-format => 'PDB');
***************
*** 32,36 ****
This object can transform Bio::Structure objects to and from PDB flat
! file databases. The working is similar to that of the Bio::SeqIO handlers.
=head1 FEEDBACK
--- 32,36 ----
This object can transform Bio::Structure objects to and from PDB flat
! file databases. The working is similar to that of the Bio::SeqIO handlers.
=head1 FEEDBACK
***************
*** 38,48 ****
=head2 Mailing Lists
! User feedback is an integral part of the evolution of this
! and other Bioperl modules. Send your comments and suggestions preferably
! to one of the Bioperl mailing lists.
! Your participation is much appreciated.
bioperl-l at bioperl.org - General discussion
! http://www.bioperl.org/MailList.shtml - About the mailing lists
=head2 Reporting Bugs
--- 38,47 ----
=head2 Mailing Lists
! User feedback is an integral part of the evolution of this and other
! Bioperl modules. Send your comments and suggestions preferably to one
! of the Bioperl mailing lists. Your participation is much appreciated.
bioperl-l at bioperl.org - General discussion
! http://bioperl.org/wiki/Mailing_lists - About the mailing lists
=head2 Reporting Bugs
***************
*** 60,64 ****
=head1 APPENDIX
! The rest of the documentation details each of the object methods.
Internal methods are usually preceded with a _
--- 59,63 ----
=head1 APPENDIX
! The rest of the documentation details each of the object methods.
Internal methods are usually preceded with a _
***************
*** 86,90 ****
my($self, at args) = @_;
! $self->SUPER::_initialize(@args);
my ($noheader, $noatom) =
--- 85,89 ----
my($self, at args) = @_;
! $self->SUPER::_initialize(@args);
my ($noheader, $noatom) =
***************
*** 131,135 ****
$line =~/\S/ && last;
}
! }
if( !defined $line ) {
return; # end of file
--- 130,134 ----
$line =~/\S/ && last;
}
! }
if( !defined $line ) {
return; # end of file
***************
*** 144,148 ****
my $buffer = $line;
!
BEFORE_COORDINATES :
until( !defined $buffer ) {
--- 143,147 ----
my $buffer = $line;
!
BEFORE_COORDINATES :
until( !defined $buffer ) {
***************
*** 194,198 ****
$header{'expdta'} = $expdta;
}
!
# AUTHOR line(s)
if (/^AUTHOR / && $all_headers) {
--- 193,197 ----
$header{'expdta'} = $expdta;
}
!
# AUTHOR line(s)
if (/^AUTHOR / && $all_headers) {
***************
*** 239,243 ****
# REMARK_1 line. We need to parse it in this pass (so no else block)
$_ = $buffer;
! }
# for the moment I don't see a better solution (other then using goto)
if (/^REMARK\s+(\d+)\s*/) {
--- 238,242 ----
# REMARK_1 line. We need to parse it in this pass (so no else block)
$_ = $buffer;
! }
# for the moment I don't see a better solution (other then using goto)
if (/^REMARK\s+(\d+)\s*/) {
***************
*** 279,283 ****
$header{'seqres'} .= $rol;
} # SEQRES
!
# MODRES line(s)
if (/^MODRES / && $all_headers) {
--- 278,282 ----
$header{'seqres'} .= $rol;
} # SEQRES
!
# MODRES line(s)
if (/^MODRES / && $all_headers) {
***************
*** 309,313 ****
$header{'formul'} .= $rol;
} # FORMUL
!
# HELIX line(s)
# store as specific object ??
--- 308,312 ----
$header{'formul'} .= $rol;
} # FORMUL
!
# HELIX line(s)
# store as specific object ??
***************
*** 316,320 ****
$header{'helix'} .= $rol;
} # HELIX
!
# SHEET line(s)
# store as specific object ??
--- 315,319 ----
$header{'helix'} .= $rol;
} # HELIX
!
# SHEET line(s)
# store as specific object ??
***************
*** 400,404 ****
$header{$scalen} .= $rol;
} # SCALEn
!
# MTRIXn line(s) (n=1,2,3)
if (/^(MTRIX\d) / && $all_headers) {
--- 399,403 ----
$header{$scalen} .= $rol;
} # SCALEn
!
# MTRIXn line(s) (n=1,2,3)
if (/^(MTRIX\d) / && $all_headers) {
***************
*** 418,422 ****
$buffer = $self->_readline;
}
!
# store %header entries a annotations
if (%header) {
--- 417,421 ----
$buffer = $self->_readline;
}
!
# store %header entries a annotations
if (%header) {
***************
*** 435,439 ****
}
}
!
# Coordinate section, the real meat
#
--- 434,438 ----
}
}
!
# Coordinate section, the real meat
#
***************
*** 453,466 ****
last;
}
! }
! }
else {
$self->throw("Could not find a coordinate section in this record\n");
}
!
until( !defined $buffer ) {
$_ = $buffer;
!
# CONNECT records
if (/^CONECT/) {
--- 452,465 ----
last;
}
! }
! }
else {
$self->throw("Could not find a coordinate section in this record\n");
}
!
until( !defined $buffer ) {
$_ = $buffer;
!
# CONNECT records
if (/^CONECT/) {
***************
*** 503,510 ****
# this it the end ...
}
!
$buffer = $self->_readline;
}
!
return $struc;
--- 502,509 ----
# this it the end ...
}
!
$buffer = $self->_readline;
}
!
return $struc;
***************
*** 533,537 ****
# HEADER
($ann) = $struc->annotation->get_Annotations("header");
! if ($ann) {
$string = $ann->as_text;
$string =~ s/^Value: //;
--- 532,536 ----
# HEADER
($ann) = $struc->annotation->get_Annotations("header");
! if ($ann) {
$string = $ann->as_text;
$string =~ s/^Value: //;
***************
*** 559,575 ****
exists $header{'obslte'} && $self->_write_PDB_simple_record(-name => "OBSLTE ", -cont => "9-10",
-annotation => $struc->annotation->get_Annotations("obslte"), -rol => "11-70");
!
exists $header{'title'} && $self->_write_PDB_simple_record(-name => "TITLE ", -cont => "9-10",
-annotation => $struc->annotation->get_Annotations("title"), -rol => "11-70");
!
exists $header{'caveat'} && $self->_write_PDB_simple_record(-name => "CAVEAT ", -cont => "9-10",
-annotation => $struc->annotation->get_Annotations("caveat"), -rol => "12-70");
!
exists $header{'compnd'} && $self->_write_PDB_simple_record(-name => "COMPND ", -cont => "9-10",
-annotation => $struc->annotation->get_Annotations("compnd"), -rol => "11-70");
!
exists $header{'source'} && $self->_write_PDB_simple_record(-name => "SOURCE ", -cont => "9-10",
-annotation => $struc->annotation->get_Annotations("source"), -rol => "11-70");
!
exists $header{'keywds'} && $self->_write_PDB_simple_record(-name => "KEYWDS ", -cont => "9-10",
-annotation => $struc->annotation->get_Annotations("keywds"), -rol => "11-70");
--- 558,574 ----
exists $header{'obslte'} && $self->_write_PDB_simple_record(-name => "OBSLTE ", -cont => "9-10",
-annotation => $struc->annotation->get_Annotations("obslte"), -rol => "11-70");
!
exists $header{'title'} && $self->_write_PDB_simple_record(-name => "TITLE ", -cont => "9-10",
-annotation => $struc->annotation->get_Annotations("title"), -rol => "11-70");
!
exists $header{'caveat'} && $self->_write_PDB_simple_record(-name => "CAVEAT ", -cont => "9-10",
-annotation => $struc->annotation->get_Annotations("caveat"), -rol => "12-70");
!
exists $header{'compnd'} && $self->_write_PDB_simple_record(-name => "COMPND ", -cont => "9-10",
-annotation => $struc->annotation->get_Annotations("compnd"), -rol => "11-70");
!
exists $header{'source'} && $self->_write_PDB_simple_record(-name => "SOURCE ", -cont => "9-10",
-annotation => $struc->annotation->get_Annotations("source"), -rol => "11-70");
!
exists $header{'keywds'} && $self->_write_PDB_simple_record(-name => "KEYWDS ", -cont => "9-10",
-annotation => $struc->annotation->get_Annotations("keywds"), -rol => "11-70");
***************
*** 704,708 ****
exists $header{'tvect'} && $self->_write_PDB_simple_record(-name => "TVECT ",
-annotation => $struc->annotation->get_Annotations("tvect"), -rol => "8-70");
!
# write out coordinate section
#
--- 703,707 ----
exists $header{'tvect'} && $self->_write_PDB_simple_record(-name => "TVECT ",
-annotation => $struc->annotation->get_Annotations("tvect"), -rol => "8-70");
!
# write out coordinate section
#
***************
*** 731,735 ****
$chain_id = $chain->id;
if ( $chain_id eq "default" ) {
! $chain_id = " ";
}
$self->debug("model_id: $model->id chain_id: $chain_id\n");
--- 730,734 ----
$chain_id = $chain->id;
if ( $chain_id eq "default" ) {
! $chain_id = " ";
}
$self->debug("model_id: $model->id chain_id: $chain_id\n");
***************
*** 776,780 ****
# ie. Calcium should be "CA "
# C alpha should be " CA "
! if( length($element) == 2 ) {
$atom_line .= sprintf("%-4s", $atom->id);
} else {
--- 775,779 ----
# ie. Calcium should be "CA "
# C alpha should be " CA "
! if( length($element) == 2 ) {
$atom_line .= sprintf("%-4s", $atom->id);
} else {
***************
*** 811,818 ****
sprintf("%-4s", $atom->segID) :
" ";
! $atom_line .= $atom->element ?
sprintf("%2s", $atom->element) :
" ";
! $atom_line .= $atom->charge ?
sprintf("%2s", $atom->charge) :
" ";
--- 810,817 ----
sprintf("%-4s", $atom->segID) :
" ";
! $atom_line .= $atom->element ?
sprintf("%2s", $atom->element) :
" ";
! $atom_line .= $atom->charge ?
sprintf("%2s", $atom->charge) :
" ";
***************
*** 885,894 ****
}
}
!
# MASTER line contains checksums, we should calculate them of course :)
my $master_line = "MASTER " . $struc->master;
$master_line .= " " x (80 - length($master_line) );
$self->_print($master_line, "\n");
!
my $end_line = "END" . " " x 77;
$self->_print($end_line,"\n");
--- 884,893 ----
}
}
!
# MASTER line contains checksums, we should calculate them of course :)
my $master_line = "MASTER " . $struc->master;
$master_line .= " " x (80 - length($master_line) );
$self->_print($master_line, "\n");
!
my $end_line = "END" . " " x 77;
$self->_print($end_line,"\n");
***************
*** 900,905 ****
Title : _filehandle
Usage : $obj->_filehandle($newval)
! Function:
! Example :
Returns : value of _filehandle
Args : newvalue (optional)
--- 899,904 ----
Title : _filehandle
Usage : $obj->_filehandle($newval)
! Function:
! Example :
Returns : value of _filehandle
Args : newvalue (optional)
***************
*** 920,926 ****
Title : _noatom
Usage : $obj->_noatom($newval)
! Function:
! Example :
! Returns : value of _noatom
Args : newvalue (optional)
--- 919,925 ----
Title : _noatom
Usage : $obj->_noatom($newval)
! Function:
! Example :
! Returns : value of _noatom
Args : newvalue (optional)
***************
*** 941,947 ****
Title : _noheader
Usage : $obj->_noheader($newval)
! Function:
! Example :
! Returns : value of _noheader
Args : newvalue (optional)
--- 940,946 ----
Title : _noheader
Usage : $obj->_noheader($newval)
! Function:
! Example :
! Returns : value of _noheader
Args : newvalue (optional)
***************
*** 988,1001 ****
}
## no space (store litteraly) $concat_line .= $rol . " ";
! $concat_line .= $rol;
} else {
last;
}
!
$_ = undef;
}
$concat_line =~ s/\s$//; # remove trailing space
$$buffer = $_;
!
return $concat_line;
}
--- 987,1000 ----
}
## no space (store litteraly) $concat_line .= $rol . " ";
! $concat_line .= $rol;
} else {
last;
}
!
$_ = undef;
}
$concat_line =~ s/\s$//; # remove trailing space
$$buffer = $_;
!
return $concat_line;
}
***************
*** 1008,1012 ****
Function: read jrnl record from PDB
Returns : Bio::Annotation::Reference object
! Args :
=cut
--- 1007,1011 ----
Function: read jrnl record from PDB
Returns : Bio::Annotation::Reference object
! Args :
=cut
***************
*** 1014,1018 ****
sub _read_PDB_jrnl {
my ($self, $buffer) = @_;
!
$_ = $$buffer;
my ($auth, $titl,$edit,$ref,$publ,$refn);
--- 1013,1017 ----
sub _read_PDB_jrnl {
my ($self, $buffer) = @_;
!
$_ = $$buffer;
my ($auth, $titl,$edit,$ref,$publ,$refn);
***************
*** 1044,1048 ****
$jrnl_ref->editors($edit);
$jrnl_ref->encoded_ref($refn);
!
return $jrnl_ref;
} # sub _read_PDB_jrnl
--- 1043,1047 ----
$jrnl_ref->editors($edit);
$jrnl_ref->encoded_ref($refn);
!
return $jrnl_ref;
} # sub _read_PDB_jrnl
***************
*** 1055,1059 ****
Function: read "remark 1" record from PDB
Returns : array of Bio::Annotation::Reference objects
! Args :
=cut
--- 1054,1058 ----
Function: read "remark 1" record from PDB
Returns : array of Bio::Annotation::Reference objects
! Args :
=cut
***************
*** 1061,1065 ****
sub _read_PDB_remark_1 {
my ($self, $buffer) = @_;
!
$_ = $$buffer;
my ($auth, $titl,$edit,$ref,$publ,$refn,$refnum);
--- 1060,1064 ----
sub _read_PDB_remark_1 {
my ($self, $buffer) = @_;
!
$_ = $$buffer;
my ($auth, $titl,$edit,$ref,$publ,$refn,$refnum);
***************
*** 1114,1118 ****
$$buffer = $_;
!
return @refs;
} # sub _read_PDB_jrnl
--- 1113,1117 ----
$$buffer = $_;
!
return @refs;
} # sub _read_PDB_jrnl
***************
*** 1125,1129 ****
Function: read one model from a PDB
Returns : Bio::Structure::Model object
! Args :
=cut
--- 1124,1128 ----
Function: read one model from a PDB
Returns : Bio::Structure::Model object
! Args :
=cut
***************
*** 1156,1160 ****
$old = 1;
}
! }
# old hier ook setten XXX
# ATOM lines, if first set chain
--- 1155,1159 ----
$old = 1;
}
! }
# old hier ook setten XXX
# ATOM lines, if first set chain
***************
*** 1167,1178 ****
$line_elements[$k] = undef if ($line_elements[$k] =~ /^\s*$/);
}
! my ($serial, $atomname, $altloc, $resname, $chainID, $resseq, $icode, $x, $y, $z,
$occupancy, $tempfactor, $segID, $element, $charge) = @line_elements;
! $chainID = 'default' if ( !defined $chainID );
if ($chainID ne $chain_name) { # possibly a new chain
# fix for bug #1187
# we can have ATOM/HETATM of an already defined chain (A B A B)
# e.g. 1abm
!
if (exists $_ch_in_model{$chainID} ) { # we have already seen this chain in this model
$chain = $_ch_in_model{$chainID};
--- 1166,1177 ----
$line_elements[$k] = undef if ($line_elements[$k] =~ /^\s*$/);
}
! my ($serial, $atomname, $altloc, $resname, $chainID, $resseq, $icode, $x, $y, $z,
$occupancy, $tempfactor, $segID, $element, $charge) = @line_elements;
! $chainID = 'default' if ( !defined $chainID );
if ($chainID ne $chain_name) { # possibly a new chain
# fix for bug #1187
# we can have ATOM/HETATM of an already defined chain (A B A B)
# e.g. 1abm
!
if (exists $_ch_in_model{$chainID} ) { # we have already seen this chain in this model
$chain = $_ch_in_model{$chainID};
***************
*** 1193,1197 ****
$residue->id($res_name_num);
$residue_name = $res_name_num;
! $atom_name = ""; # only needed inside a residue
}
# get out of here if we don't want the atom objects
--- 1192,1196 ----
$residue->id($res_name_num);
$residue_name = $res_name_num;
! $atom_name = ""; # only needed inside a residue
}
# get out of here if we don't want the atom objects
***************
*** 1239,1243 ****
$atom->sigtemp($sigtemp);
! }
} # ATOM|HETARM|SIGATM
--- 1238,1242 ----
$atom->sigtemp($sigtemp);
! }
} # ATOM|HETARM|SIGATM
***************
*** 1254,1258 ****
$line_elements[$k] = undef if ($line_elements[$k] =~ /^\s*$/);
}
! my ($serial, $atomname, $altloc, $resname, $chainID, $resseq, $icode,
$u11,$u22, $u33, $u12, $u13, $u23, $segID, $element, $charge) = @line_elements;
$self->debug("read_PDB_coor: parsing ANISOU record: $serial $atomname\n");
--- 1253,1257 ----
$line_elements[$k] = undef if ($line_elements[$k] =~ /^\s*$/);
}
! my ($serial, $atomname, $altloc, $resname, $chainID, $resseq, $icode,
$u11,$u22, $u33, $u12, $u13, $u23, $segID, $element, $charge) = @line_elements;
$self->debug("read_PDB_coor: parsing ANISOU record: $serial $atomname\n");
***************
*** 1271,1275 ****
$atom->aniso("u13",$u13);
$atom->aniso("u23",$u23);
! }
else { # SIGUIJ
if ($atom_name ne $atomname) { # something wrong with PDB file
--- 1270,1274 ----
$atom->aniso("u13",$u13);
$atom->aniso("u23",$u23);
! }
else { # SIGUIJ
if ($atom_name ne $atomname) { # something wrong with PDB file
***************
*** 1302,1306 ****
$_ = undef;
! } # while
$$buffer = $_;
--- 1301,1305 ----
$_ = undef;
! } # while
$$buffer = $_;
***************
*** 1312,1316 ****
sub _write_PDB_simple_record {
my ($self, @args) = @_;
! my ($name, $cont , $annotation, $rol, $string) =
$self->_rearrange([qw(
NAME
--- 1311,1315 ----
sub _write_PDB_simple_record {
my ($self, @args) = @_;
! my ($name, $cont , $annotation, $rol, $string) =
$self->_rearrange([qw(
NAME
***************
*** 1357,1361 ****
# ann_string contains the thing to write out, writing out happens below
my $ann_length = length $ann_string;
!
$self->debug("ann_string: $ann_string\n");
if ($cont) {
--- 1356,1360 ----
# ann_string contains the thing to write out, writing out happens below
my $ann_length = length $ann_string;
!
$self->debug("ann_string: $ann_string\n");
if ($cont) {
***************
*** 1367,1371 ****
my $num_pos = $rol_length;
my $i = 0;
! while( $i < $ann_length ) {
$t_string = substr($ann_string, $i, $num_pos);
$self->debug("t_string: $t_string~~$i $num_pos\n");
--- 1366,1370 ----
my $num_pos = $rol_length;
my $i = 0;
! while( $i < $ann_length ) {
$t_string = substr($ann_string, $i, $num_pos);
$self->debug("t_string: $t_string~~$i $num_pos\n");
More information about the Bioperl-guts-l
mailing list