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";
[download]