[gull] requête http avec perl

[Marc SCHAEFER]

On Thu, Jun 09, 2005 at 08:40:48AM +0200, Ivo Bloechliger wrote:
> J'avais le même "problème" il y a une année. Voilà qqs bouts de code qui 
> pourraient être utile. Mais attention, c'est du bricollage. J'ai pas 
> trouvé de moyen correcte pour déterminer quand la page est entièrement 
> arrivé... Ça marche, mais c'est pas propre.

Perl a des moyens de haut niveau pour faire cela. C'est comme faire des
print "<a href=\", $url, "\">bla</a>" c'est un peu dommage: Perl a dans
CGI un support indépendant/sélectionnable de la version de HTML et la
possibilité de régler automatiquement le problème de l'encodage des
URLs.

Alors pour le HTML, exemple de petit script simple qui permet de tester
un formulaire:

PS: man LWP et HTTP recommandé

#! /usr/bin/perl -w
# post_test.pl
# AUTHOR
#    Marc SCHAEFER <schaefer at alphanet.ch>
# LICENSE
#    (C) 2004 by Marc SCHAEFER, licensed under the terms of the
#    GNU General Public License as published by the Free Software
#    Foundation; either version 2 or later (at your option).
# DESCRIPTION
#    This posts some info on a CGI.
# NOTES
#    - Usage:
#         ./post_test.pl URL 'KEY=VALUE' ... 'KEY=VALUE'
# BUGS
# TODO
# BASED-ON
#    Somewhat on send_sms.pl.
# MODIFICATION-HISTORY
#    2004-02-23  schaefer  Header creation
# $Id: post_test.pl,v 1.5 2005/05/17 13:57:57 schaefer Exp $

use strict;
use LWP::UserAgent;
use HTTP::Request::Common;

my $error_reason = 'unknown';
my $result = 0; # SUCCESS

my $show_usage = 0;

my $debug = 0;

if (scalar(@ARGV) < 1) {
    $error_reason = 'bad args';
    $result = 2; # BAD ARGS
    $show_usage = 1;
}
else {
   my $url = shift;

   # NOTES
   #    - In some cases it's best to keep the specified order. And to
   #      be able to specify an entry multiple times. Thus
   #      we use an array. Apparently ::POST keeps the order.
   my @args;
   foreach (@ARGV) {
      if (/^([^=]+)=(.*)$/) {
         push(@args, $1 => $2);
      }
      else {
         $error_reason = "can't parse key/value: " . $_;
         $result = 1;
         $show_usage = 1;
      }
   }

   if ($result == 0) {
      if (!do_post($url, \@args, \$error_reason)) {
         $result = 1;
         $error_reason = 'POST failed: ' . $error_reason;
      }
   }
}

if ($show_usage) {
   print STDERR $0, " URL [KEY=VALUE] ... [KEY=VALUE]", "\n";
}

if ($result) {
   print STDERR $0, ": failed: ", $error_reason, ".\n";
}

exit $result;

sub do_post {
   my ($url, $args_array_ref, $error_reason_ref) = @_;

   my $ok = 0; # assuming failed

   my $proxy_specification;
   if ((exists $ENV{'http_proxy'})
       && defined($ENV{'http_proxy'})) {
      $proxy_specification = $ENV{'http_proxy'};
   }

   my $ua = LWP::UserAgent->new;
   if (defined($ua)) {
      $ua->agent('post_test.pl/$Revision: 1.5 $ ' . $ua->agent);

      if (defined($proxy_specification)) {
         $ua->proxy(['http'], $proxy_specification);
      }

      my $request
         = HTTP::Request::Common::POST $url, [ @{$args_array_ref} ];
      if (defined($request)) {
         if ($debug) {
            print $request->as_string;
         }
         my $response = $ua->request($request);
         if (defined($response)) {
            if ($debug) {
               print $response->as_string;
            }

            if ($response->is_success) {
               $ok = 1;
            }
	    else {
	       $$error_reason_ref = 'HTTP error: ' . $response->code ;
	    }
	 }
	 else {
	    $$error_reason_ref = 'cannot execute request';
	 }
      }
      else {
	 $$error_reason_ref = 'cannot instanciate request';
      }
   }
   else {
      $$error_reason_ref = 'could not instanciate user agent';
   }

   return $ok;
}