#!/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 файл разбивается на куски по строк -e начало каждого куска - строка, содержащая ; кусок до этой строки (шапка) остается в начале -o каждый кусок помещается в файл filename001, filename002 и т.д., а шапка - в filename000 Если опции -n или -e отсутствуют, то проводится лексический анализ первой строки и составляется соответствующее регулярное выражение. \n"; exit; } #-s сортировать куски по 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}}; #}