Как я могу обработать изображение с помощью Perl CGI-скрипта? - PullRequest
Новая
       14

Как я могу обработать изображение с помощью Perl CGI-скрипта?

3 голосов
/ 03 мая 2009

Мой гугл фу меня подводит. Как использовать Perl для обслуживания уже сгенерированного изображения?

Пример: 

<html><body><img src="getimage.pl"></body></html>

Что входит в getimage.pl?

Ответы [ 6 ]

7 голосов
/ 03 мая 2009

Вот, пожалуйста: 

#!/usr/bin/perl -w
my $file = "inner-nav.gif";

## my $length = (stat($file)) [10];
## (stat($file)) [10]; is the inode change time in seconds since  00:00 January 1, 1970 GMT. 
my $length = (stat($file)) [7];
print "Content-type: image/gif\n";
print "Content-length: $length \n\n";
binmode STDOUT;
open (FH,'<', $file) || die "Could not open $file: $!";
my $buffer = "";
while (read(FH, $buffer, 10240)) {
    print $buffer;
}
close(FH);
6 голосов
/ 03 мая 2009

Как то так ... 

#!/usr/bin/perl

use strict;
use warnings;
use CGI;

my $gfx='';
$gfx = makeImage();
print CGI::header( type=>'image/png',
                   expires=>'+1m',
                   content_length=>length($gfx)});
print $gfx;
3 голосов
/ 22 августа 2013

Небольшая поправка к коду - предоставленная команда stat не возвращала длину файла. Некоторым браузерам было все равно, но другим не удалось загрузить изображение. (stat ($ file)) [10] - это ctime, а не длина файла. 

#!/usr/bin/perl -w
my $file = "inner-nav.gif";
my $length = -s $file;
print "Content-type: image/gif\n";
print "Content-length: $length \n\n";
binmode STDOUT;
open (FH,'<', $file) || die "Could not open $file: $!";
my $buffer = "";
while (read(FH, $buffer, 10240)) {
    print $buffer;
}
2 голосов
/ 03 мая 2009

Часто задаваемые вопросы WWW: «Как выводить изображения из сценариев Perl / CGI или PHP» должны привести вас в правильном направлении. Вы должны простить меня за то, что я не отвечаю на ваш вопрос напрямую, так как я не трогал Perl около 5 лет.

0 голосов
/ 27 июля 2015

Один пользователь спросил, не пропало ли что-то. Я думаю так. exit 1; отсутствует в конце скрипта. Вот моя пересмотренная версия (лол, я только добавил в exit 1;) 

#!/usr/bin/perl -w
my $file = "inner-nav.gif";
my $length = (stat($file)) [10];
print "Content-type: image/gif\n";
print "Content-length: $length \n\n";
binmode STDOUT;
open (FH,'<', $file) || die "Could not open $file: $!";
my $buffer = "";
while (read(FH, $buffer, 10240)) {
    print $buffer;
}
close(FH);
exit 1;

В любом случае, я думаю, что лучше сделать это: 

#!/usr/bin/perl

# must haves!
use strict;
use warnings;

use CGI;
my $cgi = new CGI; # used in 'getParam($)' for getting URL paramaters

use lib "pm"; # my own perl modules library
use user; # my user related functions
use dir; # my directory handling functions

# these will be used for $fn if $fn not found, read error, or no user
my $file_not_found = "/img_srvr/error-file-not-found.jpg";
my $read_error = "/img_srvr/error-reading-image.jpg";
my $no_such_user = "/img_srvr/error-no-such-user.jpg";

# the premise of the following is to capture all input into separate vars
# verify that each element is correct, and then spit out the image.

 # for my site.  remove it if you like.  see below for getParam($) definition
my $uid = getParam("uid");
if (not userExists($uid)) { printImage($no_such_user); exit 1; }

my $folder = "/img_srvr/$uid"; # the folder where the images are stored

my $fn = getParam("img"); # see below for definition
my $path = "$folder/$fn"; # this, too, _is_ better

if (not fileExists($path))
  { printImage($file_not_found); exit 1; } else
  { printImage($path); }

exit 1;


#########################################################################


######################
sub printImage($) {
  # be sure to do your error checking BEFORE calling this. it'll just
  # blindly rip along.
  my $fn = $_[0];
  my $type = getType($fn); # see sub below
  my $buffer = "";

  print "content-type: image/$type\n"; # these are awful, but ok for now
  print "\n"; # separate just in case we want to add more to the header.

  binmode STDOUT;

  open my $FH, "<", $fn or die "$!";
  while (read ($FH, $buffer, 10240)) {
    print $buffer; # prefer NOT to print as I read...
  }
  close $FH;

  # return $OUTPUT; # this would be better, no?
}

######################
# there's gotta be a better way, spock!
sub getType($) {
  my $f = $_[0];

  if ($f =~ /\.gif$/i) { return "gif"; }
  if ($f =~ /\.jpg|\.jpeg$/i) { return "jpeg"; }
  if ($f =~ /\.png$/i) { return "png"; }

  return "bmp";
}

sub getParam($) {
  return $cgi->param($_[0]);
}

Oh! И это может быть полезная ссылка (MIME-типы!):

====

Наконец, используя вышеупомянутую printImage функцию, которую я сделал, возможно ли «изменить» размер изображения? Если так, то как? Я не хочу устанавливать другой пакет или что-то подобное. Это должно быть просто.

0 голосов
/ 18 апреля 2013

Простое решение, которое обрабатывает файлы png или jpg. Найдите последнюю версию GD, если вы хотите использовать больше типов файлов.

http://www.perlmonks.org/?node_id=18565

# 
sub serveImage
{
    use GD;

    my ( $localPath ) = @_;

    if( $localPath =~ /\.png/i )
    {
        print "Content-type: image/png\n\n";
        binmode STDOUT;
        my $image = GD::Image->newFromPng( $localPath );
        print $image->png;
    }
    else
    {
        print "Content-type: image/jpeg\n\n";
        binmode STDOUT;
        my $image = GD::Image->newFromJpeg( $localPath );
        print $image->jpeg(100);
    }


}
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Нет похожих вопросов

...