Лаборатория изучения механизмов органических реакций

reverse

#!/usr/bin/perl

use Getopt::Std;
use warnings 'all';
undef $opt_h;
getopts('n:e:s:hro:');

# Если опция -h, печатаем справку
if ($opt_h) {
  $0 =~ s/^.*[\/\\]//;
  print "
Переставляет в обратном порядке блоки строк в filename

Usage: $0 [option] [filename] [filenames] [> results]
Зависимости: Perl

Опции:
-h            этот help
-n <number>   файл разбивается на куски по <number> строк
-e <regexp>   начало каждого куска - строка, содержащая <regexp>;
              кусок до этой строки (шапка) остается в начале
-o <filename> каждый кусок помещается в файл filename001, filename002 и т.д.,
              а шапка - в filename000
Если опции -n или -e  отсутствуют, то проводится лексический анализ
первой строки и составляется соответствующее регулярное выражение.
\n";
  exit;
}
#-s <sort_rule> сортировать куски по 1-ым строкам, see perldoc -f sort
#-r             обратный порядок сортировки

die "Or -n, or -e\n" if ($opt_n && $opt_e);

@a = (<>);

unless ($opt_n || $opt_e) {
  $opt_e = &do_regexp($a[0]);
  $opt_e = '^' . "$opt_e" . '$';
}
#print "$opt_e\n";

if ($opt_n) {
  $j = 0;
  while (@a) {
    $_ = shift @a;
    $block[$j][0] = $_;
    for $i (1..$opt_n-1) {
      $block[$j][$i] = shift @a;
    }
    $j++;
  }
}
elsif ($opt_e) {
  while (@a) {
    $_ = shift @a;
    last if (/$opt_e/);
    push @shapka, $_;
  }
  $block[0][0] = $_;
  $j = 0;
  while (@a) {
    $_ = shift @a;
    $j++ if (/$opt_e/);
    push @{$block[$j]}, $_;
  }
}

if ($opt_o) {
  if (@shapka) {
    open OUT, ">$opt_o".'000';
    print OUT @shapka;
    close OUT;
  }
  my $i = 0;
  for $aref ( reverse @block ) {
    $i++;
    $incr = sprintf "%03d", $i;
    open OUT, ">$opt_o$incr";
    print OUT @$aref;
    close OUT;
  }
}
else {
  print @shapka if (@shapka);
  for $aref ( reverse @block ) {
          print @$aref;
  }
}

sub do_regexp {
  my $sample = $_[0];
  my $regexp;
  no warnings 'qw';
  my @pattern = qw (
  -?\d+(\.\d+)?[eE]-?\d+
  -?\d+\.\d+
  -?\d+
  \w+
  \s+
  ,
  ;
  \S+
  );

  LOOP:
  {
    foreach $a (@pattern) {
      $regexp .= $a, redo LOOP if $sample =~ /\G$a/gc;
    }
  }
  
  return $regexp;
}


#%block = map { ${$_}[0] => $_ } @block;
##for $aref ( @block ) {
##  $key = ${$aref}[0];
##  print $key;
##  print @$aref;
##  $block{${$aref}[0]} = $aref;
##  print @{$block{$key}};
##}
#foreach $key ( reverse sort keys %block ) {
#  print @{$block{$key}};
#}