[Perl]批量抓取电影资料

There's more than one way to do it!
https://metacpan.org http://perlmonks.org
头像
523066680
Administrator
Administrator
帖子: 340
注册时间: 2016年07月19日 12:14
拥有现金: 锁定
储蓄: 锁定
Has thanked: 30 times
Been thanked: 27 times
联系:

[Perl]批量抓取电影资料

帖子 #1 523066680 » 2017年03月11日 16:12

不做过多的解释~ 有空会继续完善

Code: [全选] [展开/收缩] [Download] (Untitled.bsh)
  1. =info
  2.     电影资料下载 V0.6
  3.     Code by 523066680@163.com
  4.     2017-03
  5. =cut
  6.  
  7. use utf8;
  8. use Encode;
  9. use IO::Handle;
  10. use LWP::Simple 'getstore';
  11. use LWP::UserAgent;
  12. STDOUT->autoflush(1);
  13. binmode(STDOUT, ":encoding(gbk)");
  14.  
  15. our $main = "http://www.bttiantangs.com";
  16. our $ua = LWP::UserAgent->new;
  17. $ua->agent("Mozilla/5.0");
  18.  
  19. our $title = "科幻"; #Unicode
  20.  
  21. our $fold = "F:\\Temp\\BTtiantangs";
  22. mkdir $fold if ( ! -e $fold );
  23. chdir $fold;
  24.  
  25. PAGELIST:
  26. {
  27.     my $page = getContent( "$main/sb/$title.html" );
  28.  
  29.     #Get max page number
  30.     my $last;
  31.     if ( $page =~/a href="[^"^\d]+(\d+)\.html" class="extend"/i )
  32.    {
  33.        $last = $1;
  34.    }
  35.    else
  36.    {
  37.        error("获取最后页码失败\n");
  38.    }
  39.  
  40.    for my $n ( 0 .. $last )
  41.    {
  42.        print "Page : $n\n";
  43.        getMoviesFromPage( "$main/sb/$title/$n.html" );
  44.    }
  45. }
  46.  
  47. sub getMoviesFromPage
  48. {
  49.    my $url = shift;
  50.    my $page = getContent( $url );
  51.  
  52.    #获取每个电影子页面的链接和电影名称
  53.    my ($pgcode, $name);
  54.    my $txtfile;
  55.    while ($page =~s/a href="([^"]+)" rel[^>]+>([^<]+)<//)
  56.     {
  57.         ($pgcode, $name) = ($1, encode('gbk', $2) );
  58.  
  59.         $name =~tr/\/:*?<>|/_/;               #去除特殊字符
  60.         printf("%s - %s\n", $1, $2);
  61.  
  62.         next if ( ( -e "$name.txt" ) and (-s "$name.txt" > 1024) );
  63.         getDetail( $main .$pgcode, $name );
  64.     }
  65. }
  66.  
  67. sub getDetail
  68. {
  69.     my ($url, $name) = (shift, shift);
  70.     my $page = getContent( $url );
  71.  
  72.     #获取磁力链接
  73.     my @links = ();
  74.     getLinks( \$page, \@links );
  75.  
  76.     #获取封面
  77.     my $pic = getPic(\$page);
  78.    
  79.     #获取资源信息 关键字 post_content
  80.     my $info = getInfo(\$page);
  81.  
  82.     getstore($pic, "$name.jpg") if ( $pic );
  83.  
  84.     open WRT, ">:encoding(utf8)", "$name.txt";
  85.     print WRT $pic, "\n";
  86.     print WRT $info, "\n\n";
  87.  
  88.     for my $ref ( @links )
  89.     {
  90.         print WRT sprintf("%s - %s\n%s\n\n",
  91.                         $ref->{'type'},
  92.                         $ref->{'name'},
  93.                         $ref->{'link'}
  94.                     );
  95.     }
  96.     close WRT;
  97. }
  98.  
  99. sub getLinks
  100. {
  101.     my ( $ref, $aref ) = (shift, shift);
  102.  
  103.     while ($$ref =~s/a href=.*<em>([^<]+)<\/em>.*href="([^"]+)"[^>]+>([^<]+)<//i)
  104.    {
  105.        push @{$aref}, { 'type' => $1, 'name' => $3, 'link' => $2 };
  106.    }
  107. }
  108.  
  109. sub getInfo
  110. {
  111.    my $ref = shift;
  112.  
  113.    #先把换行合并,然后去掉post_content前面的所有内容
  114.    $$ref =~s/\r?\n//g;
  115.    $$ref =~s/^(.+)post_content"\>//;
  116.  
  117.     #去除 </div> 之后的内容
  118.     $$ref =~s/<\/div>.*//;
  119.  
  120.     $$ref=~s/<[^>]+>//g;
  121.     $$ref=~s/(\s+)?◎/\n◎/g;
  122.     $$ref=~s/(\s+)?\&nbsp;\&nbsp;/\n            /ig;
  123.  
  124.     return $$ref;
  125. }
  126.  
  127. sub getPic
  128. {
  129.     my $ref = shift;
  130.     if ( $$ref =~ /post_content.*(http.*\.jpg)/i )
  131.     {
  132.         return $1;
  133.     }
  134.     else
  135.     {
  136.         print "JPG NOT FOUND!\n";
  137.         return undef;
  138.     }
  139. }
  140.  
  141. sub getContent
  142. {
  143.     my $url = shift;
  144.     my $res = $ua->get( $url );
  145.     if (! $res->is_success )
  146.     {
  147.         error("Failed\n");
  148.     }
  149.  
  150.     return decode('utf8', $res->content() );
  151. }
  152.  
  153. sub error
  154. {
  155.     printf shift;
  156.     <STDIN>;
  157.     exit;
  158. }

