my $dssp_obj = new Bio::Structure::SecStr::DSSP::Res( '-file' => 'filename.dssp' );

  # or

  my $dssp-obj = new Bio::Structure::SecStr::DSSP::Res( '-fh'   => \*STDOUT );

  # get DSSP defined Secondary Structure for residue 20
  $sec_str = $dssp_obj->resSecStr( 20 );

  # get dssp defined sec. structure summary for PDB residue  # 10 of chain A

  $sec_str = $dssp_obj->resSecStrSum( '10:A' );

    ( Dictionary of protein secondary structure: pattern recognition
      of hydrogen-bonded and geometrical features.
      Biopolymers. 1983 Dec;22(12):2577-637. )

    'H' = helix         ( => 'H', 'G', or 'I' from above )
    'B' = beta          ( => 'B' or 'E' from above )
    'T' = turn          ( => 'T' or 'S' from above )
    ' ' = no assignment ( => ' ' from above )

    (#)
     |
     --- Numeric portion of residue ID.  If there is only one chain and
         it has no ID AND there is no residue with an insertion code at this
         number, then this can uniquely specify a residue.

    ('#:C') or ( #, 'C' )
      | |
      | -Chain ID
      ---Numeric portion of residue ID.

  If a residue is incompletely specified then the first residue that
  fits the arguments is returned.  For example, if 19 is the argument
  and there are three chains, A, B, and C with a residue whose number
  is 19, then 19:A will be returned (assuming its listed first).

  Since neither DSSP nor STRIDE correctly handle alt-loc codes, they
  are not supported by these modules.

    my $self = shift;
    if ( $self->{ 'contSegs' } ) {
	return $self->{ 'contSegs' };
    }
    else {
	# first time, so make contSegs
	my ( $cur_chain, $i, $beg );
	my @contSegs;
	#initialize
	$cur_chain = $self->_pdbChain( 1 );
	$beg = 1;
	#internal residues
	for ( $i = 2; $i <= $self->_numResLines() - 1; $i++ ) {
	    if ( $self->{ 'Res' }->[ $i ]->{ 'amino_acid' } eq '!' ) {
		push( @contSegs, [ $beg, $i - 1, $cur_chain ] );
		$beg = $i + 1;
		$cur_chain = $self->_pdbChain( $i + 1 );
	    }
	}
	# last residue must be the end of a chain
	push( @contSegs, [ $beg, $i, $cur_chain ] );

	$self->{ 'contSegs' } =\@ contSegs;
	return $self->{ 'contSegs' };
    }

    my $self = shift;
    return ( $#{$self->{ 'Res' }} );

    my $self = shift;
    my $file = shift;
    my $cur;
    my $current_chain;
    my ( @elements, @hbond );
    my ( %head, %his, );
    my $element;
    my $res_num;

    $cur = <$file>;
    unless ( $cur =~ /^==== Secondary Structure Definition/ ) {
	$self->throw( "Not dssp output" );
	return;
    }

    $cur = <$file>;
    ( $element ) = ( $cur =~ /^REFERENCE\s+(.+?)\s+\./ );
    $head{ 'REFERENCE' } = $element;

    $cur = <$file>;
    @elements = split( /\s+/, $cur );
    pop( @elements ); # take off that annoying period
    $head{ 'PDB' } = pop( @elements );
    $head{ 'DATE' } = pop( @elements );
    # now, everything else is "header" except for the word
    # HEADER
    shift( @elements );
    $element = shift( @elements );
    while ( @elements ) {
	$element = $element." ".shift( @elements );
    }
    $head{ 'HEADER' } = $element;

    $cur = <$file>;
    ($element) = ( $cur =~ /^COMPND\s+(.+?)\s+\./ );
    $head{ 'COMPND' } = $element;

    $cur = <$file>;
    ($element) = ( $cur =~ /^PDBSOURCE\s+(.+?)\s+\./ );
    $head{ 'SOURCE' } = $element;

    $cur = <$file>;
    ($element) = ( $cur =~ /^AUTHOR\s+(.+?)\s+/ );
    $head{ 'AUTHOR' } = $element;
	
    $cur = <$file>;
    @elements = split( /\s+/, $cur );
    shift( @elements );
    $head{ 'TotNumRes' } = shift( @elements );
    $head{ 'NumChain' }  = shift( @elements );
    $head{ 'TotSSBr' }   = shift( @elements );
    $head{ 'TotIaSSBr' } = shift( @elements );
    $head{ 'TotIeSSBr' } = shift( @elements );

    $cur = <$file>;
    ( $element ) = ( $cur =~ /\s*(\d+\.\d*)\s+ACCESSIBLE SURFACE OF PROTEIN/ );
    $head{ 'ProAccSurf' } = $element;
    $self->{ 'Head' } =\% head;

    for ( my $i = 1; $i <= 14; $i++ ) {
	$cur = <$file>;
	( $element ) =
	    $cur =~ /\s*(\d+)\s+\d+\.\d+\s+TOTAL NUMBER OF HYDROGEN/;
	push( @hbond, $element );
#	$hbond{ $hBondType } = $element;
    }
    $self->{ 'HBond' } =\@ hbond;

    my $histogram_finished = 0;
    while ( !($histogram_finished) && chomp( $cur = <$file> ) ) {
	if ( $cur =~ /RESIDUE AA STRUCTURE/ ) {
	    $histogram_finished = 1;
	}
    }

    while ( chomp( $cur = <$file> ) ) {
	$res_num = substr( $cur, 0, 5 );
	$res_num =~ s/\s//g;
	$self->{ 'Res' }->[ $res_num ] = &_parseResLine( $cur );
    }

    my $cur = shift;
    my ( $feat, $value );
    my %elements;

    foreach $feat ( keys %lookUp ) {
	$value = substr( $cur, $lookUp{ $feat }->[0],
			 $lookUp{ $feat }->[1] );
	$value =~ s/\s//g;
	$elements{$feat} = $value ;
    }

    # if no chain id, make it '-' (like STRIDE...very convenient)
    if ( !( $elements{ 'pdb_chain' } ) || $elements{ 'pdb_chain'} eq ' ' ) {
	$elements{ 'pdb_chain' } = '-';
    }
    return\% elements;
}

return 1; #just because

    my $self = shift;
    my $dssp_key = shift;
    return $self->{ 'Res' }->[ $dssp_key ]->{ 'pdb_chain' };

    my $self = shift;
    my $dssp_key = shift;
    return $self->{ 'Res' }->[ $dssp_key ]->{ 'insertionco' };

    my $self = shift;
    my $dssp_key = shift;
    return $self->{ 'Res' }->[ $dssp_key ]->{ 'pdb_resnum' };

    my $self = shift;
    my $dssp_key = shift;
    return $self->{ 'Res' }->[ $dssp_key ]->{ 'amino_acid' };

    # Consider adding lookup table for 'common' name (like 20:A) for
    # fast access.  Could be built during parse of input.

    my $self = shift;
    my $arg_str;

    my ( $key_num, $chain_id, $ins_code );

    # check to see how many args are given
    if ( $#_ > 1 ) { # multiple args
	$key_num = shift;
	if ( $#_ > 1 ) { # still multiple args => ins. code, too
	    $ins_code = shift;
	    $chain_id = shift;
	}
	else { # just one more arg. => chain_id
	    $chain_id = shift;
	}
    }
    else { # only single arg.  Might be number or string
	$arg_str = shift;
	if ( $arg_str =~ /:/ ) {
	    # a chain is specified
	    ( $chain_id ) = ( $arg_str =~ /:(.)/);
	    $arg_str =~ s/:.//;
	}
	if ( $arg_str =~ /[A-Z]|[a-z]/ ) {
	    # an insertion code is specified
	    ( $ins_code ) = ( $arg_str =~ /([A-Z]|[a-z])/ );
	    $arg_str =~ s/[A-Z]|[a-z]//g;
	}
	#now, get the number bit-> everything still around
	$key_num = $arg_str;
    }

    # Now find the residue which fits this description.  Linear search is
    # probably not the best way to do this, but oh well...
    for ( my $i = 1; $i <= $self->_numResLines(); $i++ ) {
	if ( $key_num == $self->{'Res'}->[$i]->{'pdb_resnum'} ) {
	    if ( $chain_id ) { # if a chain was specified
	 	if ( $chain_id eq $self->{'Res'}->[$i]->{'pdb_chain'} ) {
		    # and it's the right one
		    if ( $ins_code ) { # if insertion code was specified
			if ( $ins_code eq $self->{'Res'}->[$i]->{'insertionco'} ) {
			    # and it's the right one
			    return $i;
			}
		    }
		    else { # no isertion code specified, this is it
			return $i;
		    }
		}
	    }
	    else { # no chain was specified
		return $i;
	    }
	}
    }
    $self->throw( "PDB key not found." );

    my $self = shift;
    my $dssp_key = shift;
    my $pdbId = ( $self->_pdbNum( $dssp_key ).
		  $self->_pdbInsCo( $dssp_key ) );
    my $chain = $self->_pdbChain( $dssp_key );
    $pdbId = "$pdbId:$chain" if $chain;
    return $pdbId;

    my $self = shift;
    my $cont_segs = $self->_contSegs();
    my %chains;
    my $seg;
    foreach $seg ( @{ $cont_segs } ) {
	$chains{ $seg->[ 2 ] } = 1;
    }
    my @chains = keys( %chains );
    return\@ chains;

    my $self  = shift;
    my $chain = shift;

    my ( $pot_chain,
	 $seq,
	 $frag_num,
	 $frag,
	 $curPdbNum,
	 $lastPdbNum,
	 $gap_len,
	 $i,
	 $id,
	 );
    my @frags;

    if ( !( $chain ) ) {
	$chain = ' ';
    }

    if ( $self->{ 'Seq' }->{ $chain } ) {
	return $self->{ 'Seq' }->{ $chain };
    }

    my $contSegs_pnt = $self->_contSegs();

    # load up specified chain
    foreach $pot_chain ( @{ $contSegs_pnt } ) {
	if ( $pot_chain->[ 2 ] eq $chain ) {
	    push( @frags, $pot_chain );
	}
    }

    # if that didn't work, just get the first one
    if ( !( @frags ) ) {
	$chain = $contSegs_pnt->[ 0 ]->[ 2 ];
	foreach $pot_chain ( @{ $contSegs_pnt } ) {
	    if ( $pot_chain->[ 2 ] eq $chain ) {
		push( @frags, $chain );
	    }
	}
    }

    # now build the sequence string
    $seq = "";
    $frag_num = 0;
    foreach $frag ( @frags ) {
	$frag_num++;
	if ( $frag_num > 1 ) {  # we need to put in some gap seq
	    $curPdbNum = $self->_pdbNum( $frag->[ 0 ] );
	    $gap_len = $curPdbNum - $lastPdbNum - 1;
	    if ( $gap_len > 0 ) {
		$seq .= 'u' x $gap_len;
	    }
	    else {
		$seq .= 'u';
	    }
	}
	for ( $i = $frag->[ 0 ]; $i <= $frag->[ 1 ]; $i++ ) {
	    $seq .= $self->_resAA( $i );
	}
	$lastPdbNum = $self->_pdbNum( $i - 1 );
    }



    $id = $self->pdbID();
    $id .= ":$chain";

    $self->{ 'Seq' }->{ $chain } =  Bio::PrimarySeq->new ( -seq => $seq,
							   -id  => $id,
							   -moltype => 'protein'
							   );
    return $self->{ 'Seq' }->{ $chain };

    my $self = shift;
    return $self->{ 'HBond'};

    my ( $class, @args ) = @_;
    my $self = $class->SUPER::new( @args );
    my $io = Bio::Root::IO->new( @args );
    $self->_parse( $io->_fh() );
    $io->close();
    return $self;

    my $self = shift;
    my $chain = shift;
    if ( !( $chain ) ) {
	return $self->{'Head'}->{'TotNumRes'};
    }
    else {
	my ( $num_res,
	     $cont_seg );
	my $cont_seg_pnt = $self->_contSegs();
	foreach $cont_seg ( @{ $cont_seg_pnt } ) {
	    if ( $chain eq $cont_seg->[ 2 ] ) {
		# this segment is part of the chain we want
		$num_res += ( $self->_toDsspKey( $cont_seg->[ 1 ] )
			      - $self->_toDsspKey( $cont_seg->[ 0 ] )
			      + 1 ); # this works because we know the
				     # the region between the start
				     # and end of a dssp key is
				     # continuous
	    }
	}
	return $num_res;
    }
}

#  STRAIGHT FROM PDB ENTRY

    my $self = shift;
    return ( $self->{'Head'}->{'TotSSBr'},
	     $self->{'Head'}->{'TotIaSSBr'},
	     $self->{'Head'}->{'TotIeSSBr'} );

    my $self = shift;
    return $self->{'Head'}->{'AUTHOR'};

    my $self = shift;
    return $self->{'Head'}->{'COMPND'};

    my $self = shift;
    return $self->{'Head'}->{'DATE'};

    my $self = shift;
    return $self->{'Head'}->{'HEADER'};

    my $self = shift;
    return $self->{'Head'}->{'PDB'};

    my $self = shift;
    return $self->{'Head'}->{'SOURCE'};
}


