Раскраска вывода Perl в командной строке Windows - PullRequest
Новая
       64

Раскраска вывода Perl в командной строке Windows

3 голосов
/ 31 октября 2019

Этот вопрос связан с вопросом: Как мне раскрасить выводимый текст из скрипта Perl в Windows?

Но это немного конкретнее. Я получил кроссплатформенную окраску, работающую, в некоторой степени: 

use Term::ANSIColor;
use Win32::Console;

if (!(-f STDOUT)) {
    if ($^O =~ /win/) {
        our $FG_BLUE;
        our $FG_YELLOW;
        our $FG_RED;
        our $BG_GREEN;
        my $CONSOLE = Win32::Console->new(STD_OUTPUT_HANDLE);
        my $attr = $CONSOLE->Attr(); # Get current console colors
        $blue   = sub {$CONSOLE->Attr($FG_BLUE);return};
        $reset  = sub {$CONSOLE->Attr($attr);return};
        $yellow = sub {$CONSOLE->Attr($FG_YELLOW);return};
        $red    = sub {$CONSOLE->Attr($FG_RED);return};
    } else {
        $blue   = sub {return color('bold blue')};
        $reset  = sub {return color('reset')};
        $yellow = sub {return color('yellow')};
        $red    = sub {return color('red')};
    }
}

, но цвета терминала не меняются сразу, когда функции вызываются из внутренних строк, таким образом: 

    print "${\$blue->()} this is blue\n";
    print "${\$blue->()}This is... not blue${\$reset->()}\n";
    print "this is Blue ${\$blue->()}\n";
    print "this is reset${\$reset->()}\n";

Мне интересно, возможно ли сделать такие вещи, как: 

    my $print_help = <<PRINT_HELP;
    Usage:  $toolname [-Options] [-fields name1,[name2],...]
    ${\$red->()} toolname version VERSION ${\$reset->()} 
    ${\$blue->()} options: ${\$reset->()}

    PRINT_HELP

    print $print_help;

печать без цветов. Я попытался установить $ |= 1 без удачи.

У меня нет возможности установить Win32 :: Console :: ANSI в рассматриваемой системе, поэтому я не могу заставить какие-либо решения, использующие этот модуль, работать.

Ответы [ 3 ]

2 голосов
/ 01 ноября 2019

Этот вид хака может быть в соответствии с тем, что вам нужно. 

#!/usr/bin/perl

use warnings;
use strict;

my $alice = sub  { return 'ALICE'; };

my $bob = sub { return 'BOB'; };

my $test = <<'ENDTEST';
lineone
line2 ${\$alice->()} endline
line3 startline ${\$bob->()}
linefour
linefive
ENDTEST

# Add spaces around newline, split on horizontal whitespace
$test =~ s/\n/ \n /g;
my @testtokens = split /\h/, $test;

# Print '%s ' for each of the testtokens
# Print newlines, evaluate all testtokens beginning with '$', otherwise print
map { /\n/ ? print : printf '%s ', /^\$/ ? eval $_ : $_} @testtokens;

Принимает наследственный код ENDTEST и печатает его в последней строке: 

$ heretest.pl
lineone 
line2 ALICE endline 
line3 startline BOB 
linefour 
linefive

Может быть , который оценит вещи по порядку.

1 голос
/ 01 ноября 2019

Вы звоните red, reset, blue и reset еще до начала печати. Вы можете использовать шаблон. Вот надежная реализация: 

use FindBin qw( $RealBin );
use lib "$RealBin/lib";

use My::Console qw( );

my $console = My::Console->new;

my $print_help = <<'__END_OF_HELP__';
Usage:  $toolname [-Options] [-fields name1,[name2],...]
{{red}}toolname version VERSION{{reset}}
{{blue}}options:{{reset}}

__END_OF_HELP__

$console->print_with_color($print_help);

lib/My/Console.pm: 

package My::Console;

use strict;
use warnings;