头像
523066680
Administrator
Administrator
帖子: 340
注册时间: 2016年07月19日 12:14
拥有现金: 锁定
储蓄: 锁定
Has thanked: 30 times
Been thanked: 27 times
联系:

[Perl]批量抓取电影资料 V0.8

帖子 #2 523066680 » 2017年03月13日 14:21

考虑到部分韩文日文编码范围的文字,改为 使用 Win32::Unicode 操作文件。

Code: [全选] [展开/收缩] [Download] (Untitled.pl)
  1. =info
  2.     bttiantangs 电影资料下载
  3.     Code by 523066680@163.com
  4.     2017-03
  5. =cut
  6.  
  7. use utf8;
  8. use Encode;
  9. use IO::Handle;
  10. use Win32::Unicode;
  11. use LWP::Simple qw/get getstore/;
  12. use LWP::UserAgent;
  13. STDOUT->autoflush(1);
  14. binmode(STDOUT, ":encoding(gbk)");
  15.  
  16. our $main = "http://www.bttiantangs.com";
  17. our $ua = LWP::UserAgent->new;
  18. $ua->agent("Mozilla/5.0");
  19.  
  20. #type: 科幻 恐怖 爱情 剧情 战争 动画 TV (top/3d/index.html)
  21. our $title = "剧情"; #Unicode
  22.  
  23. our $fold = "F:\\Temp\\BTtiantangs";
  24. mkdir $fold if ( ! -e $fold );
  25. chdir $fold;
  26.  
  27. our $htmlFold = "html";
  28. mkdir $htmlFold if ( ! -e $htmlFold );
  29.  
  30. PAGELIST:
  31. {
  32.     my $page = getContent( "$main/sb/$title.html" );
  33.  
  34.     #Get max page number
  35.     my $last;
  36.     if ( $page =~/a href="[^"^\d]+(\d+)\.html" class="extend"/i )
  37.    {
  38.        $last = $1;
  39.    }
  40.    else
  41.    {
  42.        error("获取最后页码失败\n");
  43.    }
  44.  
  45.    print "from 0 to $last\n";
  46.    for my $n ( 0 .. $last )
  47.    {
  48.        print "Page : $n\n";
  49.        getMoviesFromPage( "$main/sb/$title/$n.html" );
  50.    }
  51.    print "End\n";
  52.    <STDIN>;
  53. }
  54.  
  55. sub getMoviesFromPage
  56. {
  57.    my $url = shift;
  58.    my $page = getContent( $url );
  59.  
  60.    #获取每个电影子页面的链接和电影名称
  61.    my ($pgcode, $name);
  62.    my $txtfile;
  63.    while ($page =~s/a href="([^"]+)" rel[^>]+>([^<]+)<//)
  64.     {
  65.         ($pgcode, $name) = ($1, $2);
  66.  
  67.         $name =~tr/\/:*?<>|"/_/;               #去除特殊字符
  68.        printf("%s - %s\n", $1, $2);
  69.  
  70.        next if ( file_type('e', $name.".txt" ) and (file_size($name .".txt") > 1024) );
  71.        getDetail( $main .$pgcode, $name );
  72.    }
  73. }
  74.  
  75. sub getDetail
  76. {
  77.    my ($url, $name) = (shift, shift);
  78.    my $page = getContent( $url );
  79.  
  80.    saveHtml( $url, \$page ); # 在 $page 替换修改之前保存html
  81.  
  82.    #获取磁力链接
  83.    my @links = ();
  84.    getLinks( \$page, \@links );
  85.  
  86.    #获取封面
  87.    my $pic = getPic(\$page) || "No Pic";
  88.    
  89.    #获取资源信息 关键字 post_content
  90.    my $info = getInfo(\$page);
  91.  
  92.    my $fh = Win32::Unicode::File->new;
  93.    my $res;
  94.    if ( $pic ne "No Pic" )
  95.    {
  96.        $res = $ua->get($pic);
  97.        if ( $res->is_success )
  98.        {
  99.            $fh->open('>:raw', $name.".jpg" ) or warn "jpg $!";
  100.            print $fh $res->content();
  101.            $fh->close;
  102.        }
  103.    }
  104.  
  105.    $fh->open('>:utf8', $name.".txt" ) or die "txt $!";
  106.    
  107.    print $fh $pic, "\r\n";
  108.    print $fh $info, "\r\n\r\n";
  109.  
  110.    for my $ref ( @links )
  111.    {
  112.        printf $fh ("%s - %s\r\n%s\r\n\r\n",
  113.                        $ref->{'type'},
  114.                        $ref->{'name'},
  115.                        $ref->{'link'});
  116.    }
  117.    $fh->close;
  118. }
  119.  
  120. sub saveHtml
  121. {
  122.    my ($url, $content_ref) = (shift, shift);
  123.    my $fname;
  124.    my $content;
  125.  
  126.    $url=~/\/(\d+.html)$/;
  127.    $fname = $1;
  128.    return if ( (-e $fname) and ( -s $fname > 10240 ) );
  129.  
  130.    open WRT, ">:utf8", "./html/$fname";
  131.    print WRT $$content_ref;
  132.    close WRT;
  133. }
  134.  
  135. sub getLinks
  136. {
  137.    my ( $ref, $aref ) = (shift, shift);
  138.  
  139.    while ($$ref =~s/a href=.*<em>([^<]+)<\/em>.*href="([^"]+)"[^>]+>([^<]+)<//i)
  140.     {
  141.         push @{$aref}, { 'type' => $1, 'name' => $3, 'link' => $2 };
  142.     }
  143. }
  144.  
  145. sub getInfo
  146. {
  147.     my $ref = shift;
  148.  
  149.     #先把换行合并,然后去掉post_content前面的所有内容
  150.     $$ref =~s/\r?\n//g;
  151.     $$ref =~s/^(.+)post_content"\>//;
  152.  
  153.    #去除 </div> 之后的内容
  154.    $$ref =~s/<\/div>.*//;
  155.  
  156.    $$ref=~s/<[^>]+>//g;
  157.    $$ref=~s/(\s+)?◎/\r\n◎/g;
  158.    $$ref=~s/(\s+)?\&nbsp;\&nbsp;/\r\n            /ig;
  159.  
  160.    return $$ref;
  161. }
  162.  
  163. sub getPic
  164. {
  165.    my $ref = shift;
  166.    if ( $$ref =~ /post_content.*(http.*\.jpg)/i )
  167.    {
  168.        return $1;
  169.    }
  170.    else
  171.    {
  172.        print "JPG NOT FOUND!\n";
  173.        return undef;
  174.    }
  175. }
  176.  
  177. sub getContent
  178. {
  179.    my $url = shift;
  180.    my $res;
  181.    my $times = -1;
  182.    my $maxtimes = 5;
  183.  
  184.    do
  185.    {
  186.        $res = $ua->get( $url );
  187.        $times++;
  188.  
  189.        print "Retry : $times\n" if ($times > 0);
  190.    }
  191.    until ( $res->is_success or ($times > $maxtimes) );
  192.  
  193.    error("Failed to get $url\n") if ( $times > $maxtimes );
  194.  
  195.    return decode('utf8', $res->content() );
  196. }
  197.  
  198. sub error
  199. {
  200.    printf shift;
  201.    <STDIN>;
  202.    exit;
  203. }

