Foro - Perl en Español

Publicado: **2013-07-08 20:01 @875**

Mi intención es realizar una especie de proxy caché de imágenes de la web hacia mi red interna.

Buscando encontré un código que hace la mitad del objetivo, lo que falta es poder guardar la imagen en disco.

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

#!/usr/bin/perl
use LWP::Simple;
print"Content-type: image/png\n\n";

  getprint ('http://www.google.com.bo/images/srpr/logo4w.png');
# AQUÍ FALTARÍA EL CÓDIGO DE GUARDAR EL STDOUT
Coloreado en 0.002 segundos,  usando GeSHi 1.0.8.4

Como se habrán dado cuenta este CGI muestra o imprime la imagen al navegador mientras éste se descarga, después de esto mi intención es guardar la imagen mostrada.

Busqué por la web y encontré muchas formas de descargar imágenes. Entre ellos probé tres que funcionaron. Estos son USANDO

Sintáxis: [ Descargar ] [ Ocultar ]

use Image::Grab;
use LWP::UserAgent;
use LWP::Simple; (con éste usando getstore)

Todos estos hacen PRIMERO la descarga, luego mostrar en pantalla y luego lo guardan. Esto en el navegador no se ve muy bien porque se tiene que esperar la descarga sin mostrar nada en ese tiempo (muy largo, a veces) en el navegador.

PERO con getprint se puede observar cómo está cargando la imagen en el navegador. Esto está muy BIEN pero surge ese inconveniente de que NO SOY CAPAZ de guardar la imagen.

Espero su ayuda.
GRACIAS.

Publicado: **2013-07-09 07:45 @365**

Bienvenido a los foros de Perl en Español, Abraham.

La forma de resolver esto es viendo cómo lo hace getprint():

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

sub getprint ($)
{
    my($url) = @_;
    my $request = HTTP::Request->new(GET => $url);
    local($\) = ""; # ensure standard $OUTPUT_RECORD_SEPARATOR
    my $callback = sub { print $_[0] };
    if ($^O eq "MacOS") {
        $callback = sub { $_[0] =~ s/\015?\012/\n/g; print $_[0] }
    }
    my $response = $ua->request($request, $callback);
    unless ($response->is_success) {
        print STDERR $response->status_line, " <URL:$url>\n";
    }
    $response->code;
}
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

Como ves, lo que hace es una llamada a un objeto LWP::UserAgent, en el método request(), que incluye una $callback a una función que realiza la operación de sacar el recurso (o parte del recurso) solicitado, hacia la salida estándar.

Entonces... necesitamos un código parecido, añadiendo nuestras necesidades particulares. Sería algo parecido a esto:

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

sub getprint ($)
{
    my($url) = @_;
 
    # necesitamos saber el nombre del recurso con el que vamos a grabarlo en disco
    my($recurso) = $url =~ m{([^/]+?)$};
 
    # if (-e "$cachedir/$recurso") {
    #     # tenemos el recurso en caché, así que no lo pedimos, y en su lugar lo servimos de forma local
    #     ...;
    #     return;
    # }
 
    my $request = HTTP::Request->new(GET => $url);
    local($\) = "";
 
    # abrimos el archivo donde vamos a guardar el recurso, mientras se baja
    open my $fh, '>', "$dircache/$recurso";
 
    my $callback = sub {
                        print     $_[0];     # a la salida estándar
                        print $fh $_[0];     # al archivo
    };
 
    my $ua = LWP::UserAgent->new;
    my $response = $ua->request($request, $callback);
 
    close $fh;
}
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

En nuestro programa, sustituimos LWP::Simple por LWP::UserAgent. Y llamamos a nuestra getprint() particular.

Bueno, no deja de ser una pequeña chapucilla, pero en teoría, debería funcionar.

Un resultado más correcto debería conseguirse con HTTP::Proxy. Trae un filtro específico para el guardado de archivos: HTTP::Proxy::BodyFilter::save.

Publicado: **2013-07-09 10:50 @493**

GRACIAS, pero muchas gracias, además de resolver mi GRAN problema me has abierto las puertas a otra forma de pensar que ni se me había ocurrido:

La forma de resolver esto es viendo cómo lo hace getprint()

Perl me ha dado muchas satisfacciones, y en ningún momento dudé de él, y con esto las posibilidades crecen. Nuevamente, GRACIAS, explorer.

Bueno, se puede dar el tema como cerrado.

Foro - Perl en Español

Cómo guardar el STDOUT después de ser mostrado

Cómo guardar el STDOUT después de ser mostrado

Re: Cómo guardar el STDOUT después de ser mostrado

Re: Cómo guardar el STDOUT después de ser mostrado