LWP::UserAgent 下载知乎视频

There's more than one way to do it!
https://metacpan.org http://perlmonks.org
头像
523066680
Administrator
Administrator
帖子: 573
注册时间: 2016年07月19日 12:14
联系:

LWP::UserAgent 下载知乎视频

帖子 523066680 »

首发:https://zhuanlan.zhihu.com/p/36865994

视频示例:https://www.zhihu.com/question/271736973/answer/389377346

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

2018-10 知乎的视频方案已经更新为MP4单文件,更新代码移步三楼
=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__
头像
523066680
Administrator
Administrator
帖子: 573
注册时间: 2016年07月19日 12:14
联系:

2018-07 更新

帖子 523066680 »

更新内容 - 知乎去掉了 oauth 授权的部分
=info
    Author: 523066680
    Date: 2018-07
    更新:知乎去掉了 oauth 授权方式
=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;

for my $idx ( 0 .. $#video )
{
    printf "Getting video %s - %s\n", $idx, $video[$idx];
    my @vlinks = get_video_links( $video[$idx] );
    get_video( @vlinks );
}

# 获取 m3u8 列表并提取链接
sub get_video_links
{
    our ($main, $ua);
    my ( $pgcode ) = @_;

    my $res = $ua->get( $main .$pgcode );

    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 goto_dir
{
    my $dir = shift;
    mkdir $dir unless ( -e $dir );
    chdir $dir;
}
头像
523066680
Administrator
Administrator
帖子: 573
注册时间: 2016年07月19日 12:14
联系:

2018-10 更新,现在是MP4单文件下载了 Re: LWP::UserAgent 下载知乎视频

帖子 523066680 »

=info
    Author: 523066680
    2018-07 知乎去掉了 oauth 授权方式
    2018-10 从 ts 多文件,变更为 mp4 单文件下载
=cut

use JSON;
use Encode qw/from_to/;
use LWP::UserAgent;
use Mojo::DOM;
use File::Slurp;
STDOUT->autoflush(1);

our $wdir = "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 $title = get_title_name( $html );
my ($answerID) = ($target=~/\/(\d+)$/);

mkdir $wdir unless -e $wdir;
chdir $wdir;

for my $idx ( 0 .. $#video )
{
    printf "Getting video %s - %s\n", $idx, $video[$idx];
    get_video( $video[$idx], "${title}Answer_${answerID}_${idx}.mp4" );
}

sub get_video
{
    our ($main, $ua);
    my ( $pgcode, $fname ) = @_;
 
    my $res = $ua->get( $main .$pgcode );
    die unless $res->is_success();

    my $data = decode_json( $res->content );
    my $play_url = $data->{playlist}->{sd}->{play_url}; 

    $res = $ua->get( $play_url );
    write_file( $fname, {binmode=>":raw"}, $res->content );
}

sub get_title_name
{
    my $html = shift;
    my $dom = Mojo::DOM->new($html);
    my $title = $dom->at("title")->text;
    $title =~s/ - 知乎//;
    from_to( $title, "utf8", "gbk" );
    return $title;
}
头像
523066680
Administrator
Administrator
帖子: 573
注册时间: 2016年07月19日 12:14
联系:

知乎视频推荐 Re: LWP::UserAgent 下载知乎视频

帖子 523066680 »

会在这个帖子下追加一些推荐:

物理有多有趣? - 沐心的回答(和问题关系不大但是视频很满足强迫症哈哈)
https://www.zhihu.com/question/31063539/answer/509528704

有哪些内容引起极度舒适的视频? - 开眼视频的回答
https://www.zhihu.com/question/295562963/answer/522899377

有哪些内容引起极度舒适的视频? - 别人家的诸葛孔明的回答 - 知乎
https://www.zhihu.com/question/295562963/answer/524535772

有没有人能够将量子纠缠解释得让普通人也明白? - 陈龙的回答 - 知乎
https://www.zhihu.com/question/61196037/answer/600638871
zzz19760225
一代宗师
一代宗师
帖子: 930
注册时间: 2017年12月25日 11:12
联系:

Re: LWP::UserAgent 下载知乎视频

帖子 zzz19760225 »

量孑纠缠科普好(物的相对关系利用)
头像
523066680
Administrator
Administrator
帖子: 573
注册时间: 2016年07月19日 12:14
联系:

Re: LWP::UserAgent 下载知乎视频

帖子 523066680 »

推荐:你看过哪些让你笑到窒息的视频?
https://www.zhihu.com/question/29448215 ... /776560353
zzz19760225
一代宗师
一代宗师
帖子: 930
注册时间: 2017年12月25日 11:12
联系:

Re: LWP::UserAgent 下载知乎视频

帖子 zzz19760225 »

刷抖音
头像
523066680
Administrator
Administrator
帖子: 573
注册时间: 2016年07月19日 12:14
联系:

Re: LWP::UserAgent 下载知乎视频

帖子 523066680 »

zzz19760225 写了:刷抖音
哈哈 抖音也刷。说起来,刷抖音时间流逝的真快啊。
zzz19760225
一代宗师
一代宗师
帖子: 930
注册时间: 2017年12月25日 11:12
联系:

Re: LWP::UserAgent 下载知乎视频

帖子 zzz19760225 »

523066680 写了:
zzz19760225 写了:刷抖音
哈哈 抖音也刷。说起来,刷抖音时间流逝的真快啊。
以前上过一次,发觉有些过度搞笑无下限,然后退出了。

后来学车的学员有人上抖音,就上来看看了,发觉正能量好多。

官方一看就是奉旨圈粉的,共青团,新闻联播,外交部,交通管理,应急支援(消防),,,,,

现在每天就是点点点,还好流量够用(就是有点贵)。
头像
523066680
Administrator
Administrator
帖子: 573
注册时间: 2016年07月19日 12:14
联系:

Re: LWP::UserAgent 下载知乎视频

帖子 523066680 »

移动好像有专属的抖音流量包。我那免费领了一个15G的。
回复

在线用户

正浏览此版面之用户: 没有注册用户 和 1 访客