LWP下載知乎答案中的視頻

523066680

首發：https://zhuanlan.zhihu.com/p/36865994

視頻示例：https://www.zhihu.com/question/271736973/answer/389377346

其中 use Modern::Perl; 不是必需的。

1. =info
   
2.     Author: 523066680
   
3.     Date: 2018-05
   
4. =cut
   
5. 
   
6. use Modern::Perl;
   
7. use LWP::UserAgent;
   
8. use File::Slurp;
   
9. use JSON;
   
10. STDOUT->autoflush(1);
    
11. 
    
12. goto_dir("D:/temp");
    
13. our $main = "https://lens.zhihu.com/api/videos/";
    
14. our $ua = LWP::UserAgent->new(  );
    
15. our $target = "https://www.zhihu.com/question/271736973/answer/389377346";
    
16. 
    
17. my $res = $ua->get( $target );
    
18. my $html = $res->content();
    
19. my @video = $html=~/>https:.*?video\/(\d+)</g;
    
20. my $oauth = get_oauth( $html );
    
21. 
    
22. for my $idx ( 0 .. $#video )
    
23. {
    
24.     printf "Getting video %s - %s\n", $idx, $video[$idx];
    
25.     my @vlinks = get_video_links(  $oauth, $video[$idx] );
    
26.     get_video( @vlinks );
    
27. }
    
28. 
    
29. # 獲取 m3u8 列表并提取鏈接
    
30. sub get_video_links
    
31. {
    
32.     our ($main, $ua);
    
33.     my ( $oauth, $pgcode ) = @_;
    
34. 
    
35.     my $res = $ua->get(
    
36.                 $main .$pgcode,
    
37.                 "authorization" => $oauth,
    
38.             );
    
39. 
    
40.     die unless $res->is_success();
    
41. 
    
42.     my $data = decode_json( $res->content );
    
43.     my $play_url = $data->{playlist}->{sd}->{play_url};  # m3u8 url
    
44.     my $pre_url;
    
45. 
    
46.     # 獲取網址共用部分
    
47.     $play_url =~/(.*?\w{32})/;  
    
48.     $pre_url = $1 ."/";
    
49. 
    
50.     $res = $ua->get( $play_url );
    
51.     my @vlinks = $res->content =~/\n(.*?\d+\.ts.*?)\n/g;
    
52.     grep { $_ = $pre_url . $_ } @vlinks;
    
53. 
    
54.     return $pgcode, @vlinks;
    
55. }
    
56. 
    
57. # 獲取視頻切片，合并
    
58. sub get_video
    
59. {
    
60.     our $ua;
    
61.     my $name = shift;
    
62.     my $buff = "";
    
63.     my $res;
    
64. 
    
65.     while ( my $link = shift )
    
66.     {
    
67.         print $#_ + 1 ," ";
    
68.         $res = $ua->get( $link );
    
69.         $buff .= $res->content();
    
70.     }
    
71.     print "\n";
    
72. 
    
73.     write_file( "${name}.ts", {binmode=>":raw"}, $buff );
    
74. }
    
75. 
    
76. sub get_oauth
    
77. {
    
78.     our ( $ua );
    
79.     my $html = shift;
    
80.     my ($js) = $html =~/(https:[^<>]+main\.app[^<>]+js)/g;
    
81.     my $res = $ua->get( $js );
    
82.     # pattern: authorization:"oauth c3cef7c66a1843f8b3a9e6a1e3160e20"}
    
83.     my ($oauth) = $res->content =~/authorization:"([^"]{30,})"/;
    
84.     return $oauth
    
85. }
    
86. 
    
87. sub goto_dir
    
88. {
    
89.     my $dir = shift;
    
90.     mkdir $dir unless ( -e $dir );
    
91.     chdir $dir;
    
92. }
    
93. 
    
94. __DATA__
    

復制代碼

Perl 是不是過時我真的不關心，只用來做想做的事（工作和編程無關）。

2018-10 更新，7樓

iamlimeng

感谢分享！

Perl是个能干活的骆驼，用起来很爽。

dahe_1984

牛，可以做個爬蟲

dahe_1984

牛，可以做個爬蟲

523066680

回復 3# dahe_1984

寫了tumblr的視頻批量下載，不過需要賬號登錄，加上內容敏感，就沒有分享～

hztj2005

謝樓主，學習下！

523066680

更新一下，現在知乎簡化了，不用oauth，也不用多個ts文件拼接，直接單個MP4

代碼保存為 UTF8 編碼格式

1. =info
   
2.     Author: 523066680
   
3.     2018-07 知乎去掉了 oauth 授權方式
   
4.     2018-10 從 ts 多文件，變更為 mp4 單文件下載
   
5. =cut
   
6. 
   
7. use JSON;
   
8. use Encode qw/from_to/;
   
9. use LWP::UserAgent;
   
10. use Mojo::DOM;
    
11. use File::Slurp;
    
12. STDOUT->autoflush(1);
    
13. 
    
14. our $wdir = "D:/temp";
    
15. our $main = "https://lens.zhihu.com/api/videos/";
    
16. our $ua = LWP::UserAgent->new();
    
17. our $target = "https://www.zhihu.com/question/271736973/answer/389377346";
    
18. #our $target = "https://www.zhihu.com/question/285103979/answer/492401516";
    
19. #our $target = "https://www.zhihu.com/question/278030511/answer/452274063";
    
20. 
    
21. my $res = $ua->get( $target );
    
22. my $html = $res->content();
    
23. my @video = $html=~/>https:.*?video\/(\d+)</g;  # 獲取視頻頁面鏈接
    
24. my $title = get_title_name( $html );
    
25. my ($answerID) = ($target=~/\/(\d+)$/);
    
26. 
    
27. mkdir $wdir unless -e $wdir;
    
28. chdir $wdir;
    
29. 
    
30. for my $idx ( 0 .. $#video )
    
31. {
    
32.     printf "Getting video %s - %s\n", $idx, $video[$idx];
    
33.     get_video( $video[$idx], "${title}Answer_${answerID}_${idx}.mp4" );
    
34. }
    
35. 
    
36. sub get_video
    
37. {
    
38.     our ($main, $ua);
    
39.     my ( $pgcode, $fname ) = @_;
    
40. 
    
41.     my $res = $ua->get( $main .$pgcode );
    
42.     die unless $res->is_success();
    
43. 
    
44.     my $data = decode_json( $res->content );
    
45.     my $play_url = $data->{playlist}->{sd}->{play_url};
    
46. 
    
47.     $res = $ua->get( $play_url );
    
48.     write_file( $fname, {binmode=>":raw"}, $res->content );
    
49. }
    
50. 
    
51. sub get_title_name
    
52. {
    
53.     my $html = shift;
    
54.     my $dom = Mojo::DOM->new($html);
    
55.     my $title = $dom->at("title")->text;
    
56.     $title =~s/ - 知乎//;
    
57.     from_to( $title, "utf8", "gbk" );
    
58.     return $title;
    
59. }
    
60. 
    

復制代碼

shjwcs

路過看看啦啦啦啦

燦爛小豬

看不懂，學習中。