That's a bit more involved but Array::Transpose softens the blow a bit.

#!/usr/bin/env perl 
use strict;
use warnings;
use Data::Dumper;
use Array::Transpose;

my @array = (
    ['X1','X2','X3','X4' ],
    ['','foo','',''],
    ['','bar','',''],
    ['','rat','',''],
    ['me','','','']
);

my @at = transpose (\@array);
my @condensed;
for my $row (@at) {
    my @shortrow = sort { (length ($b) > 0  <=> length ($a) > 0) } @$r
+ow;
    push @condensed, \@shortrow;
}
@array = transpose (\@condensed);
print Dumper \@array;
[download]

Removal of trailing rows just containing blanks is left as an exercise to the reader.