my $console;
BEGIN {
   if (!-t STDOUT) {
      require My::Console::Dumb;
      $console = My::Console::Dumb::;
   }
   elsif ($^O eq 'Win32') {
      require My::Console::Win32;
      $console = My::Console::Win32::;
   }
   else {
      require My::Console::ANSI;
      $console = My::Console::ANSI::;
   }
}

sub new { $console }

1;

lib/My/Console/Base.pm: 

package My::Console::Base;

use strict;
use warnings;

use Carp qw( croak );

my %allowed_cmds = map { $_ => 1 } qw( red blue reset );

sub red   { }
sub blue  { }
sub reset { }

sub print { print(STDOUT @_); }

sub print_with_color {
   my $self = shift;

   for (@_) {
      /\G ( (?: [^{] | \{(?!\{) )+ ) /xgc
         and $self->print($1);

      /\G \z /xgc
         and next;

      /\G \{\{ /xgc;

      /\G ( (?: [^}] | \}(?!\}) )* ) \}\} /xgc
         or croak("Bad template");

      my $cmd = $1;
      if ($cmd eq "") {
         # An escape mechanism. Use "{{}}" to output "{{".
         $self->print("{{");
         redo;
      }

      $allowed_cmds{$cmd}
         or croak("Unrecognized command \"$cmd\"");

      $self->$cmd();
      redo;
   }
}

1;

lib/My/Console/Win32.pm: 

package My::Console::Win32;

use strict;
use warnings;

use My::Console::Base qw( );
use Win32::Console;

our @ISA = My::Console::Base::;

my $CONSOLE = Win32::Console->new(STD_OUTPUT_HANDLE);
my $initial_console_attr = $CONSOLE->Attr();

sub red   { STDOUT->flush; $CONSOLE->Attr($FG_RED); }
sub blue  { STDOUT->flush; $CONSOLE->Attr($FG_BLUE); }
sub reset { STDOUT->flush; $CONSOLE->Attr($initial_console_attr); }

1;

lib/My/Console/ANSI.pm: 

package My::Console::ANSI;

use strict;
use warnings;

use My::Console::Base qw( );
use Term::ANSIColor   qw( );

our @ISA = My::Console::Base::;

sub red   { print(Term::ANSIColor::red()); }
sub blue  { print(Term::ANSIColor::blue()); }
sub reset { print(Term::ANSIColor::reset()); }

1;

lib/My/Console/Dumb.pm: 

package My::Console::Dumb;

use strict;
use warnings;

use My::Console::Base qw( );

our @ISA = My::Console::Base::;

1;
0 голосов
/ 03 ноября 2019

моя консоль не поддерживает цвета, но я вижу коды ESCAPE, которые на консоли, которая поддерживает цвета, должны работать. Интересно, работает ли он у вас? 

#!/usr/bin/perl

use Term::ANSIColor;
use Win32::Console;

if (!(-f STDOUT)) {
    if ($^O =~ /win/) {
        our $FG_BLUE;
        our $FG_YELLOW;
        our $FG_RED;
        our $BG_GREEN;
        my $CONSOLE = Win32::Console->new(STD_OUTPUT_HANDLE);
        my $attr = $CONSOLE->Attr(); # Get current console colors
        $blue   = sub {$CONSOLE->Attr($FG_BLUE);return};
        $reset  = sub {$CONSOLE->Attr($attr);return};
        $yellow = sub {$CONSOLE->Attr($FG_YELLOW);return};
        $red    = sub {$CONSOLE->Attr($FG_RED);return};
    } else {
        $blue   = sub {return color('bold blue')};
        $reset  = sub {return color('reset')};
        $yellow = sub {return color('yellow')};
        $red    = sub {return color('red')};
    }
}

help();

sub help {
    print 
"
    Usage:  $toolname [-Options] [-fields name1,[name2],...]
    ${\$red->()} toolname version VERSION ${\$reset->()} 
    ${\$blue->()} options: ${\$reset->()}

";
}

Вопрос: почему бы не использовать POD для этой цели?

...