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 <[EMAIL PROTECTED]>
# 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, [EMAIL PROTECTED], \$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;
}
_______________________________________________
gull mailing list
[email protected]
http://lists.alphanet.ch/mailman/listinfo/gull
