JezK
Edit File: pnmquantall
#!/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 ############################################################################## # 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; use IO::Handle; my $TRUE=1; my $FALSE = 0; sub pm_message($) { STDERR->print("pnmquantall: $_[0]\n"); } 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 parseArgs($$$$) { my ($argvR, $extR, $newColorCtR, $fileNamesR) = @_; my @argv = @{$argvR}; my $firstArgPos; if (@argv > 0 && $argv[0] eq "-ext") { if (@argv < 2) { pm_message("-ext requires a value"); exit(100); } else { $$extR = $argv[1]; $firstArgPos = 2; } } else { $$extR = ""; $firstArgPos = 0; } if (@argv < $firstArgPos + 2) { pm_message("Not enough arguments. You need at least the number " . "of colors and one file name"); exit(100); } $$newColorCtR = $argv[$firstArgPos]; @{$fileNamesR} = @argv[$firstArgPos + 1 .. @argv-1]; } sub tempFile($) { my ($suffix) = @_; # 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=>$suffix, DIR=>File::Spec->tmpdir(), UNLINK=>$TRUE); } else { 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 makeColorMap($$$$) { my ($fileNamesR, $newColorCt, $colorMapFileName, $errorR) = @_; my $pamcatCmd = "pamcat -topbottom -white -jleft @{$fileNamesR}"; my $pnmcolormapCmd = "pnmcolormap $newColorCt"; my $makeMapCmd = "$pamcatCmd | $pnmcolormapCmd >$colorMapFileName"; my $termStatus = system($makeMapCmd); if ($termStatus != 0) { $$errorR = "Shell command to create the color map failed: '$makeMapCmd'."; } } sub remapFiles($$$$) { my ($fileNamesR, $colorMapFileName, $ext, $errorR) = @_; my ($outputFh, $outputFileName) = tempFile("pnm"); if (!defined($outputFh)) { $$errorR = "Unable to create temporary file. Errno=$ERRNO"; } else { for (my $i = 0; $i < @{$fileNamesR} && !$$errorR; ++$i) { my $inFileName = $fileNamesR->[$i]; my $pnmremapCmd = "pnmremap '$inFileName' -mapfile=$colorMapFileName " . ">$outputFileName"; my $pnmremapTermStatus = system($pnmremapCmd); if ($pnmremapTermStatus != 0) { $$errorR = "Shell command to quantize '$inFileName' failed: " . "'$pnmremapCmd'"; } else { my $newFileName = $inFileName . $ext; unlink($newFileName); File::Copy::move($outputFileName, $newFileName) or $$errorR = "Rename to '$newFileName' failed."; } } unlink($outputFileName); # In case something failed } } ############################################################################### # MAINLINE ############################################################################### my $progError; doVersionHack(\@ARGV); parseArgs(\@ARGV, \my $ext, \my $newColorCt, \my @fileNames); my ($colorMapFh, $colorMapFileName) = tempFile("pnm"); if (!defined($colorMapFh)) { $progError = "Unable to create temporary file. Errno=$ERRNO"; } if (!$progError) { makeColorMap(\@fileNames, $newColorCt, $colorMapFileName, \$progError); } if (!$progError) { remapFiles(\@fileNames, $colorMapFileName, $ext, \$progError); } my $exitStatus; if ($progError) { pm_message("Failed. $progError"); $exitStatus = 1; } else { $exitStatus = 0; } unlink($colorMapFileName); exit($exitStatus);