LWP::UserAgent 下载知乎视频
发表于 : 2018年06月28日 15:52
由 523066680
首发:https://zhuanlan.zhihu.com/p/36865994
视频示例:https://www.zhihu.com/question/271736973/answer/389377346
其中 use Modern::Perl; 不是必需的。
2018-10 知乎的视频方案已经更新为MP4单文件,更新代码移步三楼
视频示例:https://www.zhihu.com/question/271736973/answer/389377346
其中 use Modern::Perl; 不是必需的。
2018-10 知乎的视频方案已经更新为MP4单文件,更新代码移步三楼
Code: [show] | [select all]
=info
Author: 523066680
Date: 2018-05
=cut
use Modern::Perl;
use LWP::UserAgent;
use File::Slurp;
use JSON;
STDOUT->autoflush(1);
goto_dir("D:/temp");
our $main = "https://lens.zhihu.com/api/videos/";
our $ua = LWP::UserAgent->new( );
our $target = "https://www.zhihu.com/question/271736973/answer/389377346";
my $res = $ua->get( $target );
my $html = $res->content();
my @video = $html=~/>https:.*?video\/(\d+)</g;
my $oauth = get_oauth( $html );
for my $idx ( 0 .. $#video )
{
printf "Getting video %s - %s\n", $idx, $video[$idx];
my @vlinks = get_video_links( $oauth, $video[$idx] );
get_video( @vlinks );
}
# 获取 m3u8 列表并提取链接
sub get_video_links
{
our ($main, $ua);
my ( $oauth, $pgcode ) = @_;
my $res = $ua->get(
$main .$pgcode,
"authorization" => $oauth,
);
die unless $res->is_success();
my $data = decode_json( $res->content );
my $play_url = $data->{playlist}->{sd}->{play_url}; # m3u8 url
my $pre_url;
# 获取网址共用部分
$play_url =~/(.*?\w{32})/;
$pre_url = $1 ."/";
$res = $ua->get( $play_url );
my @vlinks = $res->content =~/\n(.*?\d+\.ts.*?)\n/g;
grep { $_ = $pre_url . $_ } @vlinks;
return $pgcode, @vlinks;
}
# 获取视频切片,合并
sub get_video
{
our $ua;
my $name = shift;
my $buff = "";
my $res;
while ( my $link = shift )
{
print $#_ + 1 ," ";
$res = $ua->get( $link );
$buff .= $res->content();
}
print "\n";
write_file( "${name}.ts", {binmode=>":raw"}, $buff );
}
sub get_oauth
{
our ( $ua );
my $html = shift;
my ($js) = $html =~/(https:[^<>]+main\.app[^<>]+js)/g;
my $res = $ua->get( $js );
# pattern: authorization:"oauth c3cef7c66a1843f8b3a9e6a1e3160e20"}
my ($oauth) = $res->content =~/authorization:"([^"]{30,})"/;
return $oauth
}
sub goto_dir
{
my $dir = shift;
mkdir $dir unless ( -e $dir );
chdir $dir;
}
__DATA__