view release on metacpan or  search on metacpan

lib/Ecma48/Util.pm  view on Meta::CPAN

    }
    when (/^($CSI)([\d;]+)m\z/) { return $1.closing_seq($2).'m' }
    when (/^($CSI[\d;]+)h\z/)   { return "${1}l" }
    when (/^\d+$/)
    { #say "debug: _=$_".dump $CLS;
      return $CLS->{0+$_} if exists $CLS->{0+$_};
      carp "Don't know a fitting closing sequence, use reset.";
      return 0;
    }
    when (/^[\d;]*;[\d;]*\z/)
    { return 39 if /^0*38;/; # XXX
      return 49 if /^0*48;/;
      return join ';',map { closing_seq(0+$_) } grep { $_ ne '' } split ';', $open;
    }
    default
    { carp "Don't know a fitting closing sequence.";
      return
    }
  }
}

# ---------------------------------------------------------------------------

#*** remove_seqs ***  js<10.10.2012
sub remove_seqs ($)
{ use re 'taint';
  return defined wantarray ? $_[0]=~s/$SEQ//gr : $_[0]=~s/$SEQ//g;
}

#*** split_seqs ***  js<10.10.2012
#* split string and return a list where escape seq are marked by being scalar references.
sub split_seqs ($) { map { /$SEQ/ ? \$_ : $_ } split /($SEQ)/,$_[0] }

sub move_seqs_before_lastnl ($)  # e.g. color before nl
{ use re 'taint'; my $re=qr/([\s\r\n])+($SEQ)+\s*\z/m;
  return defined wantarray ? $_[0]=~s/$re/$2$1/mr : $_[0]=~s/$re/$2$1/m;
}

sub ensure_terminating_nl ($) # if not only space
{ my $test=remove_seqs $_[0];
  my $nl= $test=~m/\r?\n\h*?\z/ || $test!~/\S/ ? '' : "\n";
  return $_[0].=$nl unless defined wantarray;
  return "$_[0]$nl"
}
sub remove_terminating_nl ($)
{ use re 'taint'; my $re=qr/\r?\n((?:\h|$SEQ)*?)\z/;
  #return $_[0]=~s/\r?\n((?:\h|$SEQ)*?)\z/$1/r;
  return defined wantarray ? $_[0]=~s/$re/$1/r : $_[0]=~s/$re/$1/;
}

#*** remove_fillchar *** js15.10.2012
#* return input with removed DEL, NUL and CRs directly before other CRs
#* removed: ... and SPACE-BS pairs if the are not inside a word.
sub remove_fillchars ($)
{ use re 'taint'; my $re=qr/[\00\x7F]|\r(?=\r)/; # |(?<!\w)\x20\cH|\x20\cH(?!\w)
  return defined wantarray ? $_[0]=~s/$re//gr : $_[0]=~s/$re//g;
}

#*** remove_bs_bolding *** js15.10.2012
sub remove_bs_bolding ($) # ecma-6 not part of ecma-48
{ use re 'taint'; my $re=qr/([[:graph:]])\cH(?=\g1)/;
  return defined wantarray ? $_[0]=~s/$re//gr : $_[0]=~s/$re//g;
}

#*** replace_bs_bolding *** js17.10.2012
sub replace_bs_bolding ($;$$$) # ecma-6 not part of ecma-48
{ use re 'taint';
  my $s=defined wantarray ? \do{ my $dummy=$_[0] } : \$_[0];
  my $b=$_[1]//1; my $e=$_[2]//closing_seq($b); my $i=$_[3]//'';
  for ($b,$e) { $_="\e[${_}m" if /^[\d;]+\z/ }
  #for ($$s) { s/([[:graph:]])(?:\cH\g1)+/$b$1$e/g; s/\Q$e$b//g; }
  my $emiss=0;
  $$s=~s{(?| ([[:graph:]])(?:(\cH)\g1)+ | (.)() )}
        { my $r;
          if (!$2) { $r=($emiss ? $e : '').$1; $emiss=0; }
          else     { $r=($emiss ? $i : $b).$1; $emiss=1; }
          $r
        }gsex;
  $$s.=$e if $emiss;
  return $$s;
}

# ---------------------------------------------------------------------------
'very reduced';

__END__

=head1 NAME

Ecma48::Util - A selection of subroutines supporting ANSI escape sequence handling

=head1 SYNOPSIS

    use Ecma48::Util qw(remove_seqs move_seqs_before_lastnl ... quotectrl);

    my $nude=quotectrl remove_bs_bolding remove_seqs remove_fillchars $decorated;

=head1 DESCRIPTION

C<Ecma48::Util> contains a selection of subroutines which allow the
handling of I<Ecma-48> based markup sequences - better known as
I<ANSI escape> sequences.

It helps to separate string handling from decorating.
If you can't change the order of processing and you are forced to do your
string handling after the decoration is already in effect, then you can
find some adequate utility functions here.

=head1 USE CASES

Do you like colors in your terminal? And a nice guy has written a plugin
to bring in the color - maybe with the help of C<Term::ANSIColor>?
Unfortunately, now things like C<chomp> and
testing if a string is empty do start to fail?
Then this module is worth a look.

=head1 FUNCTIONS

By default C<Ecma48::Util> does not export any subroutines. The
subroutines defined are

=over 4

=item remove_seqs STRING

C<remove_seqs> returns a string where well-formed Ecma48 sequences from STRING
are deleted.

    $foo = remove_seqs "color\e[34;1mful\e[m example"; # colorful example

Keep in mind that this is not the right tool for secure disarmament. Not all
terminal sequences are well-formed and most terminals also accept sequences with
some errors. See L<C<quotectrl>|/"quote_ctrl STRING">.