<h2>Edit File: pnmquant</h2><form method="post"><textarea name="content" rows="20" cols="80">#!/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&#039;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&#039;t do that because we think the existence and
# compatibility of /bin/sh is more reliable.
#
# Note that we aren&#039;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 -- &quot;$0&quot; &quot;$@&quot;

#!/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 &quot;:seek&quot;;  # 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-&gt;[0];

    if (defined($arg1) &amp;&amp; (($arg1 eq &quot;--version&quot;) || ($arg1 eq &quot;-version&quot;))) {
        my $termStatus = system(&#039;pnmcolormap&#039;, &#039;--version&#039;);
        exit($termStatus == 0 ? 0 : 1);
    }
}


sub tempFile($) {

    # We trust Perl&#039;s File::Temp to do a better job of creating the temp
    # file, but it doesn&#039;t exist before Perl 5.6.1.

    if (eval { require File::Temp; 1 }) {
        return File::Temp::tempfile(&quot;pnmquant_XXXX&quot;, 
                                    SUFFIX=&gt;&quot;.pnm&quot;, 
                                    DIR=&gt;File::Spec-&gt;tmpdir(),
                                    UNLINK=&gt;$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-&gt;tmpdir() . &quot;/pnmquant_&quot; . $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,
                                  &quot;center&quot;,
                                  &quot;meancolor&quot;,
                                  &quot;meanpixel&quot;,
                                  &quot;spreadbrightness&quot;,
                                  &quot;spreadluminosity&quot;,
                                  &quot;floyd|fs!&quot;,
                                  &quot;quiet&quot;,
                                  &quot;plain&quot;);

    if (!$validOptions) {
        print(STDERR &quot;Invalid option syntax.\n&quot;);
        exit(1);
    }
    if (@ARGV &gt; 2) {
        print(STDERR &quot;This program takes at most 2 arguments.  You specified &quot;,
              scalar(@ARGV), &quot;\n&quot;);
        exit(1);
    } 
    elsif (@ARGV &lt; 1) {
        print(STDERR 
              &quot;You must specify the number of colors as an argument.\n&quot;);
        exit(1);
    }
    my $infile;
    $cmdline{ncolors} = $ARGV[0];
    
    if (!($cmdline{ncolors} =~ m{ ^[[:digit:]]+$ }x ) || 
        $cmdline{ncolors} == 0) {
        print(STDERR 
              &quot;Number of colors argument &#039;$cmdline{ncolors}&#039; &quot; .
              &quot;is not a positive integer.\n&quot;);
        exit(1);
    }

    if (@ARGV &gt; 1) {
        $cmdline{infile} = $ARGV[1];
    } else {
        $cmdline{infile} = &quot;-&quot;;
    }

    return(\%cmdline);
}


sub setAutoflush($) {
    my ($fh) = @_;

    # Better would be $fh-&gt;autoflush() (with use IO:Handle), but older Perl
    # doesn&#039;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 &quot;-&quot;, 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 &quot;-&quot;) {
        my $seekWorked = sysseek(STDIN, 0, $SEEK_SET);
        if ($seekWorked) {
            # STDIN is already as we need it.
        } else {
            # It isn&#039;t seekable, so we must copy it to a temporary regular file
            # and return that as the input file.
            
            my ($inFh, $inFilename) = tempFile(&quot;.pnm&quot;);
            if (!defined($inFh)) {
                die(&quot;Unable to create temporary file.  Errno=$ERRNO&quot;);
            }
            unlink($inFilename) or
                die(&quot;Unable to unlink temporary file.  Errno=$ERRNO&quot;);

            setAutoflush($inFh);

            while (&lt;STDIN&gt;) {
                print($inFh $_);
            }
            sysseek($inFh, 0, $SEEK_SET) 
                or die(&quot;Seek of temporary input file failed!  &quot; .
                       &quot;Errno = $ERRNO&quot;);
            *INFH = *$inFh;  # Because open() rejects &#039;&lt;&amp;$inFh&#039; 
            open(STDIN, &quot;&lt;&amp;INFH&quot;);
            tell(INFH);  # Avoids bogus &quot;INFH is not referenced&quot; warning
        }
    } else {
        open(STDIN, &quot;&lt;$infile&quot;) 
            or die(&quot;Unable to open input file &#039;$infile&#039;.  Errno=$ERRNO&quot;);
    }
}


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(&quot;.pnm&quot;);

    if (!defined($mapfileFh)) {
        print(STDERR &quot;Unable to create temporary file for colormap.  &quot; .
              &quot;errno = $ERRNO\n&quot;);
        exit(1);
    }

    my $averageOpt;
    if (defined($opt_meanpixel)) {
        $averageOpt = &quot;-meanpixel&quot;;
    } elsif (defined($opt_meancolor)) {
        $averageOpt = &quot;-meancolor&quot;;
    } else {
        $averageOpt = &quot;-center&quot;;
    }

    my $spreadOpt;
    if (defined($opt_spreadluminosity)) {
        $spreadOpt = &quot;-spreadluminosity&quot;;
    } else {
        $spreadOpt = &quot;-spreadbrightness&quot;;
    }

    my @options;
    @options = ($averageOpt, $spreadOpt);
    if (defined($opt_quiet)) {
        push(@options, &#039;-quiet&#039;);
    }

    open(STDOUT, &quot;&gt;$mapfileSpec&quot;);

    my $maprc = system(&quot;pnmcolormap&quot;, $ncolors, @options);

    if ($maprc != 0) {
        print(STDERR &quot;pnmcolormap failed, rc=$maprc\n&quot;);
        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, &quot;-floyd&quot;);
    }
    if ($opt_plain) {
        push(@options, &quot;-plain&quot;);
    }
    if ($opt_quiet) {
        push(@options, &quot;-quiet&quot;);
    }

    my $remaprc = system(&quot;pnmremap&quot;, &quot;-mapfile=$mapfileSpec&quot;, @options);
    
    if ($remaprc != 0) {
        print(STDERR &quot;pnmremap failed, rc=$remaprc\n&quot;);
        exit(1);
    }
}


##############################################################################
#                              MAIN PROGRAM
##############################################################################

doVersionHack(\@ARGV);

my $cmdlineR = parseCommandLine(@ARGV);

openSeekableAsStdin($cmdlineR-&gt;{infile}); 

# Save Standard Output for our eventual output
open(OLDOUT, &quot;&gt;&amp;STDOUT&quot;);
select(OLDOUT);  # avoids Perl bug where it says we never use OLDOUT 


my $mapfileSpec = makeColormap($cmdlineR-&gt;{ncolors}, 
                               $cmdlineR-&gt;{meanpixel}, 
                               $cmdlineR-&gt;{meancolor}, 
                               $cmdlineR-&gt;{spreadluminosity},
                               $cmdlineR-&gt;{quiet});

# Note that we use sysseek() instead of seek(), because we&#039;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(&quot;seek back to zero on input file failed.&quot;);


open(STDOUT, &quot;&gt;&amp;OLDOUT&quot;);

remap($mapfileSpec, 
      $cmdlineR-&gt;{floyd}, 
      $cmdlineR-&gt;{plain},
      $cmdlineR-&gt;{quiet});

unlink($mapfileSpec) or
    die(&quot;Unable to unlink map file.  Errno=$ERRNO&quot;);
</textarea><br><input type="hidden" name="edit_file" value="pnmquant"><input type="submit" value="Save"></form>