初步的小成果

时间：2007-04-29 来源：thevoice

学了几天的perl终于弄了个初步的小东西出来，可以查看书架里面最新的章节名称了。但还有很多功能没有完成: 1.只能查看bookba的更新情况,还有cmfu,qmzw,17k的没有处理。他们之间的关系比较复杂: cmfu,17k是根据地，这两个网站中有我所有想要看的书。书分VIP和非VIP两种。非VIP的可以直接在网站上观看 VIP的就比较复杂，bookba上有VIP的更新，取得的方式和cmfu,17k一样，但有的书bookba上没有更新,qmzw上有而且qmzw的更新比bookba快。qmzw是个论坛，要通过他的search.php来查询书名看更新没有，但这部分返回的内容比较复杂还没有做。

2.只是取到了书籍的名称和更新章节，没有取到文章的url链接。这是因为HTML::TableExtract模块只负责提取table中的内容，如果是不行可能还要更换模块，或者说看看HTTP::Parser模块，自己试着写提取功能。

3.定时查询功能都还没有开始想。最终的完成目标就是，设定查询时间，自动查询是否更新然后取得URL或者自动打开页面观看。还有个小问题就是如果查询到了有更新，但没有看，新的更新内容已经被记录了，再查询的时候不会提醒，怎么处理还么想好。不过这都是小问题了，呵呵。关于技术方面。这几天看了不少模块，虽然都不太懂LWP、HTML::TableExtract、HTTP::Cookies、HTTP::Request虽然到现在还是稀里糊涂的，但东西就这么初步有了小成果，perl真是门很神奇的语言。要学的东西还有很多Perl语言本身，HTTP协议，模块的用法。但要继续坚持下去，不要再浪费时间了加油！

btw.
感谢路小家、福瑞哈哥。谢谢你们的热心解答。
感谢flw：你让一再的提醒着大家当然也包括我，学东西要靠自己，不能只依赖别人。
各位perl版的同仁，大家一起努力。

#! /user/perl/bin

use warnings;
use strict;

use LWP::UserAgent;
use HTTP::Cookies;
use HTTP::Request::Common qw(POST GET);

my $ua = LWP::UserAgent->new;
my $cookie_jar = HTTP::Cookies->new;

my $url = 'http://www.bookba.net/index.asp';
my $lurl = 'http://www.bookba.net/loginuser.asp';
my $fav = 'http://www.bookba.net/mybook/bookcase.asp';

#链接bookba取得cookie

my $req = GET($url);
my $res = $ua->request($req);
$cookie_jar->extract_cookies($res);

my %form;
$form{username} = 'name';
$form{password} = 'pass';
$form{sendpost}= '登录书屋';

$req = POST ($lurl,[%form]);
$cookie_jar->add_cookie_header($req);
$res = $ua->request($req);
$cookie_jar->extract_cookies($res);

$req = GET($fav);
$cookie_jar->add_cookie_header($req);
$res = $ua->request($req);
if ($res->is_success) {
    my $cont = $res->content;
    $cont =~ s/ //g;
    #print $cont;

    &cmpContent($cont);
}else{
    print $res->status_line . "\n";
}
sub cmpContent(){
    use HTML::TableExtract;
    my $label = 'by headers';
    my $te = HTML::TableExtract->new(
        headers => [qw(书名最新章节)],
    );
    my $file = shift;
    $te->parse($file);
     foreach my $ts ($te->tables) {
           foreach my $row ($ts->rows) {
              print join(',', @$row), "\n";
           }
     }
}