InPerl:WebAccess
履歴閲覧: 最新 {2004/02/16[差分表示]}
InPerlでWebにアクセスしてあれこれやるときの便利関数群。
Webサイト/Webアプリのテストを作る/実行する時とかに便利、かも。
<pre>
+use YAML; # Dumpが便利。
+use LWP;
+use HTTP::Cookies;
+use HTML::Form;
+use HTML::FormatText;
+use HTML::TreeBuilder;
+
+use threads; #以下の3つはサーバ実装のために必要。
+use threads::shared;
+use IO::Socket;
+
+sub RES{
+ return $res;
+}
+
# TEXT : HTML::FormatTextを使ってページを表示。
sub TEXT{
my $formatter = HTML::FormatText->new();
$formatter->format(HTML::TreeBuilder->new_from_content($res->content));
}
# DISP : 適当なブラウザを使ってページを表示。
# ブラウザへの指示(``内)は適当に変更すること。
sub DISP{
+ _DISP_WRITE();
+ `galeon -n /tmp/DISP_temp.html`;
+}
+
+sub _DISP_WRITE{
open(OUT,'> /tmp/DISP_temp.html');
print OUT $res->content;
close(OUT);
- `galeon -n /tmp/DISP_temp.html`;
}
+sub GO{
+ $history = 0;
+ $req = shift;
+ $res = $ua->request($req);
+ while($res->header('location')){
+ my $req = new HTTP::Request( GET=> $res->header('location') );
+ $res = $ua->request($req);
+ }
+ unshift(@history,$res);
+ @form = HTML::Form->parse($res);
+ $form = $form[0];
+ SERVER_START();
+}
+
+sub HISTORY{
+ my $i = 0;
+ my $num = shift;
+ if($num eq 'DEL'){
+ undef(@history);
+ unshift(@history,$res);
+ return;
+ }
+ if(defined $num){
+ $res = $history[$num];
+ $req = $res->request;
+ @form = HTML::Form->parse($res);
+ $form = $form[0];
+ $history = $num;
+ return;
+ SERVER_START();
+ }
+ foreach $res (@history){
+ printf(" %1s%s: %s\n"
+ ,($i == $history)?"*":'',$i++,$res->request->uri);
+ }
+}
+
# LINK : リンクの操作
+# GO と組み合わせて使う。
+# ex: GO LINK 2
+#
# LINK => リンク一覧の表示
-# LINK 2 => 指定された番号のリンクを辿って次のページへ。マイナスを指定すれば逆順に数える。
+# LINK 2 => 指定された番号のリンクに対応したHTTP::Requestオブジェクトを返す。
+# マイナスを指定すれば逆順に数える。
# LINK uri => 直接uriを指定(相対/絶対)
sub LINK{
my $uri = shift;
unless( defined $uri ){
my $content = $res->content;
print " ".$res->base."\n";
my $i = 0;
while($content =~ /<a.*?href=([\"\'])?(.*?)\1.*?>(.*?)<\/a>/mg){
printf(" %s: %s [%s]\n",$i++,$2,$3);
}
return;
}
- if($uri =~ /^\d+$/){
+ if($uri =~ /^\-?\d+$/){
my $i = 0;
my(@list);
my $content = $res->content;
while($content =~ /<a.*?href=([\"\'])?(.*?)\1.*?>(.*?)<\/a>/mg){
push(@list,$2);
}
$uri = @list[$uri];
}
if($uri){
$uri = URI->new( $uri );
$uri = $uri->abs($res->request->uri);
- $req = new HTTP::Request( GET=> $uri );
- $res = $ua->request($req);
- return $uri;
+ return new HTTP::Request( GET=> $uri );
}else{
return 'no target';
}
}
sub DISP_FORM{
my $i = -1;
my(@submits);
foreach $input ($form->inputs){
$i++;
next if($input->type eq 'hidden');
DISP_INPUT($input,$i);
}
}
sub DISP_INPUT{
my $input = shift;
my $i = shift;
my($value,$note);
if($input->type eq 'hidden'){
$note = '(hidden) ';
}
if($input->possible_values){
$value = sprintf("( %s )",
join (' ',
map { ($_ eq $input->value)? "{$_}" : $_; }
$input->possible_values));
}elsif($input->type eq 'submit'){
printf("%d [[ %s ]]\n",$i,$input->value);
return;
}else{
$value = $input->value;
}
printf("%d %s%s=%s\n",$i,$note,$input->name,$value);
}
+# FORM : フォームの操作
+# GO と組み合わせて使う。
+# ex: GO FORM 2,1
+#
+# FORM => 入力可能パラメータ一覧の表示。
+# FORM 2 => 指定された番号のパラメータを表示
+# FORM 2, 'value' => 指定された番号のパラメータを'value'に設定
+# マイナスを指定すれば逆順に数える。
+# 但し、指定された番号のパラメータがsubmitだった場合は
+# HTTP::Requestオブジェクトを返す。
sub FORM{
my $n = shift;
- unless ($n){
+ unless ( defined $n ){
return DISP_FORM;
}
if($n >= scalar($form->inputs)){
return 'no exist input $n';
}
$input = ($form->inputs)[$n];
my $val = shift;
- unless($val){
+ unless(defined $val){
DISP_INPUT($input,$n);
return '';
}
if($input->type eq 'submit'){
return $input->click($form);
}
return $input->value($val);
}
+
+my $req : shared;
+my $res : shared;
+
+# サーバ実装：
+# threadのサポートが必要。
+#
+# http://localhost:10080/ にアクセスすると、
+# GO / HISTORY で進んだ「今見ている」ページを見ることができる。
+
+# ものすごくRFCを無視したどうかと思うWebサーバ本体
+sub SERVER{
+ my $listener = IO::Socket::INET->new(Listen => SOMAXCONN,
+ LocalPort => 10080,
+ LocalAddr => "127.0.0.1",
+ PeerAddr => "0.0.0.0",
+ Proto => 'tcp',
+ Reuse => 1
+ ) or die "create listener";
+ while(1){
+ $listener->listen or die;
+ my $sock = $listener->accept();
+ unless($sock){
+ sleep 1;
+ next;
+ }
+ while($line = $sock->getline()){
+ if($line =~ /X-WebAccess-InPerl-Quit:/){
+ close($listener);
+ close($sock);
+ $end = 1;
+ }
+ last if($line =~ /^\r\n$/);
+ }
+ last if($end);
+ my $res = RES();
+ my $content = $res->content;
+ my $buf = sprintf("HTTP/1.1 200 OK\r\nContent-Type: %s\r\nConnection: close\r\nContent-Length: %s\r\n\r\n%s"
+ ,($res->header('content-type'))[0]
+ ,length($content)
+ ,$content);
+ $sock->syswrite($buf,length($buf));
+ $sock->close;
+ }
+}
+
+# ページが切り替わる度に呼ばれる。
+# いちいちサーバーを落としてから立て直すのが格好悪い
+sub SERVER_START{
+ if($SERVER_THREAD){
+ my $sock = IO::Socket::INET->new(PeerAddr => '127.0.0.1',
+ PeerPort => 10080,
+ Proto => 'tcp');
+ $sock->syswrite("X-WebAccess-InPerl-Quit:\r\n");
+ $sock->close;
+ $SERVER_THREAD->join();
+
+ }
+ $SERVER_THREAD = threads->new(\&SERVER);
+}
+
+# コマンドラインであれこれやるためのUserAgentを作る。
+$ua = new LWP::UserAgent;
+$cookie_jar = HTTP::Cookies->new;
+$ua->cookie_jar($cookie_jar);
