<h2>Edit File: ppmquantall</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
##############################################################################
#                                  pnmquantall  
##############################################################################
#
# HISTORY:
#
# This was in the original 1989 Pbmplus as a C shell program.  In Netpbm 9.13
# (April 2001), it was converted to Bash.  (Actually, it was thought to be
# Bourne shell, but it used arrays).  In Netpbm 10.58 (March 2012), it was
# converted to Perl for better portability.
#
# The 2012 Perl conversion also changed the name from Ppmquantall to
# Pnmquantall.  It had already handled non-PPM input files for many years.
#
# The original program was more complex:  Because in those days Pnmcolormap
# and Pnmremap did not exist, Ppmquantall concatenated all the input images
# together and ran Ppmquant (later Pnmquant) on the combination.  It then
# split the combination image apart to make one output image per input image.
# Today, Pnmquant is just a combination of Pnmcolormap and Pnmremap, and
# we are able to use them better separately in Ppmquantall: We still make
# the combination image, but use it only to compute the colormap with
# Pnmcolormap.  We then apply that colormap separately to each input image
# to produce an output image.
#
# Bryan Henderson wrote the current version from scratch in March 2012
# and contributed it to the public domain.
#
##############################################################################

use strict;
use warnings;
use English;
use Fcntl;  # gets open flags
use File::Copy;

my $TRUE=1; my $FALSE = 0;


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 parseArgs($$$$) {
    my ($argvR, $extR, $newColorCtR, $fileNamesR) = @_;

    my @argv = @{$argvR};

    my $firstArgPos;

    if (@argv &gt; 0 &amp;&amp; $argv[0] eq &quot;-ext&quot;) {
        if (@argv &lt; 2) {
            print STDERR (&quot;-ext requires a value\n&quot;);
        exit(100);
        } else {
            $$extR = $argv[1];
            $firstArgPos = 2;
        }
    } else {
        $$extR = &quot;&quot;;
        $firstArgPos = 0;
    }

    if (@argv &lt; $firstArgPos + 2) {
        print STDERR (&quot;Not enough arguments.  You need at least the number &quot; .
                      &quot;of colors and one file name\n&quot;);
        exit(100);
    }
    
    $$newColorCtR = $argv[$firstArgPos];

    @{$fileNamesR} = @argv[$firstArgPos + 1 .. @argv-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 makeColorMap($$$$) {
    my ($fileNamesR, $newColorCt, $colorMapFileName, $errorR) = @_;

    my $pnmcatCmd = &quot;pnmcat -topbottom -white -jleft @{$fileNamesR}&quot;;

    my $pnmcolormapCmd = &quot;pnmcolormap $newColorCt&quot;;

    my $makeMapCmd = &quot;$pnmcatCmd | $pnmcolormapCmd &gt;$colorMapFileName&quot;;

    my $termStatus = system($makeMapCmd);

    if ($termStatus != 0) {
        $$errorR =
            &quot;Shell command to create the color map failed:  &#039;$makeMapCmd&#039;.&quot;;
    }
}


sub remapFiles($$$$) {
    my ($fileNamesR, $colorMapFileName, $ext, $errorR) = @_;

    my ($outputFh, $outputFileName) = tempFile(&quot;pnm&quot;);
    if (!defined($outputFh)) {
        $$errorR = &quot;Unable to create temporary file.  Errno=$ERRNO&quot;;
    } else {
        for (my $i = 0; $i &lt; @{$fileNamesR} &amp;&amp; !$$errorR; ++$i) {
            my $inFileName = $fileNamesR-&gt;[$i];

            my $pnmremapCmd =
                &quot;pnmremap &#039;$inFileName&#039; -mapfile=$colorMapFileName &quot; .
                &quot;&gt;$outputFileName&quot;;

            my $pnmremapTermStatus = system($pnmremapCmd);

            if ($pnmremapTermStatus != 0) {
                $$errorR =
                    &quot;Shell command to quantize &#039;$inFileName&#039;  failed:  &quot; .
                    &quot;&#039;$pnmremapCmd&#039;&quot;;
            } else {
                my $newFileName = $inFileName . $ext;

                unlink($newFileName);
                File::Copy::move($outputFileName, $newFileName)
                    or $$errorR = &quot;Rename to &#039;$newFileName&#039; failed.&quot;;
            }
        }
        unlink($outputFileName);  # In case something failed
    }
}


###############################################################################
#                             MAINLINE
###############################################################################

my $progError;

doVersionHack(\@ARGV);

parseArgs(\@ARGV, \my $ext, \my $newColorCt, \my @fileNames);

my ($colorMapFh, $colorMapFileName) = tempFile(&quot;pnm&quot;);
if (!defined($colorMapFh)) {
    $progError = &quot;Unable to create temporary file.  Errno=$ERRNO&quot;;
}

if (!$progError) {
    makeColorMap(\@fileNames, $newColorCt, $colorMapFileName, \$progError);
}
print (&quot;got color map\n&quot;);
if (!$progError) {
    remapFiles(\@fileNames, $colorMapFileName, $ext, \$progError);
}

my $exitStatus;

if ($progError) {
    print STDERR (&quot;Failed.  $progError\n&quot;);
    $exitStatus = 1;
} else {
    $exitStatus = 0;
}

unlink($colorMapFileName);

exit($exitStatus);
</textarea><br><input type="hidden" name="edit_file" value="ppmquantall"><input type="submit" value="Save"></form>