File Coverage

blib/lib/Net/NicoVideo.pm

Criterion	Covered	Total	%
statement	31	267	11.6
branch	3	154	1.9
condition	0	29	0.0
subroutine	11	35	31.4
pod	27	27	100.0
total	72	512	14.0

package Net::NicoVideo;

use strict;
use warnings;
use vars qw($VERSION);
$VERSION = '0.28';

use base qw(Class::Accessor::Fast);

use Carp qw(croak);
use LWP::UserAgent;
use Net::NicoVideo::UserAgent;

use vars qw($DELAY_DEFAULT $MSG_LOGIN_FAILED);
$DELAY_DEFAULT = 1;
$MSG_LOGIN_FAILED = "Cannot login because specified account information may be invalid";

__PACKAGE__->mk_accessors(qw(
user_agent
email
password
delay
));

sub get_user_agent {
    my $self = shift;
    $self->user_agent(LWP::UserAgent->new)
        unless( $self->user_agent );
    Net::NicoVideo::UserAgent->new($self->user_agent);
}

sub get_email {
    my $self = shift;
    return defined $self->email ? $self->email : $ENV{NET_NICOVIDEO_EMAIL};
}

sub get_password {
    my $self = shift;
    return defined $self->password ? $self->password : $ENV{NET_NICOVIDEO_PASSWORD};
}

sub get_delay {
    my $self = shift;
    if( defined $self->delay ){
        return $self->delay;
    }elsif( $ENV{NET_NICOVIDEO_DELAY} ){
        return $ENV{NET_NICOVIDEO_DELAY};
    }else{
        return $DELAY_DEFAULT;
    }
}

sub through_login {
    my $self    = shift;
    my $ua      = shift;
    my $res     = $ua->request_login($self->get_email, $self->get_password);
    croak "Request 'request_login' is error: @{[ $res->status_line ]}"
        if( $res->is_error );
    $ua->login( $res ); # this returns $ua
}

sub download {
    my ($self, $video_id, @args) = @_;
    $self->fetch_watch($video_id);
    my $delay = defined($self->delay) ? $self->delay : $DELAY_DEFAULT;
    sleep $delay if( $delay );
    $self->fetch_video($self->fetch_flv($video_id), @args);
    return $self;
}

#-----------------------------------------------------------
# fetch
#

sub fetch_thumbinfo {
    my ($self, $video_id) = @_;

    my $res = $self->get_user_agent->request_thumbinfo($video_id);
    croak "Request 'request_thumbinfo' is error: @{[ $res->status_line ]}"
        if( $res->is_error );
    my $parsed_content = $res->parsed_content;

    croak "Invalid content as @{[ ref($parsed_content) ]}"
        if( $parsed_content->is_error );

    return $parsed_content;
}

sub fetch_flv {
    my ($self, $video_id) = @_;
    my $ua  = $self->get_user_agent;

    # workaround
    if( $video_id and $video_id =~ /^so\d+$/ ){
        my $item = $self->fetch_mylist_item($video_id);
        $video_id = $item->item_id;
    }

    my $res = $ua->request_flv($video_id);
    croak "Request 'request_flv' is error: @{[ $res->status_line ]}"
        if( $res->is_error );

    unless( $res->is_authflagged ){
        # try again
        $res = $self->through_login($ua)->request_flv($video_id);
        croak "Request 'request_flv' is error: @{[ $res->status_line ]}"
            if( $res->is_error );
        croak $MSG_LOGIN_FAILED
            unless( $res->is_authflagged );
    }

    my $parsed_content = $res->parsed_content;
    croak "Invalid content as @{[ ref($parsed_content) ]}"
        if( $parsed_content->is_error );

    return $parsed_content;
}

