LWP( Library for Web access in Perl)
能做到什么？
1. 使用URL对远程Web Server读取文件。
2. 对Web Serve利用POST 方式送出form request。
3. 对远程Webserver最近更新的文件作更新动作。
4. 解析HTML 文件，取得其中的「连结」与一些需要的数据。
5. 将HTML转成纯文本文件或Postscript档案。
6. 处理cookies,HTTP redirects, proxy servers, and HTTP user authentication.这些特殊事件。
重要特性：
1.包含许多可重复使用的组件，可独立运作或相互配合使用.
提供一个HTTP-style沟通的Object Oriented模型。支援 http, https, gopher, ftp, news, file, and mailto resources.
2.提供完整的OO接口。
3.支持基本的编码与认证功能
4.支持重新导向处理。
5.可以透过代理服务器(Proxy server)
6.可以透过robots.txt建构robots。有点类似网络上的爬虫程序。
7.实作HTTP的content negotiation algorithm 可以与CGI程序作界接。
8.支援 HTTP cookies.
8.有一个简单的指令格式应用程序: lwp-request.
安装时，要求先要安装的modules：
URI URL parsing and manipulation
Net::FTP to support ftp:// URLs
MIME::Base64 to support HTTP Basic authentication
Digest::MD5 to support HTTP Digest authentication
HTML::HeadParser for finding the <BASE> tag in HTML headers
(实际上更多，因为要安装上述module可能还要先安装其它modules)
#--比较建议这种方式安装，但是如果不能对外连结，只好跟我一样慢慢抓modules，一个一个安装
用CPAN方法安装：
#perl -MCPAN -e 'install Bundle::LWP'
除了上面的模块外，另外还要安装
#perl -MCPAN -e 'install HTML::Parser' -e 'install HTML::Formatter'
如果不用CPAN方式安装：
HTML-Parser HTML Parser
HTML-Tree HTML syntax-tree generation
Font-AFM Postscript font metrics
HTML-Format HTML Formatting
一定要要下载并安装上述modules..
如果要使用HTTPS必须要安装IO ::Socket ::SSL and OpenSSL library(http://www.openssl.org)
安装完LWP后，会帮你安装四个scripts
lwp-request 取得url并显示出来
lwp-download 下载文件到硬盘，适合大档案使用。
lwp-mirror 与远程的服务器的文件作镜射动作，只更新最近有被改变的文件。
Lwp-rget 递回的取得整个档案架构
LWP基础程序：
#!/usr/bin/perl
# file get_url.pl
#--开启语法检查并使用LWP modules
use strict;
use LWP;
#--取得URL
my $url = shift;
#--建立LWP ::UserAgent 与HTTP ::Request 物件，
#--其中Request对象将$url传进去
my $agent=LWP::UserAgent->new();
my $request = HTTP::Request->new(GET=>$url);
#--透过UserAgent的request method将Request送出
my $response= $agent->request($request);
#--检查是否有error发生
$response->is_success or die "$url: ",$response->message,"/n";
#--显示responser的内容
print $response->content;
其中HTTP ::Request Object可以很简单的只有一个URL也可以很复杂的包含cookies、authentication information与CGI script所需要的arguments。
HTTP ::Response对象，主要将Server回传的结果打包起来，其包含执行结果状态的信息加上文件内容。
LWP ::UserAgent 为一个介于Client与Server中间的媒介，负责传送Request至Server，并将Server的回传值解析后存入HTTP ::Response Object中。
另外也可以使用LWP ::Simple的Modules也可以作相同的事情。
# !/usr/bin/perl
# file simple_get.pl
use LWP ::Simple ;
my $url = shift;
#--如果正常会显示内容，否则
getprint($url);
LWP中最重要的三个对象：HTTP::Request、HTTP::Response、LWP::UserAgent。
以下分别针对这三个modules作说明。
LWP Modules里面Modules间的概观：
LWP::MemberMixin -- Access to member variables of Perl5 classes
LWP::UserAgent -- WWW user agent class
LWP::RobotUA -- When developing a robot applications
LWP::Protocol -- Interface to various protocol schemes
LWP::Protocol::http -- http:// access
LWP::Protocol::file -- file:// access
LWP::Protocol::ftp -- ftp:// access
...
LWP::Authen::Basic -- Handle 401 and 407 responses
LWP::Authen::Digest
HTTP::Headers -- MIME/RFC822 style header (used by HTTP::Message)
HTTP::Message -- HTTP style message
HTTP::Request -- HTTP request
HTTP::Response -- HTTP response
HTTP::Daemon -- A HTTP server class
WWW::RobotRules -- Parse robots.txt files
WWW::RobotRules::AnyDBM_File -- Persistent RobotRules
Net::HTTP -- Low level HTTP client
在Web 服务的典型中，所有Client与Server的交互作用分为Client的request与Server的reponse
HTTP::Request：
Client的request包含URL与所使用的method。事实上HTTP::Rquset使用的是URI(Uniform Resource Identifier)包含了通讯协议与连结的服务器。
通讯协议：
HTTP(http://www.abc:port/path/)、FTP(ftp://ftpname:port/path)、GOPHER(gopher:://gophername:port/path)、SMTP(mailto:user@mailserver)、NEWS(news:message-id)
这个modules支持的方法：
GET 取得URL的文件(web page)
PUT 替代或建立URL上的文件(ftp)
POST 送出事先准备好的Form至Server处。
DELETE 删除URL上的文件(FTP Server)
HEAD 取得URL的信息
HTTP协议包含其它信息：(RFC 822-like 字段)这里只有部分：
Accept 指出client准备送出的MIME型态
User-agent Client软件的名称与版本
Content-type Request的文件型态
PUT与POST method：Request可以包含文件内容（content data）。
PUT：包含要上传的到URL的文件内容。
POST：包含已经填好的要送出至CGI Script的Form。
LWP使用HTTP::Request表示所有经由LWP所发送出去的的Request，不是只有HTTP也可以包含FTP、NNTP、SMTP等协议。
Method的说明：
$request=HTTP::Request->new($method,$url[,$header[,$content]])
建构HTTP::Request物件。最少要两个自变量（$method与$url）。$URL可以是URI对象。Header与content可以对象建立后再补数据。
$request->header($field1=>$val1,$feild2=>$val2..) 设定$field数值。
@values=$request->header($field)：取得某个field里面的所有数值。可以是list也可以是scalar variable用","分隔的Variable。
$request->push_header($filed=>$value)
将$field与$value加入在header最后面
$request->remove_header(@fields)
删掉特定的fields
$request->scan(/?)
对每个HTTP header作迭代每个element都丢入? function中，主要传入field数值与value数值。
从HTTP::Header modules中继承来的method..
$request->date()：设定时间
$request->expires()：设定过期时间
$request->last_modified()：设定resources最后修改时间
$request->if_modified_since()：检查是否从$date后有被修正过。
$request->content_type()：设定讯息内容的形式
$request->content_length()：设定讯息的长度
$request->referrer()：设定Used to specify the address (URI) of the document from which the requested resouce address was obtained.
$request->user_agent()：Client端的软件与版本
$request->content([$content])
设定requset的内容，可以是一个subroutine，LWP会不断invoke这个function直到回传null数值。
$request->content_ref
回传ref to content，可以直接修改内容
$requese->add_content($data)
增加content内容
改变URL内容与method：
$request->uri([$uri])
设定或取出URI内容
$request->method([$method])
设定或取出method内容
$string=$request->as_string
将request内容以文字方式显示出来
一些例子：
发送Email：
$req = HTTP::Request->new(POST => 'mailto:[email protected]');
$req->header(Subject => "subscribe");
$req->content("Please subscribe me to the libwww-perl mailing list!/n");
FTP档案：
$req = HTTP::Request->new(GET => 'file:/etc/passwd');
与NEWS Server作用：
$req = HTTP::Request->new(GET => 'news:[email protected]');
$req = HTTP::Request->new(POST => 'news:comp.lang.perl.test');
$req->header(Subject => 'This is a test',
From => '[email protected]');
$req->content(<<EOT);
This is the content of the message that we are sending to
the world.
EOT
CPAN Request：
$LWP::Protocol::cpan::CPAN = "file:/local/CPAN/";
HTTP::Response物件：
HTTP::Reponse接收服务器的回应值，没有限定一定要是HTTP协议。
回传的状态码，不管是不是HTTP都回传下列数值：
100-199 状态码从100到199，为要求完成前的状态码
200-299 成功
300-399 重新转向，URL已经被移动至其它地方。
400-499 Client-side 错误
500以上 Server-side 错误
如果Server回传301 或 302，则LWP会对新的URL发出要求，所以回传值，是针对新的URL并非针对旧的URL。
如果Server回传401需要Authorization，而且Authorization信息也存在，则LWP会重新发送存在Authorization的Request到Server端。
HTTP::Response有一个建构子(contructor)，但是因为不会去呼叫他，所以以下并没有列出建构子。
$status_code = $response->code
$status_message=$response->message
code()回传状态码，message()回传讯息明码内容，也可以给他参数设定他的数值。
$text=$response->status_line
回传与Web Server传回的内容一样的数值，状态码加上讯息内容。
$boolean=$response->is_success
是否成功
$boolean=$response->is_redirect
是否重新转向
$boolean=$response->is_info
是否是information
$boolean=$response->is_error
是否有错误
$html=$response->error_as_HTML
当is_error为真的时候，利用error_as_HTML产成HTML格式的错误讯系
$base=$response->base
回传base的URL。实际上回传URI对象，可用来解析relative的links。
$request=$response->request
回传HTTP::Request 物件。如果有redirect或authentication则对象内容会与原本的不一样。
$request=$reponse->previous
回传HTTP::Request对象，可以在一连串redirect之后找到原始的HTTP::Request对象内容。
下面是一个找出所有转向过程的Script：
#!/usr/bin/perl
#file follow_chain.pl
use strict;
use LWP;
my $url = shift;
my $agent = LWP::UserAgent->new();
my $request=HTTP::Request->new(HEAD=>$url);
my $response=$agent->request($request);
$response->is_success or die "$url: ", $response->message,"/n";
my @urls;
for(my $r = $response; defined $r; $r=$r->previous){
unshift @urls,$r->request->uri.'('.$r->status_line.')';
}
print "Response chain:/n /t",join("/n/t-> ",@urls),"/n";
LWP ::UserAgent物件：
LWP ::UserAgent的角色在于传送request至远程的Server，接收Server回传值并将之放入HTTP ::Response物件中。其实可以把他当成是一个Web Browser engine。
跟一般的Web browser一样，LWP ::UserAgent可以知道对方的Document是否有更新、储存Cookies、与相对应的authentication并可以透过http Proxy与其它Server相通。
UserAgent通常会被其它Class继承，以适应不同的远程Server内容。
$agent=LWP ::UserAgent->new
建立LWP ::UserAgent物件
$response=$agent->request($request,[$dest[,$size]])
产生Request，并将结果存入$response中。透过$response->code与$response->is_success()可以知道是否有成功。
$dest为一个filename，所取得的文件会存在这个地方，$response只存是否成功没有内容；如果没给，会回传至$response。
也可以是callback subroutine，
$response=$agent->request($request,/&handle_content);
sub handle_content{
my ($data,$response,$protocol) = @_;
…
}
$data :current chunk of data
$response: HTTP::Response 物件
$protocol: LWP::Protocol 物件
当使用ref to code的时候，可以利用$size控制chunk的大小。例如128，则callback subtine每次会读取128 bytes chunks of the content data.
两个request的变形：
$response=$agent->simple_request($request,[$dest,[$size]])
很像request，但是碰到redirect与authentication的时候不会再次产生新的request。
$response=$agent->mirror($url,$file)
接受一个URL与本地储存文件的路径，假如本地文件较旧，则将远程文件抓取回来。
设定Request的时间与空间限制
$timeout = $agent->timeout([$timeout])
设定或读取timeout时间，default 180秒。
$bytes = $agent->max_size([$bytes])
设定或读取远程Server所能回传的最大空间。Default undef，可以不受限制收取content
增加$request的信息
$id=$agent->agent([$id])
设定或取出User-Agent:字段。内容像name/x.xx，name是Client software名称。x.xx是版本。Default : lwpwww-perl/x.xx。可以骗remote Server
$agent->agent('Mozilla/4.7 [en] (PalmOS)') [在Palm上执行 Mozilla]
$address=$agent->from([$address])
设定或取出负责这个User-Agent的E-mail address，再使用mail或news的时候会填入From: 字段。对HTTP Server的时候不使用这个。
与Proxy作用的methods
$proxy=$agent->proxy($protocol=>$proxy);
设定或取出proxy server用的protocol与URL。
$protocol可以是一个纯量('ftp')也可以是一个ref to list(['ftp','http','gopher'])。
$proxy是proxy server用的URL。例如：
$agent->proxy([qw(ftp http)] => 'http://proxy.abc.cde:8080')
可以再呼叫以修改proxy server的protocol
$agent->proxy(ftp => 'http://proxy_1.aaa,bbb:8080');
$agent->proxy(http=>'http://proxy_2.aaa.bbb:8081');
$agent->no_proxy(@domain_list)
设定对某些domain不用proxy server。
$agent->no_proxy('localhost','aaa.bbb');
$agent->no_proxy()：清除所有先前设定的domains
$agent->env_proxy
另外一种设定proxy的方法。读取ENV变数(*_proxy)。
Setenv ftp_proxy http://aaa.bbb.ccc:8080
Setenv http_proxy http://aaa.bbb.ccc:8080
Setenv no_proxy localhost,bbb.ccc
控制Authentication与Cookies
($name,$pass) = $agent->get_basic_credentials($realm,$url,[$proxy])
当proxy server需要认证时，LWP会呼叫这个subroutine，取得username与Password。$realm是realm name是远程Server这个user要求认证的一个关键词，$url是所要Request的URL，$proxy表示是中间proxy要的授权还是远程Server要的授权。这个subroutine回传经由credentials() methods设定的账号密码。
$agent->credentials($hostport,$realm,$name,$pass)
为get_basic_credentials储存username与password。Hostport格式 :$hostname:$port、authentication realm, username and passwd。
$jar=$agent->cookie_jar([$cookie_jar])
default LWP不管cookies。可以把HTTP::Cookies透过cookie_jar将cookies储存起来，以后如果需要cookie的时候可以取出使用。
给参数，则$agent设定cookies，若不给参数则$agent回传目前的$cookies(HTTP::Cookies 物件)
储存Cookies的范例：only for this sessions
$agent->cookie_jar(new HTTP::Cookies);
将cookies储存到档案中..可以跨Session使用cookies
my $file = "$ENV{HOME}/.lwp-cookies";
$agent->cookie_jar(HTTP::Cookies->new(file=>$file,autosave=>1));
使用Netscape现成的cookies档案，MAC与Windows要作修正：
my $files = "$ENV{HOME}/.netscape/cookies";
$agent->cookie_jar(HTTP::Cookies::Netscape->new(file=>file,autosave=>1);
一些例子：
取得RFC档案：
#!/usr/bin/perl
# get_rfc.pl
use strict;
use LWP;
#设定RFCS的URL
use constant RFCS => 'http://www.faqs.org/rfcs/';
#至少一个Argument
die "Usage: get_rfc.pl rfc1 rfc2.../n" unless @ARGV;
#建立LWP::UserAgent Object
my $ua = LWP::UserAgent->new;
#设定agent ID
my $newagent = 'get_rfc/1.0 ('.$ua->agent.')';
#print "$newagent/n";
$ua->agent($newagent);
#--主循环
#先建立Request Object，再传入:LWP::UserAgent的request中
while(defined(my $rfc=shift)){
warn "$rfc: invalid RFC number/n" && next unless $rfc=~/^/d+$/;
my $request = HTTP::Request->new(GET=>RFCS."rfc$rfc.html");
my $response = $ua->request($request);
if($response->is_success){
print $response->content;
}else{
warn "RFC $rfc: ",$response->message,"/n";
}
}
作Mirror：
#!/usr/bin/perl
# file: mirror_rfc.pl
use strict;
use LWP;
use constant RFCS => 'http://www.faqs.org/rfcs/';
die "Usage: mirror_rfc.pl rfc1 rfc2.../n" unless @ARGV;
my $ua = LWP::UserAgent->new;
my $newagent = 'mirror_rfc/1.0 ('.$ua->agent.')';
$ua->agent($newagent);
while(defined (my $rfc=shift)){
warn "$rfc: invalid RFC number /n" && next unless $rfc =~ /^/d+$/;
my $filename = "rfc$rfc.html";
my $url = RFCS.$filename;
#--只检查档案新旧..当有比较新的档案的时候，会将档案回传
my $response = $ua->mirror($url,$filename);
print "RFC $rfc: ", $response->message,"/n";
}
送出FORM：
http://www.faqs.org/rfcs/ 提供一个搜寻网页，其source code如下：
<FORM METHOD=POST ACTION="/cgi-bin/rfcsearch">
<INPUT NAME=query size=25>
<SELECT NAME="archive">
<OPTION VALUE="rfcs" SELECTED> Show References
<OPTION VALUE="rank"> Rank References
<OPTION VALUE="rfcindex"> Search RFC Index
<OPTION VALUE="fyiindex"> Search FYI Index
<OPTION VALUE="stdindex"> Search STD Index
<OPTION VALUE="bcpindex"> Search BCP Index
<INPUT TYPE="submit" VALUE="Search RFCs"></TD>
</FORM>
针对上面的form送出request，透过URI::Escape将特殊字符给Escape掉
#!/usr/bin/perl
# search_rfc.pl
use strict;
use LWP;
use URI::Escape;
#--URL of remote search script
use constant RFC_SEARCH => 'http://www.faqs.org/cgi-bin/rfcsearch';
#--URL of the page on which the fill-out form is located
use constant RFC_REFERER => 'http://www.faqs.org/rfcs/';
#--检查参数是否大于1个
die "Usage: rfc_search.pl term1 term2.../n" unless @ARGV;
#--建立LWP::UserAGent 物件
my $ua = LWP::UserAgent->new;
#--设定Client Software name与Version
my $newagent = 'search_rfc/1.0 ('.$ua->agent.')';
$ua->agent($newagent);
#--处理搜寻字符串，产生CGI <form>所需要的搜寻字符串
my $search_terms = "@ARGV";
my $query_string=uri_escape("query=$search_terms&archive=rfcindex");
#print "$query_string/n";
#--建立Request对象，并设定method为POST，url为RFC_SEARCH
my $request=HTTP::Request->new(POST=>RFC_SEARCH);
#--给订request的内容为$query_string
$request->content($query_string);
#--告知<form>位于哪儿
$request->referer(RFC_REFERER);
#--取得回传值，并解析出需要的内容
my $response = $ua->request($request);
die $response->message unless $response->is_success;
my $content=$response->content;
while($content =~ /(RFC /d+).*<STRONG>(.+)<//STRONG>/g){
print "$1/t$2/n";
}
上述Script存在一个隐藏性Bug，当query_string中存在有&与=的时候，我们需要手动将&转成%26、=转成%3D然后再放入uri_escape中处理，否则会产生错误的query结果。解决方法可以用下面HTTP::Request::Common module.
使用HTTP::Request::Common：
因为POST、GET、HEAD、PUT实在是太多人使用了，因此有人开发上面这个module，只要一引用就可以直接使用这四个method。
$request=POST($url[,$form_ref][,$header1=>$val1…])
回传一个HTTP::Request对象，default使用POST method，$from_ref是一个包含所有names与values的array ref，另外如果有其它header要加入可以follow header/value的格式加入
例如：
my $request = POST('http://www.faqs.org/cgi-bin/rfcsearch',
[query => 'MIME types',
archive =>'rfcindex' ]
);
加入Referer的Header：
my $request = POST('http://www.faqs.org/cgi-bin/rfcsearch',
[ query => 'MIME types',
archive => 'rfcindex' ],
Referer => 'http://www.faqs.org/rfcs');
利用Content将form包起来，看起来比较一致性：
my $request = POST('http://www.faqs.org/cgi-bin/rfcsearch',
Content => [ query => 'MIME types',
archive => 'rfcindex' ],
Referer => 'http://www.faqs.org/rfcs');
重新撰写后：
#!/usr/bin/perl
# search_rfc2.pl
use strict;
use LWP;
use HTTP::Request::Common;
use constant RFC_SEARCH => 'http://www.faqs.org/cgi-bin/rfcsearch';
use constant RFC_REFERER => 'http://www.faqs.org/rfcs/';
die "Usage: rfc_search.pl term1 term2.../n" unless @ARGV;
my $ua = LWP::UserAgent->new;
my $newagent = 'search_rfc/1.0 ('.$ua->agent.')';
$ua->agent($newagent);
my $search_terms = "@ARGV";
#--利用HTTP::Request::Common 里面的POST method建立HTTP::Request物件
my $request = POST(RFC_SEARCH,
Content => [query => $search_terms,
archive => 'rfcindex'
],
Referer => RFC_REFERER
);
my $response = $ua->request($request);
die $response->message unless $response->is_success;
my $content=$response->content;
while($content =~ /(RFC /d+).*<STRONG>(.+)<//STRONG>/g){
print "$1/t$2/n";
}
上传档案：
上传数据时所使用的编码方式与一般的<form>不同。
<FORM METHOD=POST ACTION='/cgi-bin/upload' ENCTYPE='multipart/form-data'>
通常可以从Form中知到用的是哪一种编码。
而在LWP中可以透过
My $request = POST('http://www.faqs.org/cgi-bin/rfcsearch',
Content_Type =>'form-data',
Referer =>'http://www.faqs.org/rfcs',
Content => [ query => ' MIME types',
archive => 'rfcindex']
);
一个上传档案的CGI form范例：
<form method="post" action="/WWW/software/CGI/examples/file_upload.cgi" enctype="multipart/form-data">
<input type="file" name="filename" size=45>
<input type="checkbox" name="count" value="count lines" checked="yes">
<input type="checkbox" name="count" value="count words" checked="yes">
<input type="checkbox" name="count" value="count characters" checked="yes">
<input type="reset">
<input type="submit" name="submit" value="Process File">
<input type="hidden" name=".cgifields" value="count">
</form>
上传的程序：
#!/usr/bin/perl
use strict;
use LWP;
use HTTP::Request::Common;
use constant WC_SCRIPT =>
'http://stein.cshl.org/WWW/software/CGI/examples/file_upload.cgi';
my $file = shift or die "Usage: remote_wc.pl file/n";
my $ua = LWP::UserAgent->new;
my $newagent= ' remote_wc/1.0 ('.$ua->agent.')';
$ua->agent($newagent);
#--产生request..
my $request = POST(WC_SCRIPT ,
Content_Type => 'form-data',
Content => [
count => 'count lines',
count => 'count words',
count => 'count characters',
'.cgifields' => 'count',
submit => 'Process Fiel',
filename => [ $file ],
]
);
my $response = $ua->request($request);
die $response->message unless $response->is_success;
my $content=$response->content;
my ($lines,$words,$characters) =
$content =~ m!Lines:.+?(/d+).+?Words:.+?(/d+).+?Characters:.+(/d+)!;
print "lines = $lines; words= $words; characters = $characters/n";
取得一个被密码保护的网页：
#!/usr/bin/perl
# get_url2.pl
use strict;
use LWP;
use PromptUtil;
use vars '@ISA';
#-继承LWP::UserAgent
@ISA='LWP::UserAgent';
my $url=shift;
#--产生一个新的Object
my $agent = __PACKAGE__->new;
#--产生request
my $request = HTTP::Request->new(GET => $url);
#--取得响应资料
my $response = $agent->request($request);
$response->is_success or die "$url: ".$response->message,"/n";
print $response->content;
#--改写get_basic_credentials
sub get_basic_credentials{
my ($self,$realm,$url) = @_;
#--要求使用者输入账号密码
print STDERR "Enter username and password for realm /"$realm/"./n";
print STDERR "username: ";
#--取得账号
chomp(my $name=<>);
return unless $name;
#--取得密码 stty -echo将echo关闭
my $passwd = get_passwd;
return($name,$passwd);
}
解析HTML与XML：
将 HTML档案格式化：
HTML::Formatter 是HTML formatters的基本模块。两个家族成员有HTML::FormatText、HTML::FormatPS，两者都无法处理images、forms、tables。
格式化HTML的两个步骤
1. 利用HTML::TreeBuilder将HTML file放入一个树状架构中。
2. 利用HTML::Formatter将前面产生的树形图输出至对应的文档或PS档案中。
#!/usr/bin/perl
# format_html.pl
use strict;
use Getopt::Long;
use HTML::TreeBuilder;
my $PS;
#--假如-postscript有设定..则将PS设定为TRUE
GetOption('postscript' => /$PS)
or die "Usage: format_html.pl [-postscript] [file]/n";
my $formatter;
if($PS){
require HTML::FormatPS;
$formatter=HTML::FormatPS->new(PaperSize=>'Letter');
}else{
require HTML::FormatText;
$formatter = HTML::FormatText->new;
}
#--建立TreeBuilder对象..然后将@ARGV参数抓进来Parsing
#--完毕后呼叫eof关闭tree
my $tree = HTML::TreeBuilder->new;
$tree->parse($_) while <>;
$tree->eof;
#--将$tree格式化..并且打印出来
print $formatter->format($tree);
$tree->delete;
取得URL第三版本，加入username与password与格式化HTML的内容：
#!/usr/bin/perl
# get_url3.pl
use strict;
use LWP;
use HTML::FormatText;
use HTML::TreeBuilder;
use vars '@ISA';
@ISA = 'LWP::UserAgent';
#--取得URL
my $url=shift or die "use get_url3 url/n";
#--建立本身的对象
my $agent = __PACKAGE__->new();
#--产生Request Object
my $request = HTTP::Request->new(GET => $url);
#--建立global variable $html_tree
my $html_tree; # will hold the parse tree
#--发出request，并将结果送给&process_document subroutine
my $response = $agent->request($request,/&process_document);
#--检查是否成功
$response->is_success or die "$url: ",$response->message,"/n";
# 将html格式化后打印出来
if($html_tree){
$html_tree->eof;
print HTML::FormatText->new->format($html_tree);
$html_tree->delete;
}
#--处理回传结果的subroutine接收三个参数
#--$data,$response,$protocol
sub process_document(){
my ($data,$response,$protocol) = @_;
if($response->content_type eq "text/html"){
$html_tree ||= HTML::TreeBuilder->new;
$html_tree->parse($data);
} else {
print $data;
}
}
#--替换掉default的username/password查询机制，改成人工输入
sub get_basic_credentials{
my($self,$realm,$uri) = @_;
print STDERR "Enter username and password for realm /"$realm/".";
print STDERR "username: ";
chomp(my $name=<>);
print STDERR "passwd: ";
system("stty -echo");
chomp(my $passwd=<>);
system("stty echo");
return($name,$passwd);
}
利用HTML::Parser将Links取出
#!/usr/bin/perl
# print_links.pl
use strict;
use HTML::Parser;
#--建立HTML::Parser Object
my $parser=HTML::Parser->new(api_version=>3);
#--建立处理start的callback subroutine
$parser->handler(start=>/&print_link,'tagname,attr');
#--开始parsing输入的数据
$parser->parse($_) while <>;
#--将parser停止
$parser->eof;
#--接收两个参数$tagname与$attr两个参数
sub print_link{
my ($tagname,$attr) = @_;
#--如果tagname是a的话取出href属性
if($tagname eq 'a' ){
print "link: ",$attr->{href},"/n";
#--如果tabname是img的话取出src属性
}elsif($tagname eq "img"){
print "img: ",$attr->{src},"/n";
}
}
HTML::Parser API
$parser=HTML::Parser->new(@options)
建立HTML::Parser对象，@options最常用的就是api_version=>2 or 3。
$parser->handler($event=>/&handler,$args);
注册HTML::Parser的event handler
$event可以有的名称：start、end、text、comment、declaration、process、default。
start 碰到<a> <p> <strong>这类的启始tag时会启动
end 碰到</a></p></strong>这类的tag时会启动
text 在两个<a>与</a>之间的文字
comment 碰到<!-- --> 这类的tag时
declaration 主要应用在XML中
process 主要应用在XML中
default Catchall for anything that is not explicitly handled elsewhere
$args是一个用","分隔的字符串可以有的内容如下：
tagname Tag名称
text 完整的本文内容
dtext 解碼后的内文
attr 包含属性与数值的reference of hash
self HTML::Parser Object 的复制版本
'string' 纯文字 (single or double quotes required!)
支援的method：
$parser->handler($event=>/@array,$args)
Fill an array with the information that would have been passwd to it, then examine the array at your leisure after the parse is finished.
$result=$parser->parse_file($file)
$result=$parser->parse($data)
$parser->eof
与HTML::TreeBuilder module一样..
$bool= $parser->unbroken_text([$bool])
Default HTML::Parser会将文字分成一个个chunk送至text的handler处理，但是这样可能会造成有些文字被切断了，设定这个function为true，则会将tag中间的文字完整的传送至handler，不会将一段文字中断成两段。
$bool=$parser->xml_mode([$bool])
Xml_mode主要设定是否支持XML文件，如果设定真，可以允需空的element。<tagname />.当碰到这类的tag时，产生start与end的event。
开始这个也会使得全部转成小写的机制失效。
抓取远程RFC第三版本，加入HTML::Parser这个module：
#!/usr/bin/perl
#file : search_rfc3.pl
use strict;
#--设定使用哪些modules
use LWP;
use HTTP::Request::Common;
use HTML::Parser;
#--设定目标URL与Reference URL
use constant RFC_SEARCH => 'http://www.faqs.org/cgi-bin/rfcsearch';
use constant RFC_REFERER => 'http://www.faqs.org/rfcs/';
#--如果参数小于一个则显示错误
die "Usage: rfc_search2.pl term1 term2.../n" unless @ARGV;
#--建立LWP::UserAgent物件
my $ua = $LWP::UserAgent->new;
#--设定LWP::UserAgent的ID
my $newagent = 'search_rfc/1.0 ('.$ua->agent.')';
$ua->agent($newagent);
#--将参数视为搜寻条件
my $search_terms = "@ARGV";
#--建立POST method的Request对象
my $request = POST (RFC_SEARCH,
Content => [ query => $search_terms,
archive => 'rfcindex'
],
Referer => RFC_REFERER
);
#--设定HTML::Parser对象的版本
my $parser = HTML::Parser->new(api_version => 3);
#--设定HTML::Parser的Trigger
$parser->handler(start =>/&start,'self,tagname');
#--设定UserAgent送出request将结果存在$response
my $response=$ua->request($request,sub {$parser->parse(shift)});
#--通知$parser结束了
$parser->eof;
#--检查是否有成功
die $response->message unless $response->is_success;
#--parser callbacks:碰到<START>TAG时使用
#--传入两个参数一个HTML::Parser对象，一个tag名称
sub start{
my ($parser,$tag) = @_;
$parser->{last_lag} = $tag;
return unless $tag eq "ol";
#--设定HTML::Parser的handler
$parser->handler(text =>/&extract,'self,dtext');
$parser->handler(end =>/&end, '$self,name');
}
#--碰到</START> TAG时使用
#--传入HTML::Parser对象与Tag名称
sub end{
my ($parser,$tag)= @_;
undef $parser->{last_tag};
return unless $tag eq "ol";
#--设定HTML::Parser的handler，失效
$parser->handler(text=>undef);
$parser->handler(end=>undef);
}
#--将本文内容抽取出来
sub extract{
my($parser,$text) = @_;
$text=~ s/^/s+//g;
$text=~ s//s+$//g;
print $text,"/t" if $parser->{last_tag} eq 'a';
print $text,"/n" if $parser->{last_tag} eq 'strong';
}
再分享一下我老师大神的人工智能教程吧。零基础！通俗易懂！风趣幽默！还带黄段子！希望你也加入到我们人工智能的队伍中来！https://blog.csdn.net/jiangjunshow