#!/usr/bin/perl -w

if (!@ARGV or $ARGV[0] =~ /^--?h(?:elp)?$/) {
  shift @ARGV if @ARGV;
  (my $program = $0) =~ s/^.*[\/\\]//;
  print "
  Usage: $program *.xyz|dirs
  Зависимости: Perl
  
Печатает отсортированный список брутто-формул (по Хиллу) xyz-файлов, 
заданных в параметрах или найденных (рекурсивно) в dirs.
Если параметр только один, и это директория, то ее имя не печатается.
  
Полезность этой программы заключается в следующем:
Скажем, у меня уже набралось много тысяч расчетов, и часто помню, что считал
такую молекулу, не не помню, где искать (особенно если она названа моим 
любимым именем: ttt). Тогда делаю так
$program dir_with_calcs | grep C20H20
\n";
  exit;
}

use File::Find;

my %fxyz;

foreach my $file (@ARGV) {
  add_to_fxyz($file) && next if -f $file;
  if (-d $file) {
    find {
      wanted   => sub {add_to_fxyz($File::Find::name) if m/\.xyz(ppm)?$/}, 
      no_chdir => 1, 
      bydepth  => 1
    } => $file;
  }
}

foreach my $formula (sort {&by_formula} keys %fxyz) {
  foreach (sort @{$fxyz{$formula}}) {
    # Если параметр только один, и это директория, то обрезаем ее имя
    if (@ARGV == 1 and -d $ARGV[0]) {
      (my $dir = $ARGV[0]) =~s/\/$//;
      s|^$dir/||;
    }
    printf "%-12s %s\n", $formula, $_;
  }
}

sub add_to_fxyz {
  my $file = shift;
  my $formula = get_formula($file);
  return unless $formula;
  chomp $formula;
  push @{$fxyz{$formula}}, $file;
}

sub get_formula {
  my $file = shift;
  open my $fh, '<', $file or return undef;
  if ( read_molden($fh) ) {
    undef my %f;
    my $formula = '';
    $f{ucfirst lc $_}++ foreach @atom[1..$#atom];
    foreach (sort by_Hill keys %f) {
      $formula .= $_ . ($f{$_}==1 ? '' : $f{$_});
    }
    return $formula;
  }
  close $fh;
}

sub by_Hill {
  return -1 if uc($a) eq 'C' and uc($b) ne 'C';
  return  1 if uc($a) ne 'C' and uc($b) eq 'C';
  return -1 if uc($a) eq 'H' and uc($b) ne 'H';
  return  1 if uc($a) ne 'H' and uc($b) eq 'H';
  uc($a) cmp uc($b);
}

sub by_formula {
  my $aa = $a;
  my $bb = $b;
  $aa =~ s/([A-Z](?:[a-z]*))(?!\d)/${1}1/g;
  $bb =~ s/([A-Z](?:[a-z]*))(?!\d)/${1}1/g;
  $aa =~ s/(\d+)/sprintf("%03d",$1)/eg;
  $bb =~ s/(\d+)/sprintf("%03d",$1)/eg;
  $aa cmp $bb;
}


sub read_molden {
  my $fh = shift;
  return undef if eof($fh);
  # 1-st string
  if (<$fh>=~/^\s*(\d+)\s*$/) {
#    ($N,$energy,@atom,@x,@y,@z,@ppm) = undef;
    ($N,@atom) = undef;
    $N = $1;
  } else {
    return undef;
  }
  # 2-nd string
#  ($energy) = <$fh>=~/(-?\d+\.\d+)/;
  <$fh>;
  # Geometry
  for ($i=1;$i<=$N;$i++) {
#    ($atom[$i],$x[$i],$y[$i],$z[$i],$ppm[$i],undef) = split ' ', <$fh>;
#    return undef unless $atom[$i] && $atom[$i]=~/^\w\w?/ and
#                        $x[$i] && $x[$i]=~/^-?\d+\.\d+/ and
#                        $y[$i] && $y[$i]=~/^-?\d+\.\d+/ and
#                        $z[$i] && $z[$i]=~/^-?\d+\.\d+/;
    $atom[$i] = $1 if <$fh> =~ /^\s*(\w\w?)\s/;
    return undef unless $atom[$i];
  }
  return $N;
}