Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

sprintf( @_ ) doesn't do what I want!

by harangzsolt33 (Friar)
on Oct 30, 2019 at 02:19 UTC ( #11108102=perlquestion: print w/replies, xml ) Need Help??

harangzsolt33 has asked for the wisdom of the Perl Monks concerning the following question:

I have two questions. First, of all I have written a sub called cprintf(COLOR, TEXT) that prints something colorful on the screen. For some reason, the Linux version of this sub works, which says printf(@_); but when I do my $S = sprintf(@_); instead of giving me the formatted string, "1" is returned. Why?? I thought printf and sprintf are basically the same, the only difference is that sprintf returns the string instead of printing it to stdout.

The second question is has anyone ever written a perl module that does what I am trying to do here? As you can see, I have created a sub called CLS(), MoveCursor, cprintf() to print in color in DOS mode and Linux, but maybe I've worked in vain. Maybe others have already done something like this before?

Edit: I've come back here to make corrections in my code (in case someone wants to use it. :P )

#!/usr/bin/perl -w use strict; use warnings; use Config; my $OS = GetOS(); my $X64 = is64bitOS(); my @TERM = GetConsoleSize(); ################################################## # This function returns the character width and height # of the console window as an array. # Usage: ARRAY = GetConsoleSize() # # $ARRAY[0] = WIDTH # $ARRAY[1] = HEIGHT # sub GetConsoleSize { my $WIDTH = 80; my $HEIGHT = 25; if ($OS == 1) # DOS: Use an assembly code { # In DOS mode, we acquire the screen width by calling BIOS INT 10. +.. my $OUTPUT = ExecX86('SCRWIDTH.COM', "\xB4\x0F\xCD\x10\xA3\0\1\xC6 +\6\2\1\$\xB4\t\xBA\0\1\xCD!\xC3"); if (length($OUTPUT) == 2) { $WIDTH = vec($OUTPUT, 1, 8); } } elsif ($OS == 2) # Windows: Use powershell { my $W = uc(`POWERSHELL -COMMAND ECHO \$HOST.UI.RAWUI`); my @N = SplitNumbers(TrimChar(Between($W, 'WINDOWSIZE', "\n"), ' : +')); if (@N == 3) { $WIDTH = $N[0]; $HEIGHT = $N[2]; } } else # Linux: Use tput ... { $WIDTH = `tput cols`; $HEIGHT = `tput lines`; } return ($WIDTH, $HEIGHT); } ################################################## # Prints ANSI codes to stdout that changes the color. # This function works under LINUX/OSX ONLY! # Usage: ChangeColor(INTEGER) # sub ChangeColor { $OS > 2 or return; my $C = shift; my $A = ($C & 0xF00) >> 8; # Get attrib my $B = ($C & 0x0F0) >> 4; # Get background color my $T = ($C & 0x00F); # Get text color my $E = '2648375vnrptosqu'; $E = "\x1B[" . (vec($E, $T, 8) - 20) . "m\x1B[" . (vec($E, $B, 8) - +10) . 'm'; if ($A & 1) { $E .= "\x1B[05m"; } # BLINKING if ($A & 2) { $E .= "\x1B[04m"; } # UNDERLINE if ($A & 4) { $E .= "\x1B[03m"; } # ITALIC if ($A & 8) { $E .= "\x1B[01m"; } # BOLD print $E; } ################################################## # # Prints ANSI codes to stdout that changes the # color back to default. # Usage: ResetColor() # sub ResetColor { $OS > 2 or return; print "\x1B[0m"; } ################################################## # Prints some text in the center of the screen. # If given more than one argument, each # argument will be printed on a new line. # Usage: CENTER(STRINGS...) # sub CENTER { my $WIDTH = $TERM[0]; my $PADDING; my $TEXT; print "\n"; foreach my $L (@_) { $TEXT = substr($L, 0, $WIDTH); $PADDING = int(($WIDTH - length($TEXT)) / 2); print ' ' x $PADDING, $TEXT; length($TEXT) == $WIDTH or print "\n"; } } ################################################## # Splits a string along numbers and returns an # array of alternating numbers and text. # Usage: ARRAY = SplitNumbers(STRING) # # Example: SplitNumbers('6500 Main St, Miami, FL 33014') ---> # # ('6500', ' Main St, Miami, FL ', '33014') # sub SplitNumbers { defined $_[0] or return (); my ($PTR, $PREV, $LEN, $TYPE, @A) = (0, -1, length($_[0])); $LEN or return (); # Possible values for $PREV: -1=Uninitialized 0=NUMBER 1=TEXT for (my $i = 0; $i < $LEN; $i++) { $TYPE = vec($_[0], $i, 8); $TYPE = $TYPE < 48 || $TYPE > 57; # Is it a number? if ($PREV == !$TYPE) # Same as before? { push(@A, substr($_[0], $PTR, $i-$PTR)); $PTR = $i; } $PREV = $TYPE; } push(@A, substr($_[0], $PTR)); # Process last chunk return @A; } ################################################## # Extracts a section from string S that lies between # the first occurrence of strings A and B. Returns # an empty string if A is not found. # Usage: STRING = Between(S, A, [B]) # sub Between { (defined $_[0] && defined $_[1]) or return ''; (length($_[0]) && length($_[1])) or return ''; my $p1 = index($_[0], $_[1]); return '' if ($p1 < 0); my $B = defined $_[2] ? $_[2] : ''; length($B) or return substr($_[0], $p1); my $p2 = index($_[0], $B, $p1 + length($_[1])); return '' if ($p2 <= $p1); my $start = $p1 + length($_[1]); return substr($_[0], $start, $p2 - $start); } ################################################## # Just like Trim(), this function can remove spaces # or tabs from before and after STRING but it can also # remove any other character, whatever is found in SUBSTR. # Usage: STRING = TrimChar(STRING, SUBSTR) # sub TrimChar { defined $_[0] or return ''; my $L = length($_[0]); $L or return ''; defined $_[1] or return $_[0]; length($_[1]) or return $_[0]; my $START = 0; my $LAST = 0; while ($L--) { if (index($_[1], substr($_[0], $L, 1)) < 0) { $START = $L; $LAST or $LAST = $L + 1; } } return substr($_[0], $START, $LAST - $START); } ################################################## # Removes whitespace from before and after STRING. # Whitespace is here defined as any byte whose # ASCII value is less than 33. That includes # tabs, esc, null, vertical tab, new lines, etc. # Usage: STRING = Trim(STRING) # sub Trim { defined $_[0] or return ''; my $L = length($_[0]); $L or return ''; my $P = 0; while ($P <= $L && vec($_[0], $P++, 8) < 33) {} for ($P--; $P <= $L && vec($_[0], $L--, 8) < 33;) {} substr($_[0], $P, $L - $P + 2) } ################################################# # # This function returns the OS type as a number. # 1=DOS 2=WINDOWS 3=LINUX 4=OSX 9=OTHER # sub GetOS { my $OS = uc($^O); index($OS, 'LINUX') >= 0 ? 3 : index($OS, 'MSWIN') >= 0 ? 2 : index($OS, 'DOS') >= 0 ? 1 : index($OS, 'DARWIN') >= 0 ? 4 : 9; } ################################################# # This function works like the index() function. # N is the start position. Uses rindex() when N # is negative. Returns -1 if nothing was found, # OR returns the position where SUBSTR was found. # Usage: INTEGER = IndexOf(STRING, SUBSTR, [N]) # sub IndexOf { @_ > 1 or return -1; my $P = defined $_[2] ? $_[2] : 0; $P < 0 ? rindex($_[0], $_[1], $P + length($_[0])) : index($_[0], $_[ +1], $P); } ################################################# # This function splits STRING into two parts along the # first occurrence of SUBSTR. The two resulting string # segments are stored in $a and $b. The search for # SUBSTR starts at position N. If N is -1, then # starts searching from the end of the string. # Returns 0 if SUBSTR was not found, OR # returns POSITION+1 where SUBSTR was found. # If SUBSTR is not found, the entire input string # will be stored in $a, while $b will be empty. # Usage: FOUND = SplitAB(STRING, SUBSTR, [N]) # sub SplitAB { $a = $b = ''; @_ > 1 or return 0; my $P = IndexOf(@_); if ($P < 0) { $a = $_[0]; return 0; } $a = substr($_[0], 0, $P); $b = substr($_[0], $P + length($_[1])); return $P + 1; } ################################################# # # This function clears the terminal window. # sub CLS { if ($OS == 3) { print "\x1Bc\x1B[0m\x1B[3J\x1B[H\x1B[2J"; } elsif ($OS == 1) { system('COMMAND.COM /C CLS'); } elsif ($OS == 2) { system('CLS'); } elsif ($OS == 4) { print "\x1B[3J"; } } ################################################# # LINUX/OSX ONLY! # Changes the cursor's position within the # terminal window using ANSI codes. # Usage: MoveCursor(X, Y) # sub MoveCursor { $OS > 2 or return; my $X = defined $_[0] ? $_[0] : 1; my $Y = defined $_[1] ? $_[1] : 1; $X > 0 or $X = 1; $Y > 0 or $Y = 1; print "\x1B[$Y;$X", 'H'; } ################################################## # This function expects a full path and returns # the file name portion of the path. # Usage: FILE_NAME = GetFileName(FULL_PATH) # sub GetFileName { defined $_[0] or return ''; my $F = $_[0]; $OS > 2 or $F =~ tr|\\|/|; my $P = rindex($F, '/'); return ($P < 0) ? $F : substr($F, $P+1); } ################################################# # This function executes x86 binary code in DOS/Windows. # Tested using TinyPerl 5.8 with Windows 7 Ultimate 32-bit, # Windows XP PRO SP2 (32-bit), and DOS Perl 5.004_02. # Returns whatever the program prints to stdout or # returns an empty string if something went wrong. # The PROGRAM string should contain the name of # the file (to be created) and any arguments # that may need to be passed. # Usage: STRING = ExecX86(PROGRAM, BINARY) # Example: ExecX86('MVCURSOR.COM 4 12', '...'); # sub ExecX86 { @_ == 2 && $OS < 3 or return ''; (defined $_[0] && defined $_[1]) or return ''; (length($_[0]) && length($_[1])) or return ''; my $PATH = 'C:\\WINDOWS\\TEMP\\'; SplitAB($_[0], ' '); my $PRG = $PATH . GetFileName($a); my $ARGS = $b; my $CODE = $_[1]; my $WRITE = (-e $PRG) ? (-s $PRG == length($CODE) ? 0 : 2) : 1; if ($WRITE) { -e $PATH or mkdir($PATH, 0777); # Remove read-only flag if the file exists if ($WRITE == 2) { chmod 0777, $PRG; } local *FH; open(FH, ">$PRG") or return ''; binmode FH; print FH $CODE; close FH or return ''; } return `$PRG $ARGS`; } ################################################# # Returns 1 if the OS that is installed is a # 64-bit version OS. Returns zero otherwise. # Usage: INTEGER = is64bitOS() # sub is64bitOS { # If Perl is 64-bit, then the OS is 64-bit as well. if ($Config{ptrsize} == 8) { return 1; } if ($OS == 1) # DOS is 16-bit { return 0; } if ($OS == 2) # Check Windows { my $PRG = 'C:\\PROGRAM FILES (X86)'; my $E = uc(`SET`); -e $PRG or return 0; index($E, $PRG) < 0 or return 0; if (index($E, 'PROCESSOR_ARCHITECTURE=X86') >= 0) { index($E, 'PROCESSOR_ARCHITEW6432') >= 0 or return 0; } return 1; } if ($OS == 3) # Check Linux { return index(uc(`lscpu`), '32-BIT, 64-BIT') < 0 ? 0 : 1; } if ($OS == 4) # Check OSX { return index(uc(`uname -a`), ' X86_64') < 0 ? 0 : 1; } return 0; } ################################################## # This function changes the background and text # color of the console window without erasing # any text. This works on WINDOWS ONLY!!! # Usage: SetBgColor(INTEGER) # sub SetBgColor { $OS == 2 or return; my $C = defined $_[0] ? $_[0] : 7; system('COLOR ' . sprintf('%.2X', $C)); } ################################################## # Asks the user to press Enter to continue... # Usage: PAUSE() sub PAUSE { $| = 1; # Disable buffering for now print "\nPress Enter to continue..."; scalar <STDIN>; $| = 0; return; } ################################################## # This function prints something in color in the # terminal window. # Usage: cprintf(COLOR, TEXT, [ARGS]) # sub cprintf { @_ > 1 or return; my $E = shift; my $A = ($E & 0xF00) >> 8; # Get font style my $B = ($E & 0x0F0) >> 4; # Get background color my $C = ($E & 0x00F); # Get text color # Linux/OSX cprintf solution using ANSI codes: if ($OS > 2) { $E = '2648375vnrptosqu'; # Color code translation table $E = "\x1B[" . (vec($E, $C, 8) - 20) . "m\x1B[" . (vec($E, $B, 8) +- 10) . 'm'; if ($A & 1) { $E .= "\x1B[05m"; } # BLINKING if ($A & 2) { $E .= "\x1B[04m"; } # UNDERLINE if ($A & 4) { $E .= "\x1B[03m"; } # ITALIC if ($A & 8) { $E .= "\x1B[01m"; } # BOLD print $E; # Set color printf(@_); print "\x1B[0m"; # Reset color return; } # Windows cprintf solution: my $MSG = sprintf(shift, @_); # We're going to use this as a command line argument, # so we need to clean the string... $MSG =~ tr#|<>"\r\n##d; $MSG = "\"$MSG\""; if ($OS == 2 && is64bitOS()) { # This solution requires Windows Powershell, # so it will not work if PowerShell is missing! my $POWERSHELL = "C:\\Windows\\System32\\WindowsPowerShell\\v1.0\\ +PowerShell.exe"; if (-e $POWERSHELL) { system("POWERSHELL -COMMAND WRITE-HOST $MSG -FOREGROUND $C -BACK +GROUND $B"); return; } } # DOS cprintf solution: # Here we use a 16-bit DOS program to print color text. # This will work on some Windows as well, but it # won't work on a 64-bit Windows platform. $E = sprintf('%.2X', $E); # Prepare color attribute ExecX86("COLORMSG.COM $E $MSG", "\xB3\x812\xFF\x8AO\xFF2\xED\xE39\x8 +B\xFB\xB0 \xFC\xF3\xAEtQ\xE3~\x8AE\xFF\xB3\x24\xFE\xC7S\xB3\xAD\xFF\x +E3\xEBn\x80= ts\xD0\xE0\xD0\xE0\xD0\xE0\xD0\xE0\x8A\xE0G\x8AE\xFF\xB3 +\x3CS\xEBq\xB3A\x80/!+\xC4I\xE3N2\xE4P\xB8\"\"\xF2\xAEuD\xE3B\x8B\xF7 +\x8B\xD1\xF2\xAEu\x40J:%u;GIu\xF3+\xD1t-\x8B\xCA\xB3|\x80/!\xB3\x86\x +80/![\xB0 \xB4*\x80\xEC!\xCD1\xB2\"\xAC\xB4/\x80\xEC!\xCD1:\xC2u\x97\ +x8A\xE2:\x24u\x91F\xE2\xEB2\xC0\xB4L\xCD!\xEB\xC7\xEB\xA6,0\xC3\x3CAr +\xF9\xB2\xF9\xF6\xDA*\xC2\xEB\xF1\x3Car\xF0, \xEB\xEC"); } ################################################## CLS(); CENTER('W E L C O M E'); CENTER('-' x 70); print "\nHello World!\n"; SetBgColor(0x2F); PAUSE(); MoveCursor(3, 4); cprintf(0x1E, "Hello World"); print "\n\n", join(' x ', @TERM), "\n";

Replies are listed 'Best First'.
Re: sprintf( @_ ) doesn't do what I want!
by davido (Cardinal) on Oct 30, 2019 at 04:10 UTC

    As odd as this may seem, it nevertheless works:

    sprintf($_[0], @_[1..$#_])

    ...or...

    sprintf(shift, @_)

    perlsub explains prototypes, and that's what's going on here. You can see the prototype for sprintf like this:

    perl -E 'say prototype(q{CORE::sprintf})' $@

    Dave

Re: sprintf( @_ ) doesn't do what I want!
by huck (Prior) on Oct 30, 2019 at 02:46 UTC

    Unlike printf, sprintf does not do what you probably mean when you pass it an array as your first argument. The array is given scalar context, and instead of using the 0th element of the array as the format, Perl will use the count of elements in the array as the format, which is almost never useful.

    https://perldoc.perl.org/functions/sprintf.html

Re: sprintf( @_ ) doesn't do what I want!
by Athanasius (Archbishop) on Oct 30, 2019 at 03:58 UTC

    Hello harangzsolt33,

    huck has explained the problem. This would appear to be one of the rare cases in which Perl fails to DWIM, but the fix, although annoyingly verbose, is straightforward:

    my $S = sprintf $_[0], @_[1 .. $#_];

    BTW, when I run your script under Windows 8.1, 64-bit, I get a series of errors like this:

    This version of C:\WINDOWS\TEMP\TMP2X137.COM is not compatible with th +e version of Windows that you're running. Check your computer's syste +m information and then contact the software publisher. This version of C:\WINDOWS\TEMP\TMP2X137.COM is not compatible with th +e version of Windows that you're running. Check your computer's syste +m information and then contact the software publisher.
    The second question is has anyone ever written a perl module that does what I am trying to do here?

    For Linux, there is the Curses module which I think does everything you need. For Windows, you will need to search CPAN, for example the Win32:: namespace. (I have a vague memory that I found a module for Windows that promised exactly what you’re looking for, but I couldn’t get it to install. :-(. But I can’t find the details, sorry.)

    Update: Have a look at Win32::Console.

    Hope that helps,

    Athanasius <°(((><contra mundum Iustus alius egestas vitae, eros Piratica,

Re: sprintf( @_ ) doesn't do what I want!
by skleblan (Sexton) on Nov 01, 2019 at 21:08 UTC
Re: sprintf( @_ ) doesn't do what I want!
by Anonymous Monk on Oct 30, 2019 at 14:39 UTC
      Oh, yes! That's how I wrote my cprintf() function. I got the ideas from Term::ANSIColor. ;)

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://11108102]
Approved by huck
Front-paged by huck
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others exploiting the Monastery: (2)
As of 2022-05-28 02:17 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Do you prefer to work remotely?



    Results (98 votes). Check out past polls.

    Notices?