#!/usr/bin/perl
use CGI qw/:standard/;
use File::stat;
$| = 1;
$ENV{"PATH"} = "@path@";
my $grid = "@grid@";
my $defs_file = "@defs@";
my $work_dir = "@work_dir@";
my $http_work_dir = "@http_work_dir@";
my ($x_off, $y_off, $scaling, $g_intvl, $g_thick, $g_color, $p_size);
sub get_defaults {
$x_off = "0";
$y_off = "0";
$scaling = "1";
$g_intvl = "1.5";
$g_thick = "0.05";
$g_color = "0:0:0";
$p_size = "a4";
(-f $defs_file && -r $defs_file) || return;
my $defs = `cat $defs_file`;
foreach my $rec (split (/\n/, $defs)) {
(my $key, my $val) = split(/[ \t]+/, $rec);
SWITCH: {
$key eq "x_offset" && do {$x_off = $val; last};
$key eq "y_offset" && do {$y_off = $val; last};
$key eq "scaling" && do {$scaling = $val; last};
$key eq "grid_interval" && do {$g_intvl = $val; last};
$key eq "grid_thickness" && do {$g_thick = $val; last};
$key eq "grid_color" && do {$g_color = $val; last};
$key eq "paper_size" && do {$p_size = $val; last};
}
}
}
sub show_form {
my $p_preset = "-";
my $p_other;
get_defaults;
($p_size eq "]etter" || $p_size eq "a4") ?
($p_preset = ucfirst $p_size) : ($p_other = $p_size);
(my $g_clr_r, my $g_clr_g, my $g_clr_b) = split(/:/, $g_color);
print h2("Grid an Image");
print start_multipart_form;
print table({border=>"0"},
Tr(
td({align=>"right"}, "Image File:"),
td(filefield("file", "", 50))
),
Tr(
td({colspan=>"2"}, "
")
),
Tr(
td({align=>"right"}, "Image Placement:"),
td(textfield("x_off", $x_off, 8),
textfield("y_off", $y_off, 8),
"mm from the left/bottom edge of the page")
),
Tr(
td({align=>"right"}, "Image Scaling:"),
td(textfield("scaling", $scaling, 8), "×")
),
Tr(
td({colspan=>"2"}, "
")
),
Tr(
td({align=>"right"}, "Grid Interval:"),
td(textfield("g_intvl", $g_intvl, 8), "mm")
),
Tr(
td({align=>"right"}, "Grid Thickness:"),
td(textfield("g_thick", $g_thick, 8), "mm")
),
Tr(
td({align=>"right"}, "Grid Color:"),
td(textfield("g_clr_r", $g_clr_r, 5),
textfield("g_clr_g", $g_clr_g, 5),
textfield("g_clr_b", $g_clr_b, 5),
"red green blue")
),
Tr(
td({align=>"right"}, " "),
td(checkbox("Rotate Grid"))
),
Tr(
td({colspan=>"2"}, "
")
),
Tr(
td({align=>"right"}, "Paper Size:"),
td(radio_group("p_preset", ['A4', 'Letter'], $p_preset),
" ",
"Other:", textfield("p_other", $p_other, 12),
"width×height mm")
),
Tr(
td({align=>"right"}, " "),
td(checkbox("Landscape Mode"))
),
Tr(
td({colspan=>"2"}, "
")
),
Tr(
td({align=>"right"}, "Output Format:"),
td(radio_group('format', ['PDF', 'PostScript'], 'PDF'))
),
Tr(
td({colspan=>"2"}, "
")
),
Tr(
td(" "),
td(submit("action", "Grid It!"), " ", reset)
)
);
print end_form;
}
sub grid_it {
my ($err, $tmpfile, $tmpfile2, $out_file);
my $handle = param("file");
if (! $handle) {
$err = "Missing file name";
goto END;
}
$tmpfile = `mktemp "$work_dir/webgrid.XXXXXX"`;
chomp $tmpfile;
if (! $tmpfile) {
$err = "Can't create temporary file";
goto END;
}
if (! open(TMPFILE, ">$tmpfile")) {
$err = "Can't open temporary file for output: $!";
goto END;
}
my ($nr, $ntot) = 0;
while ($nr = read($handle, $buf, 1024)) {
print TMPFILE $buf;
$ntot += $nr;
}
close TMPFILE;
if ((! defined $nr) || ($ntot == 0)) {
$err = "Can't read file \`$handle'";
goto END;
}
if (-x $grid) {
my $opt;
param("x_off") ne "" and $opt .= " -x " . param("x_off");
param("y_off") ne "" and $opt .= " -y " . param("y_off");
param("scaling") ne "" and $opt .= " -s " . param("scaling");
param("g_intvl") ne "" and $opt .= " -i " . param("g_intvl");
param("g_thick") ne "" and $opt .= " -t " . param("g_thick");
param("g_clr_r") ne "" and param("g_clr_g") ne "" and
param("g_clr_b") ne "" and $opt .= " -c " . param("g_clr_r") .
":" . param("g_clr_g") . ":" . param("g_clr_b");
param("Rotate Grid") eq "on" and $opt .= " -r ";
(param("p_other") ne "") ? ($opt .= " -p " . param("p_other")) :
($opt .= " -p " . lc param("p_preset"));
param("Landscape Mode") eq "on" and $opt .= " -l";
my $fmt = param("format");
my $ext = ($fmt eq "PDF") ? ".pdf" : ".ps";
my $i = 1;
while (-f ($out_file = ("$work_dir/" . "grid" . sprintf("%03d", $i) .
$ext))) {
$i++;
}
if ($fmt eq "PDF") {
if (`which ps2pdf`) {
$tmpfile2 = `mktemp "$work_dir/webgrid.XXXXXX"`;
chomp $tmpfile2;
if (! $tmpfile2) {
$err = "Can't create temporary file";
goto END;
}
$err = `$grid $opt $tmpfile 2>&1 1>$tmpfile2` and goto END;
$err = `ps2pdf $tmpfile2 $out_file 2>&1`;
} else {
$err = "Can't execute \`ps2pdf'";
}
} else {
$err = `$grid $opt $tmpfile 2>&1 1>$out_file`;
}
} else {
$err = "Can't execute \`$grid'";
}
END:
if ($err =~ /^\s*$/) {
my $sb = stat($out_file);
print h2("Gridding complete"),
start_form,
p, submit("action", "Download"), hidden("out_file", $out_file),
hidden("mtime", $sb->mtime), hidden("format", $fmt),
end_form;
} else {
print h2("Gridding failed"),
pre($err);
unlink $out_file;
}
unlink($tmpfile, $tmpfile2);
}
sub send_file {
my $out_file = param("out_file");
my $tail = ($out_file =~ /^.*\/(.*)$/)[0];
my $mtime = param("mtime");
my $fmt = param("format");
if (-f $out_file && -r $out_file && ($sb = stat($out_file)) &&
$sb->mtime == $mtime) {
print "Content-Type: application/". lc $fmt . "\n";
$fmt eq "PDF" and print "Content-Transfer-Encoding: binary\n";
print "Content-Disposition: inline; filename=\"$tail\"\n\n";
system("cat \"$out_file\"");
unlink $out_file;
} else {
print header,
start_html({title=>"Grid an Image", bgcolor=>"#d0d0d0"}),
h2("Error"),
pre("Can't read file \`$out_file'"),
end_html;
}
exit;
}
if (param("out_file")) {send_file}
print header;
print start_html({title=>"Grid an Image", bgcolor=>"#d0d0d0"});
if (param()) {grid_it} else {show_form}
print end_html;
.