# RESIDUE SPECIFIC ACCESSORS

    my $self = shift;
    my @args = @_;
    my $dssp_key = $self->_toDsspKey( @args );
    return $self->{ 'Res' }->[ $dssp_key ]->{ 'amino_acid' };

    my $self = shift;
    my @args = @_;
    my $dssp_key = $self->_toDsspKey( @args );
    return $self->{ 'Res' }->[ $dssp_key ]->{ 'alpha' };
}

# VALUE ADDED METHODS (NOT JUST PARSE/REPORT)

    my $self = shift;
    my @args = @_;
    my $dssp_key = $self->_toDsspKey( @args );
    return ( $self->{ 'Res' }->[ $dssp_key ]->{ 'hb1_nh_o_p' },
	     $self->{ 'Res' }->[ $dssp_key ]->{ 'hb1_nh_o_e' },
	     $self->{ 'Res' }->[ $dssp_key ]->{ 'hb2_nh_o_p' },
	     $self->{ 'Res' }->[ $dssp_key ]->{ 'hb2_nh_o_e' } );

    my $self = shift;
    my @args = @_;
    my $dssp_key = $self->_toDsspKey( @args );
    return ( $self->{ 'Res' }->[ $dssp_key ]->{ 'hb1_o_hn_p' },
	     $self->{ 'Res' }->[ $dssp_key ]->{ 'hb1_o_hn_e' },
	     $self->{ 'Res' }->[ $dssp_key ]->{ 'hb2_o_hn_p' },
	     $self->{ 'Res' }->[ $dssp_key ]->{ 'hb2_o_hn_e' } );

    my $self = shift;
    my @args = @_;
    my $dssp_key = $self->_toDsspKey( @args );
    return $self->{ 'Res' }->[ $dssp_key ]->{ 'kappa' };

    my $self = shift;
    my @args = @_;
    my $dssp_key = $self->_toDsspKey( @args );
    return $self->{ 'Res' }->[ $dssp_key ]->{ 'phi' };

    my $self = shift;
    my @args = @_;
    my $dssp_key = $self->_toDsspKey( @args );
    return $self->{ 'Res' }->[ $dssp_key ]->{ 'psi' };

    my $self = shift;
    my @args = @_;
    my $dssp_key = $self->_toDsspKey( @args );
    my $ss_char = $self->{ 'Res' }->[ $dssp_key ]->{ 'ss_summary' };
    return $ss_char if $ss_char;
    return ' ';

    my $self = shift;
    my @args = @_;
    my $dssp_key = $self->_toDsspKey( @args );
    my $ss_char = $self->{ 'Res' }->[ $dssp_key ]->{ 'ss_summary' };
    if ( $ss_char eq 'H' || $ss_char eq 'G' || $ss_char eq 'I' ) {
	return 'H';
    }
    if ( $ss_char eq ' ' || !( $ss_char ) ) {
	return ' ';
    }
    if ( $ss_char eq 'B' || $ss_char eq 'E' ) {
	return 'B';
    }
    else {
	return 'T';
    }
}

