[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