トラックバック送信
#! /usr/local/bin/perl
use LWP::UserAgent;
use HTTP::Request::Common;
print qq(Content-type: text/html; charset=Shift_JIS\n\n);
print <<END;
<html>
<head>
<title>トラックバック送信</title>
</head>
<body>
<h1 style="font-size:17px">トラックバック送信</h1>
<form action="" method="POST">
END
if($ENV{'REQUEST_METHOD'} eq 'POST') {
loadForm();
my $tb = $FORM{'tb'}; #トラックバック送信先
$tb = "http://$ENV{'HTTP_HOST'}/w/perl/trackbackget.cgi"; #サンプルにつき送信先固定（この行は削除）
my $data = [ #トラックバック送信データ
blog_name => $FORM{'blog_name'},
title => $FORM{'title'},
url => $FORM{'url'},
excerpt => $FORM{'excerpt'} ];
print <<" END";
$tb へトラックバック送信しました。<br>
<br>
$tb からのレスポンス<br>
<textarea cols="80" rows="20">
END
print postData($tb, $data); #トラックバック送信
print <<" END";
</textarea>
END
}
else {
print <<" END";
【トラックバック送信先】<br>
<input type="text" name="tb" size="100"><br>
<br>
【blog_name】<br>
<input type="text" name="blog_name" size="100"><br>
<br>
【title】<br>
<input type="text" name="title" size="100"><br>
<br>
【url】<br>
<input type="text" name="url" size="100" value="http://"><br>
<br>
【excerpt】<br>
<textarea cols="80" rows="20" name="excerpt"></textarea><br>
<br>
<input type="submit" name="submit" value=" 送信 "><br>
END
}
print <<END;
</form>
</body>
</html>
END
exit;
#============================================================================== トラックバック送信
sub postData
{
my $ua = LWP::UserAgent->new;
$ua->agent('Mozilla/4.0 (compatible; MSIE 9.0; Windows NT 6.1)');
my $request = POST($_[0], $_[1]);
my $response = $ua->request($request);
return $response->content;
# return $response->as_string; #HTTPヘッダーも取得の場合
# return $response->header('Content-Length'); #HTTPヘッダーの一部取得（ヘッダ名指定）の場合
}
#============================================================================== フォームデータ取り込み
sub loadForm
{
my ($query, $pair);
read(STDIN, $query, $ENV{'CONTENT_LENGTH'});
foreach $pair (split(/&/, $query)) {
my ($key, $value) = split(/=/, $pair);
$value =~ tr/+/ /;
$value =~ s/%([0-9a-fA-F][0-9a-fA-F])/chr(hex($1))/eg;
$FORM{$key} = $value;
}
}
〔 実行する 〕