#!/usr/bin/perl

use strict;
use warnings;

SpitGIF();
exit;

##################################################
#                       GIF | Graphics | v2023.2.5
# This function generates a single-pixel GIF of a given color
# I took original code from PerlMonks and modified it a little bit.
# Original code was written by a user named "turnstep"
# and is called the World's Smallest GIF image. It produces a GIF
# image that is only 35 bytes (or 43 bytes if it is transparent.)
# Source: https://perlmonks.com/?node_id=7974
#
# This function expects one or two arguments. The first argument
# should be a hexadecimal number such as 0xCC00CC which would
# produce a purple pixel.
#
# This function will always generate the smallest possible GIF image.
#
# Examples:
#
#    SpitGIF() will send a black 1x1 pixel to the browser.
#
#    SpitGIF(0xFFFFFF) will send a white 1x1 pixel to the browser
#                      as response by printing it to stdout.
#
#    SpitGIF(-1) will send a transparent pixel to the browser.
#
#  The following example will simply return a grey 1x1 GIF
#  file's content in a string rather than printing it:
#
#    my $GIF = SpitGIF(0x999999, '<STRING>');
#
#  Next example will save a red GIF pixel to a file called "red.gif"
#
#    SpitGIF(0xFF0000, 'red.gif');
#
#  The next example will return a base64 inline code that can be
#  inserted into a HTML page and will produce a green GIF pixel:
#
#    my $GIF = SpitGIF(0x00FF00, '<INLINE>');
#    print "<IMG WIDTH=1 HEIGHT=1 BORDER=0 SRC='$GIF'>";
#                                                 ^ Here the $GIF
#  variable contains the GIF file's contents in base64 encoding
#  rather than a gif file name. Newer web browsers will recognize
#  this and will render the image correctly. Very old web browsers
#  such as MSIE6 will just display a missing image icon.
#
# Usage: SpitGIF(COLOR, [OUTPUT])
#
sub SpitGIF
{
  my $COLOR = defined $_[0] ? $_[0] : 0;
  my $GHOST = ($COLOR & 0xFF000000) ? "!\xF9\4\5\x10\0\0\0" : '';
  $COLOR = substr(pack('N', $COLOR & 0xffffff), 1, 3);

  # Create the world's smallest GIF image:
  my $GIF = "GIF89a\1\0\1\0\x90\0\0$COLOR" .
              "\0\0\0$GHOST,\0\0\0\0\1\0\1\0\0\2\2\4\1\0;";

  # If $_[1] is not empty, then...
  unless (defined $_[1] && length($_[1]) && $_[1] =~ m/\S+/)
  {
    binmode(STDOUT);
    return print "Content-Type: image/gif\nContent-Length: ",
      length($GIF), "\n\n", $GIF;
  }
  my $F = $_[1];
  $F =~ tr`<>*%$?\x00-\x1F\"\|``d;
  if ($F eq '<STRING>') { return $GIF; }
  if ($F eq '<INLINE>') { EncodeBase64($GIF, 1);
    return "data:image/gif;base64,$GIF"; }
  print "\nSaving 1x1 GIF image to $F\n";
  return CreateFile($F, $GIF);
}
##################################################
#                              String | v2022.11.4
# This function converts a string to text using the
# standard Base64 encoding algorithm.
#
# THIS FUNCTION CHANGES THE VALUE OF THE FIRST ARGUMENT!
#
# The first argument should be a string or a string reference.
# The second argument MAY contain a custom 65-byte
# character set. The 65th byte will be used for padding.
#
# The second argument MAY also be 0 or 1:
#    0 = Use standard Base64 encoding which ends with +/  (default)
#    1 = Use web-safe Base64 encoding which ends with -_
#
# Usage: EncodeBase64(STRING, [CHARSET])
#
sub EncodeBase64
{
  defined $_[0] or return $_[0] = '';

  # Prepare character set.
  my $PADDING = '=';
  my $BASE64 = defined $_[1] ? $_[1] : 0;
  if (length($BASE64) >= 64)
  { $PADDING = substr($BASE64, 64, 1); }
  else { $BASE64 =
    'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789'
    . (($BASE64 eq '1') ? '-_' : '+/'); }

  # Get string reference.
  my $REF = ref($_[0]);
  if (length($REF))
  {
    $REF eq 'SCALAR' or return 0;
    $REF = $_[0];
    defined $$REF or return $$REF = '';
  }
  else { $REF = \$_[0]; }

  my ($i, $OUT, $L) = (0, '', length($$REF));
  while ($i < $L)
  {
    # Read 3 bytes.
    my $A = vec($$REF, $i++, 8);
    my $B = vec($$REF, $i++, 8);
    my $C = vec($$REF, $i++, 8);
    # Write 4 bytes.
    $OUT .= substr($BASE64, $A >> 2, 1);
    $OUT .= substr($BASE64, (($A & 3) << 4) | ($B >> 4), 1);
    $OUT .= substr($BASE64, (($B & 15) << 2) | (($C >> 6) & 3), 1);
    $OUT .= substr($BASE64, $C & 63, 1);
  }
  # Replace last couple of bytes with padding.
  my $DIFF = $i - $L;
  substr($OUT, length($OUT) - $DIFF, $DIFF) = $PADDING x $DIFF;
  $$REF = $OUT;  # Replace original string with the new one.
  undef $OUT;    # Free up memory.
  return 1;
}
##################################################
#                                File | v2022.11.8
# Creates and overwrites a file in binary mode.
# If the file has already existed, it erases the
# old content and replaces it with the new content.
# Returns 1 on success or 0 if something went wrong.
#
# Usage: STATUS = CreateFile(FILENAME, CONTENT)
#
sub CreateFile
{
  my $F = defined $_[0] ? shift : '';
  $F =~ tr/\x00-\x1F\"\|*%$?<>//d;    # Remove illegal characters.
  local *FILE;
  open(FILE, ">$F") or return 0;
  binmode FILE;
  foreach (@_) { defined $_ and length($_) and print FILE $_; }
  close FILE;
  -e $F or return 0;   # File exists?
  -f $F or return 0;   # It's a plain file?
  return 1;
}
##################################################