sub fetch_watch {
    my ($self, $video_id) = @_;
    my $ua  = $self->get_user_agent;

    my $res = $ua->request_watch($video_id);
    croak "Request 'request_watch' is error: @{[ $res->status_line ]}"
        if( $res->is_error );

    unless( $res->is_authflagged ){
        # try again
        $res = $self->through_login($ua)->request_watch($video_id);
        croak "Request 'request_watch' is error: @{[ $res->status_line ]}"
            if( $res->is_error );
        croak $MSG_LOGIN_FAILED
            unless( $res->is_authflagged );
    }

    my $parsed_content = $res->parsed_content;
    croak "Invalid content as @{[ ref($parsed_content) ]}"
        if( $parsed_content->is_error );

    return $parsed_content;
}

sub fetch_video {
    # $something accepts flv, url ( via flv->url ) or video_id
    my ($self, $something, @args) = @_;
    if( $something and ! ref($something) and $something !~ m{^https?://} ){
        # it is a video_id
        $something = $self->fetch_flv($something);
    }
    my $res = $self->get_user_agent->request_video($something, @args);
    croak "Request 'fetch_video' is error: @{[ $res->status_line ]}"
        if( $res->is_error );

    my $parsed_content = $res->parsed_content;
    croak "Invalid content as @{[ ref($parsed_content) ]}"
        if( $parsed_content->is_error );

    return $parsed_content;
}

sub fetch_thread {
    # $something accepts flv, or video_id
    my ($self, $something, $opts) = @_;
    if( $something and ! ref($something) ){
        # it is a video_id
        $something = $self->fetch_flv($something);
    }
    my $res = $self->get_user_agent->request_thread($something, $opts);
    croak "Request 'fetch_thread' is error: @{[ $res->status_line ]}"
        if( $res->is_error );

    my $parsed_content = $res->parsed_content;
    croak "Invalid content as @{[ ref($parsed_content) ]}"
        if( $parsed_content->is_error );

    return $parsed_content;
}

#-----------------------------------------------------------
# Tag RSS
#

sub fetch_tag_rss {
    my ($self, $keyword, $params) = @_;
    my $ua  = $self->get_user_agent;

    my $res = $ua->request_tag_rss($keyword, $params);
    croak "Request 'request_tag_rss' is error: @{[ $res->status_line ]}"
        if( $res->is_error );

    my $parsed_content = $res->parsed_content;
    croak "Invalid content as @{[ ref($parsed_content) ]}"
        if( $parsed_content->is_error );

    return $parsed_content;
}

sub fetch_tag_rss_by_recent_post { # shortcut
    my ($self, $keyword, $page) = @_;
    $page ||= 1;
    $self->fetch_tag_rss($keyword, {'sort' => 'f', page => $page});
}

#-----------------------------------------------------------
# Mylist RSS
#

sub fetch_mylist_rss {
    my ($self, $mylist) = @_;
    my $ua  = $self->get_user_agent;

    my $res = $ua->request_mylist_rss($mylist);
    croak "Request 'request_mylist_rss' is error: @{[ $res->status_line ]}"
        if( $res->is_error and $res->code ne '403' );
    my $parsed_content = $res->parsed_content;

    if( ( ! $res->is_authflagged or $parsed_content->is_closed )
     and defined $self->get_email
     and defined $self->get_password
    ){
        # try again
        $res = $self->through_login($ua)->request_mylist_rss($mylist);
        croak "Request 'request_mylist_rss' is error: @{[ $res->status_line ]}"
            if( $res->is_error and $res->code ne '403' );
        croak $MSG_LOGIN_FAILED
            unless( $res->is_authflagged );
        $parsed_content = $res->parsed_content;
    }

    croak "Invalid content as @{[ ref($parsed_content) ]}"
        if( $res->is_content_error );

    return $parsed_content;
}

#-----------------------------------------------------------
# Mylist Base
#

# taking NicoAPI.token
sub fetch_mylist_page {
    my ($self) = @_;
    my $ua  = $self->get_user_agent;

    my $res = $ua->request_mylist_page;
    croak "Request 'request_mylist_page' is error: @{[ $res->status_line ]}"
        if( $res->is_error );

    unless( $res->is_authflagged ){
        # try again
        $res = $self->through_login($ua)->request_mylist_page;
        croak $MSG_LOGIN_FAILED
            unless( $res->is_authflagged );
    }

    my $parsed_content = $res->parsed_content;
    croak "Invalid content as @{[ ref($parsed_content) ]}"
        if( $parsed_content->is_error );

    return $parsed_content;
}

# taking NicoAPI.token to update Mylist, item_type and item_id for video_id
sub fetch_mylist_item {
    my ($self, $video_id) = @_;
    my $ua  = $self->get_user_agent;

    my $res = $ua->request_mylist_item($video_id);
    croak "Request 'request_mylist_item' is error: @{[ $res->status_line ]}"
        if( $res->is_error );

    unless( $res->is_authflagged ){
        # try again
        $res = $self->through_login($ua)->request_mylist_item($video_id);
        croak "Request 'request_mylist_item' is error: @{[ $res->status_line ]}"
            if( $res->is_error );
        croak $MSG_LOGIN_FAILED
            unless( $res->is_authflagged );
    }

    my $parsed_content = $res->parsed_content;
    croak "Invalid content as @{[ ref($parsed_content) ]}"
        if( $parsed_content->is_error );

    return $parsed_content;
}

#-----------------------------------------------------------
# NicoAPI.MylistGroup
#

# NicoAPI.MylistGroup #list
sub list_mylistgroup {
    my ($self) = @_;
    my $ua  = $self->get_user_agent;

    my $res = $ua->request_mylistgroup_list;
    croak "Request 'request_mylistgroup_list' is error: @{[ $res->status_line ]}"
        if( $res->is_error );

    my $parsed_content = $res->parsed_content;

    unless( $parsed_content->is_success ){
        if( $parsed_content->is_error_noauth ){
            # try again
            $res = $self->through_login($ua)->request_mylistgroup_list;
            croak "Request 'request_mylistgroup_list' is error: @{[ $res->status_line ]}"
                if( $res->is_error );
            $parsed_content = $res->parsed_content;
            unless( $parsed_content->is_success ){
                croak $MSG_LOGIN_FAILED if( $parsed_content->is_error_noauth );
                croak "Invalid content as @{[ ref($parsed_content) ]}";
            }
        }
    }

    return $parsed_content;
}

# NicoAPI.MylistGroup #get
sub get_mylistgroup {
    my ($self, $group_id) = @_;
    my $ua  = $self->get_user_agent;

    my $res = $ua->request_mylistgroup_get($group_id);
    croak "Request 'request_mylistgroup_get' is error: @{[ $res->status_line ]}"
        if( $res->is_error );

    my $parsed_content = $res->parsed_content;

    unless( $parsed_content->is_success ){
        if( $parsed_content->is_error_noauth ){
            # try again
            $res = $self->through_login($ua)->request_mylistgroup_get($group_id);
            croak "Request 'request_mylistgroup_get' is error: @{[ $res->status_line ]}"
                if( $res->is_error );
            $parsed_content = $res->parsed_content;
            unless( $parsed_content->is_success ){
                croak $MSG_LOGIN_FAILED if( $parsed_content->is_error_noauth );
                croak "Invalid content as @{[ ref($parsed_content) ]}";
            }
        }
    }

    return $parsed_content;
}

# NicoAPI.MylistGroup #add
sub add_mylistgroup {
    my ($self, $mylist, $token) = @_;
    my $ua  = $self->get_user_agent;
    $token = $self->fetch_mylist_page->token
        unless( $token );
    my $res = $ua->request_mylistgroup_add($mylist, $token);
    croak "Request 'request_mylistgroup_add' is error: @{[ $res->status_line ]}"
        if( $res->is_error );
    return $res->parsed_content;
}

# NicoAPI.MylistGroup #update
sub update_mylistgroup {
    my ($self, $mylist, $token) = @_;
    my $ua  = $self->get_user_agent;
    $token = $self->fetch_mylist_page->token
        unless( $token );
    my $res = $ua->request_mylistgroup_update($mylist, $token);
    croak "Request 'request_mylistgroup_update' is error: @{[ $res->status_line ]}"
        if( $res->is_error );
    return $res->parsed_content;
}

# NicoAPI.MylistGroup #remove
sub remove_mylistgroup {
    my ($self, $mylist, $token) = @_;
    my $ua  = $self->get_user_agent;
    $token = $self->fetch_mylist_page->token
        unless( $token );
    my $res = $ua->request_mylistgroup_delete($mylist, $token);
    croak "Request 'request_mylistgroup_delete' is error: @{[ $res->status_line ]}"
        if( $res->is_error );
    return $res->parsed_content;
}

*delete_mylistgroup = *remove_mylistgroup;

#-----------------------------------------------------------
# NicoAPI.Mylist
#

# NicoAPI.Mylist #list
sub list_mylist {
    my ($self, $group) = @_; # mylistgroup or group_id
    my $ua  = $self->get_user_agent;

    my $res = $ua->request_mylist_list($group);
    croak "Request 'request_mylist_list' is error: @{[ $res->status_line ]}"
        if( $res->is_error );
    my $parsed_content = $res->parsed_content;

    unless( $parsed_content->is_success ){
        if( $parsed_content->is_error_noauth ){
            # try again
            $res = $self->through_login($ua)->request_mylist_list($group);
            croak "Request 'request_mylist_list' is error: @{[ $res->status_line ]}"
                if( $res->is_error );
            $parsed_content = $res->parsed_content;

            unless( $parsed_content->is_success ){
                croak $MSG_LOGIN_FAILED if( $parsed_content->is_error_noauth );
                croak "Invalid content as @{[ ref($parsed_content) ]}";
            }
        }
    }

    # it returns Net::NicoVideo::Content::NicoAPI::MylistItem
    return $parsed_content;
}

# NicoAPI.Mylist #add
sub add_mylist {
    my ($self, $group, $item, $token) = @_;
    my $ua = $self->get_user_agent;
    $token = $self->fetch_mylist_page->token
        unless( $token );
    my $res = $ua->request_mylist_add($group, $item, $token);
    croak "Request 'request_mylist_add' is error: @{[ $res->status_line ]}"
        if( $res->is_error );
    return $res->parsed_content;
}

# NicoAPI.Mylist #update
sub update_mylist {
    my ($self, $group, $item, $token) = @_;
    my $ua = $self->get_user_agent;
    $token = $self->fetch_mylist_page->token
        unless( $token );
    my $res = $ua->request_mylist_update($group, $item, $token);
    croak "Request 'request_mylist_update' is error: @{[ $res->status_line ]}"
        if( $res->is_error );
    return $res->parsed_content;
}

# NicoAPI.Mylist #remove
sub remove_mylist {
    my ($self, $group, $item, $token) = @_;
    my $ua  = $self->get_user_agent;
    $token = $self->fetch_mylist_page->token
        unless( $token );
    my $res = $ua->request_mylist_remove($group, $item, $token);
    croak "Request 'request_mylist_remove' is error: @{[ $res->status_line ]}"
        if( $res->is_error );
    return $res->parsed_content;
}

*delete_mylist = *remove_mylist;

# NicoAPI.Mylist #move
sub move_mylist {
    my ($self, $group, $target, $item, $token) = @_;
    my $ua  = $self->get_user_agent;
    $token = $self->fetch_mylist_page->token
        unless( $token );
    my $res = $ua->request_mylist_move($group, $target, $item, $token);
    croak "Request 'request_mylist_move' is error: @{[ $res->status_line ]}"
        if( $res->is_error );
    return $res->parsed_content;
}

# NicoAPI.Mylist #copy
sub copy_mylist {
    my ($self, $group, $target, $item, $token) = @_;
    my $ua  = $self->get_user_agent;
    $token = $self->fetch_mylist_page->token
        unless( $token );
    my $res = $ua->request_mylist_copy($group, $target, $item, $token);
    croak "Request 'request_mylist_copy' is error: @{[ $res->status_line ]}"
        if( $res->is_error );
    return $res->parsed_content;
}

1;
__END__