#!/usr/bin/perl
# The Missing Textutils, Ondrej Bojar, obo@cuni.cz
# http://www.cuni.cz/~obo/textutils
#
# Given a regexp, all the matching lines are put in front of the file and all
# the rest is put below. It's like running 'grep' and 'grep -v'. Optionally a
# blank line is inserted to separate the blocks.
#
# This tool is extremely handy when manually editing any text-based database.
#
# $Id: solve_first,v 1.11 2007/03/23 06:08:36 bojar Exp $

use strict;
use Getopt::Long;

my $sort = 0;
my $delim = 0;
my $usecol = 0;
my $inverse = 0;
my $just_matching = 0;
my $blockwise = 0;
my $insens = 0;
my $usage = 0;
my $utf = 0;
my $skip = 0;
GetOptions("sort" => \$sort, "delim" => \$delim, "col=i"=>\$usecol,
  "inverse" => \$inverse, "blockwise" => \$blockwise,
  "insens"=>\$insens,
  "help"=>\$usage,
  "utf"=>\$utf,
  "skip=i"=>\$skip,
  "just-matching" => \$just_matching,
) or exit 1;
$usecol --;

if ($utf) {
  binmode(STDIN, ":encoding(utf8)");
  binmode(STDOUT, ":encoding(utf8)");
} else {
  binmode(STDIN, ":encoding(iso-8859-2)");
  binmode(STDOUT, ":encoding(iso-8859-2)");
}


my $re = shift;
if (!$re || $usage) {
  print STDERR "usage: solve_first <regular_expression>
options:
  --sort ... the top lines are sorted by \$1 of the reg. expression
  --delim ... add a blank line between the two parts
  --col=i ... check only the given column to check the reg. expression
  --inverse ... put above if not matches
  --blockwise ... match whole blocks of input instead of lines
  --just-matching ... do not print nonmatching blocks/lines
  --insens ... case insensitive
  --skip=<number_of_lines_to_blindly_copy>
";
  exit 1;
}


while ($skip > 0) {
  my $l = <>;
  print $l;
  $skip --;
}


my %head;
my $stack = "";
my $block = "";
while (($_ = <>) || $block ne "") {
  if ($blockwise) {
    $block .= $_;
    next if ! /^$/ && !eof(STDIN);
  } else {
    $block = $_;
  }

  my $test;
  if ($usecol > -1) {
    my @line = split /\t/, $block;
    $test = @line[$usecol];
  } else {
    $test = $block;
  }
  my $result = $insens ?  $test =~ /$re/moi : $test =~ /$re/om;
  if ($result xor $inverse) {
    if ($sort) {
      my $k = $1;
      if (defined $head{$k}) {
        $head{$k} .= $block;
      } else {
        $head{$k} = $block;
      }
    } else {
      print $block;
    }
  } else {
    $stack .= $block;
  }
  $block = "";
}
if ($sort) {
  for my $k (sort {$a <=> $b} keys %head) {
    print $head{$k};
  }
}
if (!$just_matching) {
  print "\n" if $delim;
  print $stack;
}