| Dir : /proc/thread-self/root/proc/self/root/proc/self/root/proc/self/root/opt/sharedrads/extras/ |
| Server: Linux ngx353.inmotionhosting.com 4.18.0-553.22.1.lve.1.el8.x86_64 #1 SMP Tue Oct 8 15:52:54 UTC 2024 x86_64 IP: 209.182.202.254 |
| Dir : //proc/thread-self/root/proc/self/root/proc/self/root/proc/self/root/opt/sharedrads/extras/say |
#!/usr/bin/perl
# encoding: utf-8
# author: Kyle Yetter <kyle@ohboyohboyohboy.org>
# created on: May 27, 2011
use strict;
use IO::Handle;
use Scalar::Util 'openhandle';
use Carp;
use File::Basename;
use Getopt::Long;
our $VERSION = '1.0.0';
our $add_newline = 1;
our $do_help = 0;
our $do_version = 0;
our %option_spec = (
'n|no-newline' => sub { $add_newline = 0; },
'h|help' => sub { help(); exit 0; },
'v|version' => sub { print "$VERSION\n"; exit 0; }
);
our %ESCAPE_MAP = (
'n' => "\n", 't' => "\t", 'r' => "\r", 'e' => "\e",
'\\' => "\\", 'a' => "\a", "s" => " ", 'b' => "\b",
'%' => '%%'
);
our $BACKGROUND_CODE = "\e[4%im";
our $FOREGROUND_CODE = "\e[3%im";
our %COLOR_VALUES = (
"white" => 7, "black" => 0, "cyan" => 6, "blue" => 4,
"green" => 2, "red" => 1, "magenta" => 5, "yellow" => 3
);
our %DISPLAY_MAP = ();
while ( my ( $k, $v ) = each %COLOR_VALUES ) {
$DISPLAY_MAP{ $v } = $k;
}
our %COLOR_NAMES = (
"bla" => "black", "gree" => "green", "w" => "white",
"blac" => "black", "green" => "green", "wh" => "white",
"black" => "black", "m" => "magenta", "whi" => "white",
"blu" => "blue", "ma" => "magenta", "whit" => "white",
"blue" => "blue", "mag" => "magenta", "white" => "white",
"c" => "cyan", "mage" => "magenta", "y" => "yellow",
"cy" => "cyan", "magen" => "magenta", "ye" => "yellow",
"cya" => "cyan", "magent" => "magenta", "yel" => "yellow",
"cyan" => "cyan", "magenta" => "magenta", "yell" => "yellow",
"g" => "green", "r" => "red", "yello" => "yellow",
"gr" => "green", "re" => "red", "yellow" => "yellow",
"gre" => "green", "red" => "red"
);
our %STYLE_CODES = (
'*' => "\e[1m", '_' => "\e[4m", '~' => "\e[7m", '!' => "\e[5m"
);
our $RX_TAGS = qr`
( [\*~!_]* )
| ( [a-z]+ (?: @ [a-z]+ )?
| @ [a-z]+
)
`xi;
our $RX_COLOR_ARG = qr`
% \( ( $RX_TAGS ) \)
( [\-\+0\s\#]? \d* (?:\.\d+)? [hlI]? [bcdEefGgiopsuXx] )
`x;
our $RX_ESCAPE = qr(^\\(.));
our $RX_CLOSE_TAG = qr(^</$RX_TAGS>);
our $RX_OPEN_TAG = qr(^<$RX_TAGS>);
our $RX_TEXT = qr(^(.+?)(?=(?:\\.|</?$RX_TAGS>|\Z)))s;
our $BAD_CLOSE = q(bad format close tag: expected `%(g)s', but got `%(y)s');
sub color_value($) {
my ( $name ) = @_;
if ( $name ) {
my $full_name = $COLOR_NAMES{ lc( $name ) } or
damn( "`%(y)s' is not a valid color name", $name );
return $COLOR_VALUES{ $full_name };
}
}
sub color_scan($) {
my ( $text ) = @_;
my ( @foreground, @background, @styles );
my $out = '';
open( my $str, '>', \$out );
$text =~ s($RX_COLOR_ARG)(<$1>%$4</$1>)g;
$_ = $text;
while ( $_ ) {
my $print_escape = 0;
if ( /$RX_ESCAPE/ ) {
$_ = $';
my $c = $ESCAPE_MAP{ $1 } || $1;
print $str $c;
} elsif ( /$RX_CLOSE_TAG/ ) {
$_ = $';
if ( my $style_char = $1 ) {
for my $c ( split //, $style_char ) {
my $v = $STYLE_CODES{ $c };
@styles = grep { $_ ne $v } @styles;
}
} elsif ( my $colors = $2 ) {
my ( $fg, $bg ) = split( /@/, $colors, 2 );
if ( my $value = color_value( $fg ) ) {
my $current = $foreground[ -1 ];
if ( $current and $current ne $value ) {
my $expected = $DISPLAY_MAP{ $current };
my $got = $DISPLAY_MAP{ $value };
damn( $BAD_CLOSE, $expected, $got );
}
pop @foreground;
}
if ( my $value = color_value( $bg ) ) {
my $current = $background[ -1 ];
if ( $current and $current ne $value ) {
my $expected = $DISPLAY_MAP{ $current };
my $got = $DISPLAY_MAP{ $value };
damn( $BAD_CLOSE, $expected, $got );
}
pop @background;
}
}
$print_escape = 1;
} elsif ( /$RX_OPEN_TAG/ ) {
$_ = $';
if ( my $style_char = $1 ) {
for my $c ( split //, $style_char ) {
push @styles, $STYLE_CODES{ $c };
}
} elsif ( my $colors = $2 ) {
my ( $fg, $bg ) = split( /@/, $colors, 2 );
if ( my $value = color_value( $fg ) ) { push @foreground, $value; }
if ( my $value = color_value( $bg ) ) { push @background, $value; }
}
$print_escape = 1;
} elsif ( /$RX_TEXT/ ) {
$_ = $';
print $str $1;
} else {
damn( "this shouldn't happen: (%s@%i)", __FILE__, __LINE__ );
}
if ( $print_escape ) {
print $str "\e[0m";
if ( my $value = $foreground[ -1 ] ) { printf $str $FOREGROUND_CODE, $value; }
if ( my $value = $background[ -1 ] ) { printf $str $BACKGROUND_CODE, $value; }
print $str join( '', @styles );
}
}
if ( @foreground + @background + @styles > 0 ) {
print $str "\e[0m";
}
close( $str );
return $out;
}
sub say {
my $currfh = select();
my $handle;
{
no strict 'refs';
$handle = openhandle( $_[0] ) ? shift : \*$currfh;
use strict 'refs';
}
my ( $format, @args ) = @_;
$format ||= $_;
$format ||= '';
my $warning;
local $SIG{__WARN__} = sub { $warning = join q{}, @_ };
if ( $add_newline and $format !~ m($/\z)s ) { $format .= $/; }
$format = color_scan( $format );
my $res = printf {$handle} $format, @args;
return $res if $res;
$warning =~ s/[ ]at[ ].*//xms;
croak $warning;
}
*IO::Handle::say = \&say if ! defined &IO::Handle::say;
sub damn {
my ( $message, @args ) = @_;
say( \*STDERR, "<red>ERROR:</red> $message", @args );
exit( 1 );
}
sub help {
my $name = basename( $0 );
my @help_lines = <DATA>;
my $help = join( '', @help_lines );
$help =~ s(\b__name__\b)($name)g;
print $help, "\n";
}
GetOptions( %option_spec );
say @ARGV;
__END__
__name__: print a printf-style formatted string with ansi color code markup
USAGE: __name__ [opts] format_string [args ...]
OPTIONS:
-n, --no-newline Do not append a trailing newline
-v, --version Print program version and exit
-h, --help Print program summary and exit
ANSI MARK UP EXAMPLES:
styles: <_>underline</_> <~>invert</~> <!>blink</!> <*>bold</*>
colors: <fg_color></fg_color> <@bg_color></@bg_color> <fg@bg></fg@bg>