For reasons of my own, I required a memory efficient montager.
I coded it around netpbm, especially
pnmcat and it uses named pipelines (Posix FIFO's).
It only accepts JPEG and generates a PAM stream to stdout; typical usage would be, where BR is a row separator.
tess.pl tile0_0.jpg tile0_1.jpg tile0_3.jpg BR tile_1_0.jpg tile_1_1.jpg tile_1_2.jpg | pnmtojpeg -quality=85 > all.jpg
There may be remaining bugs, but it has worked for my purpose.
It may serve others either "as is", or as an example of technique.
BugBear
Code: Select all
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
use File::Basename;
use Carp;
use POSIX;
sub fullyQuoted {
my ($s) = @_;
$s =~ s/'/'\\''/g;
return "'$s'";
}
my @tmpFileList;
# any path passed to this method is recorded,
# and an attempt to unlink() it made at END time
sub deleteFileAtEnd {
my ($f) = @_;
push @tmpFileList, $f;
return $f;
}
# takes a base and optional extension; the process ID
# and extension (if defined) are concatanated to the base
sub tmpFileName {
my ( $base, $extension ) = @_;
if ( defined($extension) ) {
return $base . $$ . $extension;
}
else {
return $base . $$;
}
}
# wrapper that returns a fileName as per tmpFileName
# and also marks the file for eventual cleanup
sub tmpFileNameDeleteAtEnd {
return deleteFileAtEnd( tmpFileName(@_) );
}
END {
my $f;
foreach $f (@tmpFileList) {
if ( defined($f) && -e $f ) {
unlink $f or croak "couldn't delete file $f:$!";
}
}
}
sub _backtick {
my ( $cmd, $handler ) = @_;
my $ret = `$cmd`;
if($? == -1) {
&$handler(
sprintf( 'back tick : --%s-- could not be called', $cmd ) );
}
my $exit = ( $? >> 8 );
if ( $exit != 0 ) {
&$handler(
sprintf( 'back tick : --%s-- failed, exit = %d', $cmd, $exit ) );
}
return $ret;
}
# execute like the `` operator, but catch, and deal
# with failures, by croak-ing
sub backtickdie {
my ($cmd) = @_;
_backtick(
$cmd,
sub {
my ($msg) = @_;
croak $msg;
}
);
}
# create a command that perform a LR concat of JPG files to pnm stdout
sub lr {
my ($files, $row_index) = @_;
my $col_index = 0;
my @ff;
foreach my $f (@$files) {
my $fifo_name = tmpFileNameDeleteAtEnd(sprintf("/tmp/f_%03d_%03d", $row_index, $col_index), "");
mkfifo($fifo_name, 0666);
# spawn a converter
my $src = fullyQuoted($f);
system("jpegtopnm $src > $fifo_name &");
push @ff, $fifo_name;
$col_index++;
}
my $row_name = tmpFileNameDeleteAtEnd(sprintf("/tmp/f_%03d", $row_index), "");
mkfifo($row_name, 0666);
my $src_list = join " ", @ff;
system("pnmcat -lr $src_list > $row_name &");
return $row_name;
}
sub tb {
my ($tb) = @_;
my $row_index = 0;
my @ff;
foreach my $r (@$tb) {
push @ff, lr($r, $row_index++);
}
my $name = tmpFileNameDeleteAtEnd("/tmp/ff", "");
mkfifo($name, 0666);
my $src_list = join " ", @ff;
system("pnmcat -tb $src_list > $name &");
return $name;
}
sub stack_and_pump {
my ($tb) = @_;
my $src;
if(scalar(@$tb) == 1) {
$src = lr($tb->[0], 0);
} else {
$src = tb($tb);
}
my $in;
open $in, "<", $src or die "cannot open $src";
my $buf;
while (read $in, $buf, 32 * 1024) {
print STDOUT $buf;
}
close($in);
}
sub arg_parse {
my ($argv) = @_;
my @TB;
my @LR;
foreach my $f (@$argv) {
if($f =~ /^br$/i) {
push @TB, [@LR];
@LR = ();
} else {
push @LR, $f;
}
}
if(scalar(@LR) > 0) {
push @TB, [@LR];
}
stack_and_pump(\@TB);
}
unless(scalar(@ARGV) > 1) {
die "usage $0 <file1> <file2> ['BR'] <file3> ... <filen> <output>";
}
# sort of like undice, but more pipe-lined
arg_parse(\@ARGV);
