| Current Path : /proc/self/root/usr/bin/ |
Linux gator3171.hostgator.com 4.19.286-203.ELK.el7.x86_64 #1 SMP Wed Jun 14 04:33:55 CDT 2023 x86_64 |
| Current File : //proc/self/root/usr/bin/pnmquant |
#!/bin/sh
##############################################################################
# This is essentially a Perl program. We exec the Perl interpreter specifying
# this same file as the Perl program and use the -x option to cause the Perl
# interpreter to skip down to the Perl code. The reason we do this instead of
# just making /usr/bin/perl the script interpreter (instead of /bin/sh) is
# that the user may have multiple Perl interpreters and the one he wants to
# use is properly located in the PATH. The user's choice of Perl interpreter
# may be crucial, such as when the user also has a PERL5LIB environment
# variable and it selects modules that work with only a certain main
# interpreter program.
#
# An alternative some people use is to have /usr/bin/env as the script
# interpreter. We don't do that because we think the existence and
# compatibility of /bin/sh is more reliable.
#
# Note that we aren't concerned about efficiency because the user who needs
# high efficiency can use directly the programs that this program invokes.
#
##############################################################################
exec perl -w -x -S -- "$0" "$@"
#!/usr/bin/perl
##############################################################################
# pnmquant
##############################################################################
# By Bryan Henderson, San Jose CA; December 2001.
#
# Contributed to the public domain by its author.
##############################################################################
use strict;
use English;
use Getopt::Long;
use File::Spec;
#use Fcntl ":seek"; # not available in Perl 5.00503
use Fcntl; # gets open flags
my ($TRUE, $FALSE) = (1,0);
my ($SEEK_SET, $SEEK_CUR, $SEEK_END) = (0, 1, 2);
sub doVersionHack($) {
my ($argvR) = @_;
my $arg1 = $argvR->[0];
if (defined($arg1) && (($arg1 eq "--version") || ($arg1 eq "-version"))) {
my $termStatus = system('pnmcolormap', '--version');
exit($termStatus == 0 ? 0 : 1);
}
}
sub tempFile($) {
# We trust Perl's File::Temp to do a better job of creating the temp
# file, but it doesn't exist before Perl 5.6.1.
if (eval { require File::Temp; 1 }) {
return File::Temp::tempfile("pnmquant_XXXX",
SUFFIX=>".pnm",
DIR=>File::Spec->tmpdir(),
UNLINK=>$TRUE);
} else {
my ($suffix) = @_;
my $fileName;
local *file; # For some inexplicable reason, must be local, not my
my $i;
$i = 0;
do {
$fileName = File::Spec->tmpdir() . "/pnmquant_" . $i++ . $suffix;
} until sysopen(*file, $fileName, O_RDWR|O_CREAT|O_EXCL);
return(*file, $fileName);
}
}
sub parseCommandLine(@) {
local @ARGV = @_; # GetOptions takes input from @ARGV only
my %cmdline;
my $validOptions = GetOptions(\%cmdline,
"center",
"meancolor",
"meanpixel",
"spreadbrightness",
"spreadluminosity",
"floyd|fs!",
"quiet",
"plain");
if (!$validOptions) {
print(STDERR "Invalid option syntax.\n");
exit(1);
}
if (@ARGV > 2) {
print(STDERR "This program takes at most 2 arguments. You specified ",
scalar(@ARGV), "\n");
exit(1);
}
elsif (@ARGV < 1) {
print(STDERR
"You must specify the number of colors as an argument.\n");
exit(1);
}
my $infile;
$cmdline{ncolors} = $ARGV[0];
if (!($cmdline{ncolors} =~ m{ ^[[:digit:]]+$ }x ) ||
$cmdline{ncolors} == 0) {
print(STDERR
"Number of colors argument '$cmdline{ncolors}' " .
"is not a positive integer.\n");
exit(1);
}
if (@ARGV > 1) {
$cmdline{infile} = $ARGV[1];
} else {
$cmdline{infile} = "-";
}
return(\%cmdline);
}
sub setAutoflush($) {
my ($fh) = @_;
# Better would be $fh->autoflush() (with use IO:Handle), but older Perl
# doesn't have it.
my $oldFh = select($fh);
$OUTPUT_AUTOFLUSH = $TRUE;
select ($oldFh);
}
sub openSeekableAsStdin($) {
my ($infile) = @_;
# Open the input file $infile and connect it to Standard Input
# (assuming Standard Input is now open as the Perl file handle STDIN).
# If $infile is "-", that means just leave Standard Input alone. But if
# Standard Input is not seekable, copy it to a temporary regular
# file and return a file handle for that. I.e. the file handle we
# return is guaranteed to be seekable.
# Note: this all works only because STDIN is already set up on file
# descriptor 0. Otherwise, open(STDIN, ...) would just create a brand
# new file handle named STDIN on some arbitrary file descriptor.
if ($infile eq "-") {
my $seekWorked = sysseek(STDIN, 0, $SEEK_SET);
if ($seekWorked) {
# STDIN is already as we need it.
} else {
# It isn't seekable, so we must copy it to a temporary regular file
# and return that as the input file.
my ($inFh, $inFilename) = tempFile(".pnm");
if (!defined($inFh)) {
die("Unable to create temporary file. Errno=$ERRNO");
}
unlink($inFilename) or
die("Unable to unlink temporary file. Errno=$ERRNO");
setAutoflush($inFh);
while (<STDIN>) {
print($inFh $_);
}
sysseek($inFh, 0, $SEEK_SET)
or die("Seek of temporary input file failed! " .
"Errno = $ERRNO");
*INFH = *$inFh; # Because open() rejects '<&$inFh'
open(STDIN, "<&INFH");
tell(INFH); # Avoids bogus "INFH is not referenced" warning
}
} else {
open(STDIN, "<$infile")
or die("Unable to open input file '$infile'. Errno=$ERRNO");
}
}
sub makeColormap($$$$$) {
my ($ncolors, $opt_meanpixel, $opt_meancolor, $opt_spreadluminosity,
$opt_quiet) = @_;
# Make a colormap of $ncolors colors from the image on Standard Input.
# Put it in a temporary file and return its name.
my ($mapfileFh, $mapfileSpec) = tempFile(".pnm");
if (!defined($mapfileFh)) {
print(STDERR "Unable to create temporary file for colormap. " .
"errno = $ERRNO\n");
exit(1);
}
my $averageOpt;
if (defined($opt_meanpixel)) {
$averageOpt = "-meanpixel";
} elsif (defined($opt_meancolor)) {
$averageOpt = "-meancolor";
} else {
$averageOpt = "-center";
}
my $spreadOpt;
if (defined($opt_spreadluminosity)) {
$spreadOpt = "-spreadluminosity";
} else {
$spreadOpt = "-spreadbrightness";
}
my @options;
@options = ($averageOpt, $spreadOpt);
if (defined($opt_quiet)) {
push(@options, '-quiet');
}
open(STDOUT, ">$mapfileSpec");
my $maprc = system("pnmcolormap", $ncolors, @options);
if ($maprc != 0) {
print(STDERR "pnmcolormap failed, rc=$maprc\n");
exit(1);
}
return $mapfileSpec;
}
sub remap($$$$) {
my ($mapfileSpec, $opt_floyd, $opt_plain, $opt_quiet) = @_;
# Remap the image on Standard Input to Standard Output, using the colors
# from the colormap file named $mapfileSpec.
my @options;
@options = (); # initial value
if ($opt_floyd) {
push(@options, "-floyd");
}
if ($opt_plain) {
push(@options, "-plain");
}
if ($opt_quiet) {
push(@options, "-quiet");
}
my $remaprc = system("pnmremap", "-mapfile=$mapfileSpec", @options);
if ($remaprc != 0) {
print(STDERR "pnmremap failed, rc=$remaprc\n");
exit(1);
}
}
##############################################################################
# MAIN PROGRAM
##############################################################################
doVersionHack(\@ARGV);
my $cmdlineR = parseCommandLine(@ARGV);
openSeekableAsStdin($cmdlineR->{infile});
# Save Standard Output for our eventual output
open(OLDOUT, ">&STDOUT");
select(OLDOUT); # avoids Perl bug where it says we never use OLDOUT
my $mapfileSpec = makeColormap($cmdlineR->{ncolors},
$cmdlineR->{meanpixel},
$cmdlineR->{meancolor},
$cmdlineR->{spreadluminosity},
$cmdlineR->{quiet});
# Note that we use sysseek() instead of seek(), because we're positioning
# the file to be read by our non-Perl child process, rather than for reading
# through the Perl I/O layer.
sysseek(STDIN, 0, $SEEK_SET)
or die("seek back to zero on input file failed.");
open(STDOUT, ">&OLDOUT");
remap($mapfileSpec,
$cmdlineR->{floyd},
$cmdlineR->{plain},
$cmdlineR->{quiet});
unlink($mapfileSpec) or
die("Unable to unlink map file. Errno=$ERRNO");