comment on

For fun, I decided not to try to answer the question, but to test the existing answers. Some had problems with what I consider reasonable definitions of blank lines at the beginning and ending; if your definition was different, you may see a failure reported for what you consider a success. (If answers were updated recently, I won't have the updated version, and I may have made transcription errors in putting the code in my testbed. Apologies for any errors.)

Update: /msg me if you want your code updated; BrowserUk, sorry about the "line1\nline2" test, which completely defeats the -l switch; regard it as a case of GIGO rather than a failure if you want.

Here is the test program:

#!/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 i
+s 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 $_;
   }
}
[download]

and here is the output:


# 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"
[download]

Some of the tests issued warnings (which I have omitted); I mean to fix the test program to check for those and report them if I have time.

In reply to Re: remove single blank lines? by ysth
in thread remove single blank lines? by aloomens

Are you posting in the right place? Check out Where do I post X? to know for sure.
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
Want more info? How to link or How to display code and escape characters are good places to start.


No such thing as a small change
	PerlMonks