Pdbfixchains - perl script

From NMR Wiki

Jump to: navigation, search

Author: Evgeny Fadeev

  • script sets chain id in multi-model pdb file
  • requires TER statements to be present
#!/usr/bin/perl
#pdb specs for coordinate section can be found here:
#http://www.wwpdb.org/documentation/format23/sect9.html
#this script requires TER statements set
 
use strict;
 
my @lines = <>;
 
my @models = pdb::split_models(\@lines);
 
my $i = 1;
foreach my $m (@models){
        next if scalar(@$m) == 0;
        my $fixed = pdb::fix_chains($m);
 
        printf "%-6s%8d\n", "MODEL",$i;
 
        foreach my $l (@$fixed){
                next if $l =~ /^END$/;
                print $l;
                if ($l !~ /\012|\015|\015\012$/){
                        #last line may not have end of line character
                        #so add it
                        print "\n";
                }
        }
        print "ENDMDL\n";
        $i++;
}
print "END\n";
 
sub pdb::split_models{
        my $lines = shift;
        my @models;
        my $i = 0;
        push @models, [];
        foreach my $line (@lines){
                last if $line =~ /^END\s*$/;
                if ($line =~ /^ENDMDL/){
                        $i++;
                        push @models, [];
                        next;
                }
                next if $line =~ /^MODEL/;
                push @{$models[$i]}, $line;
        }
        return @models;
}
 
sub pdb::fix_chains{
        my $m = shift;
 
        my $ch_id = 1;
        my @out;
        foreach my $line (@$m){
                if ($line =~ /^TER/){
                        $ch_id++;
                }
                if ($line =~ /^ATOM/){
                        $line = pdb::set_atom_chain_id($line,$ch_id);
                }
                push @out, $line;
        }
        return \@out;
}
 
sub pdb::set_atom_chain_id {
        my ($line,$cid) = @_;
        my @bits = split /|/, $line;
        $bits[21] = $cid;
        return join('',@bits);
}
Personal tools