# DSSP SPECIFIC

    my $self = shift;
    my @args = @_;
    my $dssp_key = $self->_toDsspKey( @args );
    return $self->{ 'Res' }->[ $dssp_key ]->{ 'solv_acces' };

    my $self = shift;
    my @args = @_;
    my $dssp_key = $self->_toDsspKey( @args );
    return $self->{ 'Res' }->[ $dssp_key ]->{ 'solv_acces' };

    my $self = shift;
    my @args = @_;
    my $dssp_key = $self->_toDsspKey( @args );
    return $self->{ 'Res' }->[ $dssp_key ]->{ 'tco' };

    my $self = shift;
    my $chain = shift;
    my %sec_bounds;

    $chain = '-' if ( !( $chain ) || $chain eq ' ' || $chain eq '-' );

    # if we've memoized this chain, use that
    if ( $self->{ 'SecBounds' } ) {
	# check to make sure chain is valid
	if ( !( $self->{ 'SecBounds' }->{ $chain } ) ) {
	    $self->throw( "No such chain: $chain\n" );
	}
	return $self->{ 'SecBounds' }->{ $chain };
    }

    my ( $cur_element, $i, $cur_chain, $beg, );

    #initialize
    $cur_element = $self->{ 'Res' }->[ 1 ]->{ 'ss_summary' };
    $beg = 1;

    for ( $i = 2; $i <= $self->_numResLines() - 1; $i++ ) {
	if ( $self->{ 'Res' }->[ $i ]->{ 'amino_acid' } eq '!' ) {
	    # element is terminated by a chain discontinuity
	    push( @{ $sec_bounds{ $self->_pdbChain( $beg ) } },
		  [ $self->_toPdbId( $beg ),
		    $self->_toPdbId( $i - 1 ),
		    $cur_element ] );
	    $i++;
	    $beg = $i;
	    $cur_element = $self->{ 'Res' }->[ $i ]->{ 'ss_summary' };
	}
	
	elsif ( $self->{ 'Res' }->[ $i ]->{ 'ss_summary' } ne $cur_element ) {
	    # element is terminated by beginning of a new element
	    push( @{ $sec_bounds{ $self->_pdbChain( $beg ) } },
		  [ $self->_toPdbId( $beg ),
		    $self->_toPdbId( $i - 1 ),
		    $cur_element ] );
	    $beg = $i;
	    $cur_element = $self->{ 'Res' }->[ $i ]->{ 'ss_summary' };
	}
    }
    #last residue
    if ( $self->{ 'Res' }->[ $i ]->{ 'ss_summary' } eq $cur_element ) {
	push( @{ $sec_bounds{ $self->_pdbChain( $beg ) } },
	      [ $self->_toPdbId( $beg ),
		$self->_toPdbId( $i ),
		$cur_element ] );
    }

    else {
	push( @{ $sec_bounds{ $self->_pdbChain( $beg ) } },
	      [ $self->_toPdbId( $beg ),
		$self->_toPdbId( $i - 1 ),
		$cur_element ] );
	push( @{ $sec_bounds{ $self->_pdbChain( $i ) } },
	      [ $self->_toPdbId( $i ),
		$self->_toPdbId( $i ),
		$self->{ 'Res' }->[ $i ]->{ 'ss_summary' } ] );
    }

    $self->{ 'SecBounds' } =\% sec_bounds;

    # check to make sure chain is valid
    if ( !( $self->{ 'SecBounds' }->{ $chain } ) ) {
	$self->throw( "No such chain: $chain\n" );
    }

    return $self->{ 'SecBounds' }->{ $chain };

    my $self = shift;
    return $self->{ 'Head' }->{ 'ProAccSurf' };

  bioperl-l@bioperl.org          - General discussion
  http://bio.perl.org/MailList.html             - About the mailing lists

  bioperl-bugs@bio.perl.org
  http://bugzilla.bioperl.org/

 Title         : _parseResLine
 Usage         : parses a single residue line
 Function      :
 Example       : used internally
 Returns       :
 Args          : residue line ( string )