在 windows 命令提示符下着色 Perl 输出
Coloring Perl output on windows command prompt
此问题与以下问题相关:
How do I color output text from Perl script on 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 的选项,所以我无法使任何使用该模块的解决方案起作用。
这种 hack 可能符合您的需要。
#!/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 heredoc 并将其打印在最后一行:
$ heretest.pl
lineone
line2 ALICE endline
line3 startline BOB
linefour
linefive
也许会按顺序评估事物。
您甚至在开始打印之前就调用了 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();
/\G \z /xgc
and next;
/\G \{\{ /xgc;
/\G ( (?: [^}] | \}(?!\}) )* ) \}\} /xgc
or croak("Bad template");
my $cmd = ;
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;
我的控制台不支持颜色,但我可以看到在支持颜色的控制台上应该可以使用的 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?
此问题与以下问题相关: How do I color output text from Perl script on 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 的选项,所以我无法使任何使用该模块的解决方案起作用。
这种 hack 可能符合您的需要。
#!/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 heredoc 并将其打印在最后一行:
$ heretest.pl
lineone
line2 ALICE endline
line3 startline BOB
linefour
linefive
也许会按顺序评估事物。
您甚至在开始打印之前就调用了 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();
/\G \z /xgc
and next;
/\G \{\{ /xgc;
/\G ( (?: [^}] | \}(?!\}) )* ) \}\} /xgc
or croak("Bad template");
my $cmd = ;
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;
我的控制台不支持颜色,但我可以看到在支持颜色的控制台上应该可以使用的 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?