#!/usr/bin/perl -w
use strict;
use warnings;
use 5.008;
my $try;
our ($in, $out);
use Data::Dumper;
$Data::Dumper::Terse = 1;
$Data::Dumper::Useqq = 1;

our %tests = (
   "line1\nline2\n" => "line1\nline2\n",
   "\nline1\nline2\n" => "line1\nline2\n",
   "line1\nline2\n\n" => "line1\nline2\n",
   "\n\nline1\nline2\n" => "\n\nline1\nline2\n",
   "line1\nline2\n\n\n" => "line1\nline2\n\n\n",
   "line1\n\nline2\n" => "line1\nline2\n",
   "line1\n\n\nline2\n" => "line1\n\n\nline2\n",
   "line1\nline2" => "line1\nline2",
);

our @subs = qw/coruscate long_qq Roy_Johnson BrowserUk asarih/;

for my $sub (@subs) {
   print "\n# testing $sub\n";
   while (my ($instr, $expected) = each %tests) {
      my $got='';
      open $in, "<", \$instr or die "huh? couldn't open \$in: $!";
      open $out, ">", \$got or die "huh? couldn't open \$out: $!";
      select $out;
      main::->$sub; # look ma, no no strict 'refs'
      select STDOUT;
      close $out;
      close $in;
      if ($got ne $expected) {
         printf "not ok - %s# expected %s# got %s",
	        map Dumper($_), $instr, $expected, $got;
      } else {
         print "ok - ", Dumper($instr);
      }
   }
}

sub coruscate {
   my $string = do { local $/; <$in> };
   $string =~ s#\n(\n+)#"\n" x (length($1)>1 ? length($1)+1 : length($1))#eg;
   print $string;
}

sub long_qq { # long version
   my $t = do { local $/; <$in> };
   $t =~ s/(?<!\n)\n{2}(?!=\n)/\n/g;
   print $t;
}

sub asarih {
   my ($this, $next, $last);
   while (<$in>) {
      $last = $this;
      $this = $next;
      $next = $_;
      print $this unless ($last ne "\n") && ($this eq "\n") && ($next ne "\n");
   }
   print $next unless ($next eq "\n") && ($this ne "\n"); #last line is special
}

sub Roy_Johnson {
   my $blank_lines = 0;
   while (<$in>) {
      if ($_ eq "\n") { ++$blank_lines }
      else {
         print "\n" x $blank_lines if $blank_lines != 1;
         print;
         $blank_lines = 0;
      }
   }
}

sub BrowserUk { # translated via Deparse
   my $x;
   local $/ = "\n"; local $\ = "\n";
LINE: while (defined($_ = <$in>)) {
      chomp $_;
      ++$x and next unless length $_;
      printf $/ x $x unless $x == 1;
      $x = 0;
      print $_;
   }
}

##</code><code>##


# testing coruscate
ok - "line1\n\nline2\n"
not ok - "\n\nline1\nline2\n"
# expected "\n\nline1\nline2\n"
# got "\nline1\nline2\n"
ok - "line1\n\n\nline2\n"
ok - "line1\nline2\n\n"
ok - "line1\nline2\n"
ok - "line1\nline2"
not ok - "\nline1\nline2\n"
# expected "line1\nline2\n"
# got "\nline1\nline2\n"
ok - "line1\nline2\n\n\n"

# testing long_qq
ok - "line1\n\nline2\n"
not ok - "\n\nline1\nline2\n"
# expected "\n\nline1\nline2\n"
# got "\nline1\nline2\n"
not ok - "line1\n\n\nline2\n"
# expected "line1\n\n\nline2\n"
# got "line1\n\nline2\n"
ok - "line1\nline2\n\n"
ok - "line1\nline2\n"
ok - "line1\nline2"
not ok - "\nline1\nline2\n"
# expected "line1\nline2\n"
# got "\nline1\nline2\n"
not ok - "line1\nline2\n\n\n"
# expected "line1\nline2\n\n\n"
# got "line1\nline2\n\n"

# testing Roy_Johnson
ok - "line1\n\nline2\n"
ok - "\n\nline1\nline2\n"
ok - "line1\n\n\nline2\n"
ok - "line1\nline2\n\n"
ok - "line1\nline2\n"
ok - "line1\nline2"
ok - "\nline1\nline2\n"
not ok - "line1\nline2\n\n\n"
# expected "line1\nline2\n\n\n"
# got "line1\nline2\n"

# testing BrowserUk
ok - "line1\n\nline2\n"
ok - "\n\nline1\nline2\n"
ok - "line1\n\n\nline2\n"
ok - "line1\nline2\n\n"
ok - "line1\nline2\n"
not ok - "line1\nline2"
# expected "line1\nline2"
# got "line1\nline2\n"
ok - "\nline1\nline2\n"
not ok - "line1\nline2\n\n\n"
# expected "line1\nline2\n\n\n"
# got "line1\nline2\n"

# testing asarih
ok - "line1\n\nline2\n"
ok - "\n\nline1\nline2\n"
ok - "line1\n\n\nline2\n"
ok - "line1\nline2\n\n"
ok - "line1\nline2\n"
ok - "line1\nline2"
ok - "\nline1\nline2\n"
ok - "line1\nline2\n\n\n"