Pdbcat - perl script that concatenates pdb files

From NMR Wiki

tries to guess chain terminations (detects discontinuities in residue number) and inserts TER statements
adds MODEL and ADDMDL records
does not do anything with chain ID's
only supports ATOM records in the coordinate section, discards all comments

pdbcat [pdb_file_list] > concatenated_file.pdb

#!/usr/bin/perl
#pdb specs for coordinate section can be found here:
#http://www.wwpdb.org/documentation/format23/sect9.html
 
use strict;
 
my @files = @ARGV;
my $i = 1;
 
foreach my $f (@files){
    open F, "<$f" or $!;
    my @lines = <F>;
    printf "%-6s%8d\n", "MODEL",$i;
 
    my @chains = pdb::split_xplor_pdb_chains(\@lines);
 
    foreach my $c (@chains){
        foreach my $l (@$c){
            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 "TER\n";
    }
    print "ENDMDL\n";
    $i++;
}
print "END\n";
 
sub pdb::split_xplor_pdb_chains{
    my $in = shift;
    my $p_resno = 0;
    my @chains;
    my $c_chain = 0;
    $chains[0] = [];
    foreach my $line (@$in){
        next if $line !~ /^ATOM/;
        my @chars = split /|/, $line;
        my $resno = join('',@chars[23 .. 26]);
        #get number of residue
        if ($resno - $p_resno == 1 or $resno == $p_resno){
            #if number stays or increases by one - same residue
            push @{$chains[$c_chain]}, $line;
        }
        else {
            #otherwise start new chain and increment chain number
            my @new_chain;
            push @new_chain, $line;
            push @chains, \@new_chain;
            $c_chain++;
        }
        $p_resno = $resno;
    }
    return @chains;
}