samples/samp-scale.cgi

   1 #!/usr/bin/perl -w
   2
   3 =head1 NAME
   4
   5 samp-scale.cgi - sample CGI that takes an uploaded image to make a new image using Imager
   6
   7 =head1 SYNOPSIS
   8
   9   Copy samp-scale.html to your document tree.
  10   Copy samp-scale.cgi to your /cgi-bin
  11   Browse to samp-scale.html in your browser
  12   Select an image file
  13   Click on "Scale Image"
  14
  15 =cut
  16
  17
  18 use strict;
  19 use Imager;
  20 use CGI;
  21
  22 my $cgi = CGI->new;
  23
  24 my $filename = $cgi->param('image');
  25 if ($filename) {
  26   my $fh = $cgi->upload('image');
  27   if ($fh) {
  28     binmode $fh;
  29
  30     my $image = Imager->new;
  31     if ($image->read(fh=>$fh)) {
  32       # scale it to max 200 x 200
  33       my $scaled = $image->scale(xpixels=>200, ypixels=>200, type=>'min');
  34       if ($scaled) {
  35         # no line end conversion (or UTF or whatever)
  36         binmode STDOUT;
  37
  38         # send in the order we provide it
  39         ++$|;
  40
  41         # give it back to the user - as a JPEG
  42         print "Content-Type: image/jpeg\n\n";
  43         $scaled->write(fd=>fileno(STDOUT), type=>'jpeg');
  44       }
  45       else {
  46         # this should only fail in strange circumstances
  47         error("Cannot scale image: ", $image->errstr);
  48       }
  49     }
  50     else {
  51       error("Cannot read image: ".$image->errstr);
  52     }
  53   }
  54   else {
  55     error("Incorrect form or input tag - check enctype and that the file upload field is type file");
  56   }
  57 }
  58 else {
  59   error("No image was supplied");
  60 }
  61
  62 # simple error handler, ideally you'd display the form again with
  63 # an error in the right place, but this is a sample
  64 sub error {
  65   my ($msg) = @_;
  66
  67   print "Content-Type: text/plain\n\nError processing form:\n$msg\n";
  68   exit;
  69 }
  70
  71 =head1 DESCRIPTION
  72
  73 This is a sample CGI program that accepts an image file from the
  74 browser.
  75
  76 Please read L<Imager::Cookbook/Parsing an image posted via CGI> for
  77 cautions and explanations.
  78
  79 =head1 AUTHOR
  80
  81 Tony Cook <tony@imager.perl.org>
  82
  83 =head1 REVISION
  84
  85 $Revision$
  86
  87 =cut
  88