头像
523066680
Administrator
Administrator
帖子: 340
注册时间: 2016年07月19日 12:14
拥有现金: 锁定
储蓄: 锁定
Has thanked: 30 times
Been thanked: 27 times
联系:

对已下载的资料进行分类整理

帖子 #3 523066680 » 2017年03月13日 14:22

Code: [全选] [展开/收缩] [Download] (Untitled.pl)
  1. use utf8;
  2. use Encode;
  3. use File::Copy;
  4. use Win32::Unicode;
  5. use IO::Handle;
  6. STDOUT->autoflush(1);
  7. #binmode(STDOUT, ":encoding(gbk)");
  8.  
  9. our $fold = "F:\\Temp\\BTtiantangs";
  10. our $fh = Win32::Unicode::File->new;
  11. our $dh = Win32::Unicode::Dir->new;
  12. chdir $fold;
  13.  
  14. our @files;
  15.  
  16. my $skip = 0;
  17. my $rate;
  18. my $path;
  19. my $jpg;
  20. my %info;
  21.  
  22. $dh->open( $fold );
  23. while (my $f = $dh->fetch() )
  24. {
  25.     if ( $f =~ /\.txt/ )
  26.     {
  27.         $skip = getRate( $f, \%info );
  28.         next if ($skip eq 'skip');
  29.  
  30.         $jpg = $f;
  31.         $jpg =~s/\.txt$/\.jpg/;
  32.  
  33.         #为不同类型创建副本
  34.         for my $n ( 0 .. $#{$info{'types'}} )
  35.         {
  36.             $path = join("/",
  37.                 $info{'rate'},
  38.                 $info{'types'}[$n],
  39.             );
  40.  
  41.             mkpathW( $path );
  42.             copyW( $f, "$path/".$info{'year'}." ".$f );
  43.             copyW( $jpg, "$path/".$info{'year'}." ".$jpg );
  44.         }
  45.     }
  46. }
  47.  
  48. sub getRate
  49. {
  50.     my ($file, $href) = (shift, shift);
  51.     my $all;
  52.  
  53.     $fh->open('<:utf8', $file);
  54.     $all = $fh->slurp;
  55.     $fh->close;
  56.  
  57.     return "skip" if ( $all=~/此剧集/ );
  58.     return "skip" if ( not $all=~/magnet\:\?/i );
  59.  
  60.     #类型
  61.     if ($all =~ /类  型 (.*+)/ )
  62.     {
  63.         $href->{'types'} = [split(" ", $1)];
  64.     }
  65.  
  66.     if ($all =~ /年  代 (\d+)/ )
  67.     {
  68.         $href->{'year'} = $1;
  69.     }
  70.  
  71.     if ( $all=~/豆瓣评分\s+(\d+)\.\d/ )
  72.     {
  73.         $href->{'rate'} = $1;
  74.     }
  75.     else
  76.     {
  77.         $href->{'rate'} = 'NoRate';
  78.     }
  79.  
  80.     return "";
  81. }


回到 “Perl”

在线用户

用户浏览此论坛: 没有注册用户 和 1 访客