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

mask

#!/usr/bin/perl -ws

#use Data::Dump::Color('dd');

our ($h,$re);
if ($h) {
  (my $program = $0) =~ s/^.*[\/\\]//;
  print "Inverse bash expansion
Usage: $program filenames_list
Generate glob pattern for filenames_list (suitable only for this list). 

> $program f1.ext f2.ext f3.ext
f{1,2,3}.ext

> $program -re f1.ext f2.ext f3.ext
f[1-3].ext

> $program -re f2.ext f1.ext f3.ext
f{2,1,3}.ext

> $program -re=sort f2.ext f1.ext f3.ext
f[1-3].ext

> echo f1.ext f2.ext f3.ext | $program
f{1,2,3}.ext

Commands 'ls *.ext' and 'ls `$program *.ext`' should give the same output.
-re is experimental option.
";
  exit;
}
if (-p STDIN) {
  my @in = <STDIN>; # if pipe to stdin
  unshift @ARGV, map {split ' '} @in;
  #print "@ARGV\n"; exit;
}

exit unless @ARGV;
#exec("$0 -h") unless @ARGV;

#if (@ARGV == 1) {
#  print "@ARGV\n";
#  exit;
#}

my @a = @ARGV;
my $end = delete_eq_end(\@a);
my $begin = delete_eq_begin(\@a);

# Try convert {1,2,3,4,5} to [1-5]. Experimental
if ($re) {
  my @aa;
  @a = sort @a if $re eq 'sort';
  for (my $i=0; $i<@a; $i++) {
    if ($a[$i] !~ /(.*?)([0-8a-yA-Y])$/) {
      push @aa, $a[$i];
      next;
    }
    push @aa, [$a[$i]];
    last if $i == $#a;
    my ($b,$e) = ($1,$2);
    while ($a[$i+1] eq $b.++$e) {
      $aa[-1][1] = $e;
      $i++;
      last if $i == $#a;
    }
  }
  #dd @aa; exit;
  foreach (@aa) {
    next unless ref;
    if (@$_ == 1) {
      $_ = $_->[0];
      next;
    }
    my $e = $_->[1];
    $_ = $_->[0];
    s/(.)$/[$1-$e]/;
  }
  @a = @aa;
}

print $begin, '{';
print join(',', @a);
print '}', "$end\n";

sub delete_eq_end {
  my $aref = shift;
  return '' if @$aref == 1;
  my $end = '';
  while (1) {
    my @a = @$aref;
    $a0 = substr $a[0], -1, 1, '';
    for (my $i=1; $i<@a; $i++) {
      my $ai = substr $a[$i], -1, 1, '';
      return reverse($end) if $ai ne $a0;
    }
    $end .= $a0;
    @$aref = @a;
  }
}
sub delete_eq_begin {
  my $aref = shift;
  return '' if @$aref == 1;
  my $begin = '';
  while (1) {
    my @a = @$aref;
    $a0 = substr $a[0], 0, 1, '';
    for (my $i=1; $i<@a; $i++) {
      my $ai = substr $a[$i], 0, 1, '';
      return $begin if $ai ne $a0;
    }
    $begin .= $a0;
    @$aref = @a;
  }
}