From c67158fa409f1b1b4f98a8621a69bb2013b76451 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jes=C3=BAs?= Date: Mon, 2 Mar 2020 08:18:54 -0500 Subject: rebrand app --- lib/WWW/FairViewer.pm | 1121 +++++++++++++++++++++++++++++ lib/WWW/FairViewer/Activities.pm | 93 +++ lib/WWW/FairViewer/Authentication.pm | 216 ++++++ lib/WWW/FairViewer/Channels.pm | 200 +++++ lib/WWW/FairViewer/CommentThreads.pm | 98 +++ lib/WWW/FairViewer/GetCaption.pm | 280 +++++++ lib/WWW/FairViewer/GuideCategories.pm | 85 +++ lib/WWW/FairViewer/Itags.pm | 319 ++++++++ lib/WWW/FairViewer/ParseJSON.pm | 76 ++ lib/WWW/FairViewer/ParseXML.pm | 311 ++++++++ lib/WWW/FairViewer/PlaylistItems.pm | 146 ++++ lib/WWW/FairViewer/Playlists.pm | 124 ++++ lib/WWW/FairViewer/RegularExpressions.pm | 89 +++ lib/WWW/FairViewer/Search.pm | 175 +++++ lib/WWW/FairViewer/Subscriptions.pm | 272 +++++++ lib/WWW/FairViewer/Utils.pm | 801 +++++++++++++++++++++ lib/WWW/FairViewer/VideoCategories.pm | 97 +++ lib/WWW/FairViewer/Videos.pm | 230 ++++++ lib/WWW/StrawViewer.pm | 1121 ----------------------------- lib/WWW/StrawViewer/Activities.pm | 93 --- lib/WWW/StrawViewer/Authentication.pm | 216 ------ lib/WWW/StrawViewer/Channels.pm | 200 ----- lib/WWW/StrawViewer/CommentThreads.pm | 98 --- lib/WWW/StrawViewer/GetCaption.pm | 280 ------- lib/WWW/StrawViewer/GuideCategories.pm | 85 --- lib/WWW/StrawViewer/Itags.pm | 319 -------- lib/WWW/StrawViewer/ParseJSON.pm | 76 -- lib/WWW/StrawViewer/ParseXML.pm | 311 -------- lib/WWW/StrawViewer/PlaylistItems.pm | 146 ---- lib/WWW/StrawViewer/Playlists.pm | 124 ---- lib/WWW/StrawViewer/RegularExpressions.pm | 89 --- lib/WWW/StrawViewer/Search.pm | 175 ----- lib/WWW/StrawViewer/Subscriptions.pm | 272 ------- lib/WWW/StrawViewer/Utils.pm | 801 --------------------- lib/WWW/StrawViewer/VideoCategories.pm | 97 --- lib/WWW/StrawViewer/Videos.pm | 230 ------ 36 files changed, 4733 insertions(+), 4733 deletions(-) create mode 100644 lib/WWW/FairViewer.pm create mode 100644 lib/WWW/FairViewer/Activities.pm create mode 100644 lib/WWW/FairViewer/Authentication.pm create mode 100644 lib/WWW/FairViewer/Channels.pm create mode 100644 lib/WWW/FairViewer/CommentThreads.pm create mode 100644 lib/WWW/FairViewer/GetCaption.pm create mode 100644 lib/WWW/FairViewer/GuideCategories.pm create mode 100644 lib/WWW/FairViewer/Itags.pm create mode 100644 lib/WWW/FairViewer/ParseJSON.pm create mode 100644 lib/WWW/FairViewer/ParseXML.pm create mode 100644 lib/WWW/FairViewer/PlaylistItems.pm create mode 100644 lib/WWW/FairViewer/Playlists.pm create mode 100644 lib/WWW/FairViewer/RegularExpressions.pm create mode 100644 lib/WWW/FairViewer/Search.pm create mode 100644 lib/WWW/FairViewer/Subscriptions.pm create mode 100644 lib/WWW/FairViewer/Utils.pm create mode 100644 lib/WWW/FairViewer/VideoCategories.pm create mode 100644 lib/WWW/FairViewer/Videos.pm delete mode 100644 lib/WWW/StrawViewer.pm delete mode 100644 lib/WWW/StrawViewer/Activities.pm delete mode 100644 lib/WWW/StrawViewer/Authentication.pm delete mode 100644 lib/WWW/StrawViewer/Channels.pm delete mode 100644 lib/WWW/StrawViewer/CommentThreads.pm delete mode 100644 lib/WWW/StrawViewer/GetCaption.pm delete mode 100644 lib/WWW/StrawViewer/GuideCategories.pm delete mode 100644 lib/WWW/StrawViewer/Itags.pm delete mode 100644 lib/WWW/StrawViewer/ParseJSON.pm delete mode 100644 lib/WWW/StrawViewer/ParseXML.pm delete mode 100644 lib/WWW/StrawViewer/PlaylistItems.pm delete mode 100644 lib/WWW/StrawViewer/Playlists.pm delete mode 100644 lib/WWW/StrawViewer/RegularExpressions.pm delete mode 100644 lib/WWW/StrawViewer/Search.pm delete mode 100644 lib/WWW/StrawViewer/Subscriptions.pm delete mode 100644 lib/WWW/StrawViewer/Utils.pm delete mode 100644 lib/WWW/StrawViewer/VideoCategories.pm delete mode 100644 lib/WWW/StrawViewer/Videos.pm (limited to 'lib/WWW') diff --git a/lib/WWW/FairViewer.pm b/lib/WWW/FairViewer.pm new file mode 100644 index 0000000..2749215 --- /dev/null +++ b/lib/WWW/FairViewer.pm @@ -0,0 +1,1121 @@ +package WWW::FairViewer; + +use utf8; +use 5.016; +use warnings; + +use parent qw( + WWW::FairViewer::Search + WWW::FairViewer::Videos + WWW::FairViewer::Channels + WWW::FairViewer::Playlists + WWW::FairViewer::ParseJSON + WWW::FairViewer::Activities + WWW::FairViewer::Subscriptions + WWW::FairViewer::PlaylistItems + WWW::FairViewer::CommentThreads + WWW::FairViewer::Authentication + WWW::FairViewer::VideoCategories + ); + +=head1 NAME + +WWW::FairViewer - A very easy interface to YouTube, using the API of invidio.us. + +=cut + +our $VERSION = '1.0.0'; + +=head1 SYNOPSIS + + use WWW::FairViewer; + + my $yv_obj = WWW::FairViewer->new(); + ... + +=head1 SUBROUTINES/METHODS + +=cut + +my %valid_options = ( + + # Main options + v => {valid => q[], default => 3}, + page => {valid => [qr/^(?!0+\z)\d+\z/], default => 1}, + http_proxy => {valid => [qr{.}], default => undef}, + hl => {valid => [qr/^\w+(?:[\-_]\w+)?\z/], default => undef}, + maxResults => {valid => [1 .. 50], default => 10}, + topicId => {valid => [qr/^./], default => undef}, + order => {valid => [qw(relevance date rating viewCount title videoCount)], default => undef}, + publishedAfter => {valid => [qr/^\d+/], default => undef}, + publishedBefore => {valid => [qr/^\d+/], default => undef}, + channelId => {valid => [qr/^[-\w]{2,}\z/], default => undef}, + channelType => {valid => [qw(any show)], default => undef}, + + # Video only options + videoCaption => {valid => [qw(any closedCaption none)], default => undef}, + videoDefinition => {valid => [qw(any high standard)], default => undef}, + videoCategoryId => {valid => [qr/^\d+\z/], default => undef}, + videoDimension => {valid => [qw(any 2d 3d)], default => undef}, + videoDuration => {valid => [qw(any short medium long)], default => undef}, + videoEmbeddable => {valid => [qw(any true)], default => undef}, + videoLicense => {valid => [qw(any creativeCommon youtube)], default => undef}, + videoSyndicated => {valid => [qw(any true)], default => undef}, + eventType => {valid => [qw(completed live upcoming)], default => undef}, + chart => {valid => [qw(mostPopular)], default => 'mostPopular'}, + + regionCode => {valid => [qr/^[A-Z]{2}\z/i], default => undef}, + relevanceLanguage => {valid => [qr/^[a-z](?:\-\w+)?\z/i], default => undef}, + safeSearch => {valid => [qw(none moderate strict)], default => undef}, + videoType => {valid => [qw(any episode movie)], default => undef}, + + comments_order => {valid => [qw(top new)], default => 'top'}, + subscriptions_order => {valid => [qw(alphabetical relevance unread)], default => undef}, + + # Misc + debug => {valid => [0 .. 3], default => 0}, + lwp_timeout => {valid => [qr/^\d+\z/], default => 1}, + config_dir => {valid => [qr/^./], default => q{.}}, + cache_dir => {valid => [qr/^./], default => q{.}}, + + # Booleans + lwp_env_proxy => {valid => [1, 0], default => 1}, + escape_utf8 => {valid => [1, 0], default => 0}, + prefer_mp4 => {valid => [1, 0], default => 0}, + prefer_av1 => {valid => [1, 0], default => 0}, + + # API/OAuth + key => {valid => [qr/^.{15}/], default => undef}, + client_id => {valid => [qr/^.{15}/], default => undef}, + client_secret => {valid => [qr/^.{15}/], default => undef}, + redirect_uri => {valid => [qr/^.{15}/], default => undef}, + access_token => {valid => [qr/^.{15}/], default => undef}, + refresh_token => {valid => [qr/^.{15}/], default => undef}, + + authentication_file => {valid => [qr/^./], default => undef}, + api_host => {valid => [qr{^https?://}], default => "https://invidio.us"}, + + # No input value allowed + api_path => {valid => q[], default => '/api/v1/'}, + video_info_url => {valid => q[], default => 'https://www.youtube.com/get_video_info'}, + oauth_url => {valid => q[], default => 'https://accounts.google.com/o/oauth2/'}, + video_info_args => {valid => q[], default => '?video_id=%s&el=detailpage&ps=default&eurl=&gl=US&hl=en'}, + www_content_type => {valid => q[], default => 'application/x-www-form-urlencoded'}, + + # LWP user agent + lwp_agent => {valid => [qr/^.{5}/], default => 'Mozilla/5.0 (X11; U; Linux i686; gzip; en-US) Chrome/10.0.648.45'}, +); + +sub _our_smartmatch { + my ($value, $arg) = @_; + + $value // return 0; + + if (ref($arg) eq '') { + return ($value eq $arg); + } + + if (ref($arg) eq ref(qr//)) { + return scalar($value =~ $arg); + } + + if (ref($arg) eq 'ARRAY') { + foreach my $item (@$arg) { + return 1 if __SUB__->($value, $item); + } + } + + return 0; +} + +sub basic_video_info_fields { + join( + ',', + qw( + title + videoId + description + published + publishedText + viewCount + likeCount + dislikeCount + genre + author + authorId + lengthSeconds + rating + liveNow + ) + ); +} + +sub extra_video_info_fields { + my ($self) = @_; + join( + ',', + $self->basic_video_info_fields, + qw( + subCountText + captions + isFamilyFriendly + ) + ); +} + +{ + no strict 'refs'; + + foreach my $key (keys %valid_options) { + + if (ref $valid_options{$key}{valid} eq 'ARRAY') { + + # Create the 'set_*' subroutines + *{__PACKAGE__ . '::set_' . $key} = sub { + my ($self, $value) = @_; + $self->{$key} = + _our_smartmatch($value, $valid_options{$key}{valid}) + ? $value + : $valid_options{$key}{default}; + }; + } + + # Create the 'get_*' subroutines + *{__PACKAGE__ . '::get_' . $key} = sub { + my ($self) = @_; + + if (not exists $self->{$key}) { + return ($self->{$key} = $valid_options{$key}{default}); + } + + $self->{$key}; + }; + } +} + +=head2 new(%opts) + +Returns a blessed object. + +=cut + +sub new { + my ($class, %opts) = @_; + + my $self = bless {}, $class; + + foreach my $key (keys %valid_options) { + if (exists $opts{$key}) { + my $method = "set_$key"; + $self->$method(delete $opts{$key}); + } + } + + foreach my $invalid_key (keys %opts) { + warn "Invalid key: '${invalid_key}'"; + } + + return $self; +} + +sub page_token { + my ($self) = @_; + + my $page = $self->get_page; + + # Don't generate the token for the first page + return undef if $page == 1; + + my $index = $page * $self->get_maxResults() - $self->get_maxResults(); + my $k = int($index / 128) - 1; + $index -= 128 * $k; + + my @f = (8, $index); + if ($k > 0 or $index > 127) { + push @f, $k + 1; + } + + require MIME::Base64; + MIME::Base64::encode_base64(pack('C*', @f, 16, 0)) =~ tr/=\n//dr; +} + +=head2 escape_string($string) + +Escapes a string with URI::Escape and returns it. + +=cut + +sub escape_string { + my ($self, $string) = @_; + + require URI::Escape; + + $self->get_escape_utf8 + ? URI::Escape::uri_escape_utf8($string) + : URI::Escape::uri_escape($string); +} + +=head2 set_lwp_useragent() + +Initializes the LWP::UserAgent module and returns it. + +=cut + +sub set_lwp_useragent { + my ($self) = @_; + + my $lwp = ( + eval { require LWP::UserAgent::Cached; 'LWP::UserAgent::Cached' } + // do { require LWP::UserAgent; 'LWP::UserAgent' } + ); + + $self->{lwp} = $lwp->new( + + cookie_jar => {}, # temporary cookies + timeout => $self->get_lwp_timeout, + show_progress => $self->get_debug, + agent => $self->get_lwp_agent, + + ssl_opts => {verify_hostname => 1, SSL_version => 'TLSv1_2'}, + + $lwp eq 'LWP::UserAgent::Cached' + ? ( + cache_dir => $self->get_cache_dir, + nocache_if => sub { + my ($response) = @_; + my $code = $response->code; + + $code >= 300 # do not cache any bad response + or $response->request->method ne 'GET' # cache only GET requests + + # don't cache if "cache-control" specifies "max-age=0" or "no-store" + or (($response->header('cache-control') // '') =~ /\b(?:max-age=0|no-store)\b/) + + # don't cache video or audio files + or (($response->header('content-type') // '') =~ /\b(?:video|audio)\b/); + }, + + recache_if => sub { + my ($response, $path) = @_; + not($response->is_fresh) # recache if the response expired + or ($response->code == 404 && -M $path > 1); # recache any 404 response older than 1 day + } + ) + : (), + + env_proxy => (defined($self->get_http_proxy) ? 0 : $self->get_lwp_env_proxy), + ); + + require LWP::ConnCache; + state $cache = LWP::ConnCache->new; + $cache->total_capacity(undef); # no limit + + state $accepted_encodings = do { + require HTTP::Message; + HTTP::Message::decodable(); + }; + + my $agent = $self->{lwp}; + $agent->ssl_opts(Timeout => 30); + $agent->default_header('Accept-Encoding' => $accepted_encodings); + $agent->conn_cache($cache); + $agent->proxy(['http', 'https'], $self->get_http_proxy) if defined($self->get_http_proxy); + + push @{$self->{lwp}->requests_redirectable}, 'POST'; + return $self->{lwp}; +} + +=head2 prepare_access_token() + +Returns a string. used as header, with the access token. + +=cut + +sub prepare_access_token { + my ($self) = @_; + + if (defined(my $auth = $self->get_access_token)) { + return "Bearer $auth"; + } + + return; +} + +sub _auth_lwp_header { + my ($self) = @_; + + my %lwp_header; + if (defined $self->get_access_token) { + $lwp_header{'Authorization'} = $self->prepare_access_token; + } + + return %lwp_header; +} + +sub _warn_reponse_error { + my ($resp, $url) = @_; + warn sprintf("[%s] Error occurred on URL: %s\n", $resp->status_line, $url =~ s/([&?])key=(.*?)&/${1}key=[...]&/r); +} + +=head2 lwp_get($url, %opt) + +Get and return the content for $url. + +Where %opt can be: + + simple => [bool] + +When the value of B is set to a true value, the +authentication header will not be set in the HTTP request. + +=cut + +sub lwp_get { + my ($self, $url, %opt) = @_; + + $url // return; + $self->{lwp} // $self->set_lwp_useragent(); + + my %lwp_header = ($opt{simple} ? () : $self->_auth_lwp_header); + my $response = $self->{lwp}->get($url, %lwp_header); + + if ($response->is_success) { + return $response->decoded_content; + } + + if ($response->status_line() =~ /^401 / and defined($self->get_refresh_token)) { + if (defined(my $refresh_token = $self->oauth_refresh_token())) { + if (defined $refresh_token->{access_token}) { + + $self->set_access_token($refresh_token->{access_token}); + + # Don't be tempted to use recursion here, because bad things will happen! + $response = $self->{lwp}->get($url, $self->_auth_lwp_header); + + if ($response->is_success) { + $self->save_authentication_tokens(); + return $response->decoded_content; + } + elsif ($response->status_line() =~ /^401 /) { + $self->set_refresh_token(); # refresh token was invalid + $self->set_access_token(); # access token is also broken + warn "[!] Can't refresh the access token! Logging out...\n"; + } + } + else { + warn "[!] Can't get the access_token! Logging out...\n"; + $self->set_refresh_token(); + $self->set_access_token(); + } + } + else { + warn "[!] Invalid refresh_token! Logging out...\n"; + $self->set_refresh_token(); + $self->set_access_token(); + } + } + + $opt{depth} ||= 0; + + # Try again on 500+ HTTP errors + if ( $opt{depth} < 3 + and $response->code() >= 500 + and $response->status_line() =~ /(?:Temporary|Server) Error|Timeout|Service Unavailable/i) { + return $self->lwp_get($url, %opt, depth => $opt{depth} + 1); + } + + _warn_reponse_error($response, $url); + return; +} + +=head2 lwp_post($url, [@args]) + +Post and return the content for $url. + +=cut + +sub lwp_post { + my ($self, $url, @args) = @_; + + $self->{lwp} // $self->set_lwp_useragent(); + + my $response = $self->{lwp}->post($url, @args); + + if ($response->is_success) { + return $response->decoded_content; + } + else { + _warn_reponse_error($response, $url); + } + + return; +} + +=head2 lwp_mirror($url, $output_file) + +Downloads the $url into $output_file. Returns true on success. + +=cut + +sub lwp_mirror { + my ($self, $url, $output_file) = @_; + $self->{lwp} // $self->set_lwp_useragent(); + $self->{lwp}->mirror($url, $output_file); +} + +sub _get_results { + my ($self, $url, %opt) = @_; + + return + scalar { + url => $url, + results => $self->parse_json_string($self->lwp_get($url, %opt)), + }; +} + +=head2 list_to_url_arguments(\%options) + +Returns a valid string of arguments, with defined values. + +=cut + +sub list_to_url_arguments { + my ($self, %args) = @_; + join(q{&}, map { "$_=$args{$_}" } grep { defined $args{$_} } sort keys %args); +} + +sub _append_url_args { + my ($self, $url, %args) = @_; + %args + ? ($url . ($url =~ /\?/ ? '&' : '?') . $self->list_to_url_arguments(%args)) + : $url; +} + +sub get_api_url { + my ($self) = @_; + join('', $self->get_api_host, $self->get_api_path); +} + +sub _simple_feeds_url { + my ($self, $path, %args) = @_; + $self->get_api_url . $path . '?' . $self->list_to_url_arguments(key => $self->get_key, %args); +} + +=head2 default_arguments(%args) + +Merge the default arguments with %args and concatenate them together. + +=cut + +sub default_arguments { + my ($self, %args) = @_; + + my %defaults = ( + + #key => $self->get_key, + #part => 'snippet', + #prettyPrint => 'false', + #maxResults => $self->get_maxResults, + #regionCode => $self->get_regionCode, + %args, + ); + + $self->list_to_url_arguments(%defaults); +} + +sub _make_feed_url { + my ($self, $path, %args) = @_; + my $extra_args = $self->default_arguments(%args); + my $url = $self->get_api_url . $path; + + if ($extra_args) { + $url .= '?' . $extra_args; + } + + return $url; +} + +sub _extract_from_invidious { + my ($self, $videoID) = @_; + + my $url = sprintf("https://invidio.us/api/v1/videos/%s?fields=formatStreams,adaptiveFormats", $videoID); + + my $tries = 3; + my $resp = $self->{lwp}->get($url); + + while (not $resp->is_success() and $resp->status_line() =~ /read timeout/i and --$tries >= 0) { + $resp = $self->{lwp}->get($url); + } + + $resp->is_success() || return; + + my $json = $resp->decoded_content() // return; + my $ref = $self->parse_json_string($json) // return; + + my @formats; + + # The entries are already in the format that we want. + if (exists($ref->{adaptiveFormats}) and ref($ref->{adaptiveFormats}) eq 'ARRAY') { + push @formats, @{$ref->{adaptiveFormats}}; + } + + if (exists($ref->{formatStreams}) and ref($ref->{formatStreams}) eq 'ARRAY') { + push @formats, @{$ref->{formatStreams}}; + } + + return @formats; +} + +sub _ytdl_is_available { + (state $x = system('youtube-dl', '--version')) == 0; +} + +sub _extract_from_ytdl { + my ($self, $videoID) = @_; + + $self->_ytdl_is_available() || return; + + my $json = $self->proxy_stdout('youtube-dl', '--all-formats', '--dump-single-json', + quotemeta("https://www.youtube.com/watch?v=" . $videoID)); + + my $ref = $self->parse_json_string($json); + + my @formats; + if (ref($ref) eq 'HASH' and exists($ref->{formats}) and ref($ref->{formats}) eq 'ARRAY') { + foreach my $format (@{$ref->{formats}}) { + if (exists($format->{format_id}) and exists($format->{url})) { + + my $entry = { + itag => $format->{format_id}, + url => $format->{url}, + type => ((($format->{format} // '') =~ /audio only/i) ? 'audio/' : 'video/') . $format->{ext}, + }; + + push @formats, $entry; + } + } + } + + return @formats; +} + +sub _fallback_extract_urls { + my ($self, $videoID) = @_; + + my @formats; + + if ($self->_ytdl_is_available) { + if ($self->get_debug) { + say STDERR ":: Using youtube-dl to extract the streaming URLs..."; + } + + push @formats, $self->_extract_from_ytdl($videoID); + + if ($self->get_debug) { + my $count = scalar(@formats); + say STDERR ":: Found $count streaming URLs..."; + } + + return @formats; + } + + # Use the API of invidio.us + if ($self->get_debug) { + say STDERR ":: Using invidio.us to extract the streaming URLs..."; + } + + push @formats, $self->_extract_from_invidious($videoID); + + if ($self->get_debug) { + say STDERR ":: Found ", scalar(@formats), " streaming URLs."; + } + + return @formats; +} + +=head2 parse_query_string($string, multi => [0,1]) + +Parse a query string and return a data structure back. + +When the B option is set to a true value, the function will store multiple values for a given key. + +Returns back a list of key-value pairs. + +=cut + +sub parse_query_string { + my ($self, $str, %opt) = @_; + + if (not defined($str)) { + return; + } + + require URI::Escape; + + my @pairs; + foreach my $statement (split(/,/, $str)) { + foreach my $pair (split(/&/, $statement)) { + push @pairs, $pair; + } + } + + my %result; + + foreach my $pair (@pairs) { + my ($key, $value) = split(/=/, $pair, 2); + + if (not defined($value) or $value eq '') { + next; + } + + $value = URI::Escape::uri_unescape($value =~ tr/+/ /r); + + if ($opt{multi}) { + push @{$result{$key}}, $value; + } + else { + $result{$key} = $value; + } + } + + return %result; +} + +sub _group_keys_with_values { + my ($self, %data) = @_; + + my @hashes; + + foreach my $key (keys %data) { + foreach my $i (0 .. $#{$data{$key}}) { + $hashes[$i]{$key} = $data{$key}[$i]; + } + } + + return @hashes; +} + +sub _old_extract_streaming_urls { + my ($self, $info, $videoID) = @_; + + if ($self->get_debug) { + say STDERR ":: Using `url_encoded_fmt_stream_map` to extract the streaming URLs..."; + } + + my %stream_map = $self->parse_query_string($info->{url_encoded_fmt_stream_map}, multi => 1); + my %adaptive_fmts = $self->parse_query_string($info->{adaptive_fmts}, multi => 1); + + if ($self->get_debug >= 2) { + require Data::Dump; + Data::Dump::pp(\%stream_map); + Data::Dump::pp(\%adaptive_fmts); + } + + my @results; + + push @results, $self->_group_keys_with_values(%stream_map); + push @results, $self->_group_keys_with_values(%adaptive_fmts); + + foreach my $video (@results) { + if (exists $video->{s}) { # has an encrypted signature :( + + if ($self->get_debug) { + say STDERR ":: Detected an encrypted signature..."; + } + + my @formats = $self->_fallback_extract_urls($videoID); + + foreach my $format (@formats) { + foreach my $ref (@results) { + if (defined($ref->{itag}) and ($ref->{itag} eq $format->{itag})) { + $ref->{url} = $format->{url}; + last; + } + } + } + + last; + } + } + + if ($info->{livestream} or $info->{live_playback}) { + + if ($self->get_debug) { + say STDERR ":: Live stream detected..."; + } + + if (my @formats = $self->_fallback_extract_urls($videoID)) { + @results = @formats; + } + elsif (exists $info->{hlsvp}) { + push @results, + { + itag => 38, + type => 'video/ts', + url => $info->{hlsvp}, + }; + } + } + + if ($self->get_debug) { + my $count = scalar(@results); + say STDERR ":: Found $count streaming URLs..."; + } + + return @results; +} + +sub _extract_streaming_urls { + my ($self, $info, $videoID) = @_; + + if (exists $info->{url_encoded_fmt_stream_map}) { + return $self->_old_extract_streaming_urls($info, $videoID); + } + + if ($self->get_debug) { + say STDERR ":: Using `player_response` to extract the streaming URLs..."; + } + + my $json = $self->parse_json_string($info->{player_response} // return); + + if ($self->get_debug >= 2) { + require Data::Dump; + Data::Dump::pp($json); + } + + ref($json) eq 'HASH' or return; + + my @results; + if (exists $json->{streamingData}) { + + my $streamingData = $json->{streamingData}; + + if (exists $streamingData->{adaptiveFormats}) { + push @results, @{$streamingData->{adaptiveFormats}}; + } + + if (exists $streamingData->{formats}) { + push @results, @{$streamingData->{formats}}; + } + } + + foreach my $item (@results) { + + if (exists $item->{cipher} and not exists $item->{url}) { + + my %data = $self->parse_query_string($item->{cipher}); + + $item->{url} = $data{url} if defined($data{url}); + + if (defined($data{s})) { # unclear how this can be decrypted... + require URI::Escape; + my $sig = $data{s}; + $sig = URI::Escape::uri_escape($sig); + $item->{url} .= "&sig=$sig"; + } + } + + if (exists $item->{mimeType}) { + $item->{type} = $item->{mimeType}; + } + } + + # Cipher streaming URLs are currently unsupported, so let's filter them out. + @results = grep { not exists $_->{cipher} } @results; + + # Keep only streams with contentLength > 0. + @results = grep { exists($_->{contentLength}) and $_->{contentLength} > 0 } @results; + + # Detect livestream + if (!@results and exists($json->{streamingData}) and exists($json->{streamingData}{hlsManifestUrl})) { + + if ($self->get_debug) { + say STDERR ":: Live stream detected..."; + } + + @results = $self->_fallback_extract_urls($videoID); + + if (!@results) { + push @results, + { + itag => 38, + type => "video/ts", + url => $json->{streamingData}{hlsManifestUrl}, + }; + } + } + + if ($self->get_debug) { + my $count = scalar(@results); + say STDERR ":: Found $count streaming URLs..."; + } + + return @results; +} + +sub _get_video_info { + my ($self, $videoID) = @_; + + my $url = $self->get_video_info_url() . sprintf($self->get_video_info_args(), $videoID); + my $content = $self->lwp_get($url, simple => 1) // return; + my %info = $self->parse_query_string($content); + + return %info; +} + +=head2 get_streaming_urls($videoID) + +Returns a list of streaming URLs for a videoID. +({itag=>..., url=>...}, {itag=>..., url=>....}, ...) + +=cut + +sub get_streaming_urls { + my ($self, $videoID) = @_; + + my %info = $self->_get_video_info($videoID); + my @streaming_urls = $self->_extract_streaming_urls(\%info, $videoID); + + my @caption_urls; + if (exists $info{player_response}) { + + require URI::Escape; + my $captions_json = URI::Escape::uri_unescape($info{player_response}); + my $caption_data = $self->parse_json_string($captions_json); + + if (eval { ref($caption_data->{captions}{playerCaptionsTracklistRenderer}{captionTracks}) eq 'ARRAY' }) { + push @caption_urls, @{$caption_data->{captions}{playerCaptionsTracklistRenderer}{captionTracks}}; + } + } + + # Try again with youtube-dl + if (!@streaming_urls or $info{status} =~ /fail|error/i) { + @streaming_urls = $self->_fallback_extract_urls($videoID); + } + + if ($self->get_prefer_mp4 or $self->get_prefer_av1) { + + my @video_urls; + my @audio_urls; + + require WWW::FairViewer::Itags; + + my %audio_itags; + @audio_itags{@{WWW::FairViewer::Itags->get_itags->{audio}}} = (); + + foreach my $url (@streaming_urls) { + + if (exists($audio_itags{$url->{itag}})) { + push @audio_urls, $url; + next; + } + + if ($url->{type} =~ /\bvideo\b/i) { + if ($self->get_prefer_mp4 and $url->{type} =~ /\bmp4\b/i) { + push @video_urls, $url; + } + elsif ($self->get_prefer_av1 and $url->{type} =~ /\bav[0-9]+\b/i) { + push @video_urls, $url; + } + } + else { + push @audio_urls, $url; + } + } + + if (@video_urls) { + @streaming_urls = (@video_urls, @audio_urls); + } + } + + # Filter out streams with `clen = 0`. + @streaming_urls = grep { defined($_->{clen}) ? ($_->{clen} > 0) : 1 } @streaming_urls; + + # Return the YouTube URL when there are no streaming URLs + if (!@streaming_urls) { + push @streaming_urls, + { + itag => 38, + type => "video/mp4", + url => "https://www.youtube.com/watch?v=$videoID", + }; + } + + if ($self->get_debug >= 2) { + require Data::Dump; + Data::Dump::pp(\%info) if ($self->get_debug >= 3); + Data::Dump::pp(\@streaming_urls); + Data::Dump::pp(\@caption_urls); + } + + return (\@streaming_urls, \@caption_urls, \%info); +} + +sub _request { + my ($self, $req) = @_; + + $self->{lwp} // $self->set_lwp_useragent(); + + my $res = $self->{lwp}->request($req); + + if ($res->is_success) { + return $res->decoded_content; + } + else { + warn 'Request error: ' . $res->status_line(); + } + + return; +} + +sub _prepare_request { + my ($self, $req, $length) = @_; + + $req->header('Content-Length' => $length) if ($length); + + if (defined $self->get_access_token) { + $req->header('Authorization' => $self->prepare_access_token); + } + + return 1; +} + +sub _save { + my ($self, $method, $uri, $content) = @_; + + require HTTP::Request; + my $req = HTTP::Request->new($method => $uri); + $req->content_type('application/json; charset=UTF-8'); + $self->_prepare_request($req, length($content)); + $req->content($content); + + $self->_request($req); +} + +sub post_as_json { + my ($self, $url, $ref) = @_; + my $json_str = $self->make_json_string($ref); + $self->_save('POST', $url, $json_str); +} + +sub next_page_with_token { + my ($self, $url, $token) = @_; + + my $pt_url = ( + $url =~ s{[?&]continuation=\K([^&]+)}{$token} + ? $url + : $self->_append_url_args($url, continuation => $token) + ); + + my $res = $self->_get_results($pt_url); + $res->{url} = $pt_url; + return $res; +} + +sub next_page { + my ($self, $url) = @_; + + my $pt_url = ( + $url =~ s{[?&]page=\K(\d+)}{$1+1}e + ? $url + : $self->_append_url_args($url, page => 2) + ); + + my $res = $self->_get_results($pt_url); + $res->{url} = $pt_url; + return $res; +} + +sub previous_page { + my ($self, $url) = @_; + + my $pt_url = ( + $url =~ s{[?&]page=\K(\d+)}{($1 > 2) ? ($1-1) : 1}e + ? $url + : $url + ); + + my $res = $self->_get_results($pt_url); + $res->{url} = $pt_url; + return $res; +} + +# SUBROUTINE FACTORY +{ + no strict 'refs'; + + # Create proxy_{exec,system} subroutines + foreach my $name ('exec', 'system', 'stdout') { + *{__PACKAGE__ . '::proxy_' . $name} = sub { + my ($self, @args) = @_; + + $self->{lwp} // $self->set_lwp_useragent(); + + local $ENV{http_proxy} = $self->{lwp}->proxy('http'); + local $ENV{https_proxy} = $self->{lwp}->proxy('https'); + + local $ENV{HTTP_PROXY} = $self->{lwp}->proxy('http'); + local $ENV{HTTPS_PROXY} = $self->{lwp}->proxy('https'); + + $name eq 'exec' ? exec(@args) + : $name eq 'system' ? system(@args) + : $name eq 'stdout' ? qx(@args) + : (); + }; + } +} + +=head1 AUTHOR + +Trizen, C<< >> + +=head1 SEE ALSO + +https://developers.google.com/youtube/v3/docs/ + +=head1 LICENSE AND COPYRIGHT + +Copyright 2012-2015 Trizen. + +This program is free software; you can redistribute it and/or modify it +under the terms of the the Artistic License (2.0). You may obtain a +copy of the full license at: + +L + +Any use, modification, and distribution of the Standard or Modified +Versions is governed by this Artistic License. By using, modifying or +distributing the Package, you accept this license. Do not use, modify, +or distribute the Package, if you do not accept this license. + +If your Modified Version has been derived from a Modified Version made +by someone other than you, you are nevertheless required to ensure that +your Modified Version complies with the requirements of this license. + +This license does not grant you the right to use any trademark, service +mark, tradename, or logo of the Copyright Holder. + +This license includes the non-exclusive, worldwide, free-of-charge +patent license to make, have made, use, offer to sell, sell, import and +otherwise transfer the Package with respect to any patent claims +licensable by the Copyright Holder that are necessarily infringed by the +Package. If you institute patent litigation (including a cross-claim or +counterclaim) against any party alleging that the Package constitutes +direct or contributory patent infringement, then this Artistic License +to you shall terminate on the date that such litigation is filed. + +Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER +AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. +THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR +PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY +YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR +CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR +CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, +EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + + +=cut + +1; # End of WWW::FairViewer + +__END__ diff --git a/lib/WWW/FairViewer/Activities.pm b/lib/WWW/FairViewer/Activities.pm new file mode 100644 index 0000000..7c80df0 --- /dev/null +++ b/lib/WWW/FairViewer/Activities.pm @@ -0,0 +1,93 @@ +package WWW::FairViewer::Activities; + +use utf8; +use 5.014; +use warnings; + +=head1 NAME + +WWW::FairViewer::Activities - list of channel activity events that match the request criteria. + +=head1 SYNOPSIS + + use WWW::FairViewer; + my $obj = WWW::FairViewer->new(%opts); + my $activities = $obj->activities($channel_id); + +=head1 SUBROUTINES/METHODS + +=cut + +sub _make_activities_url { + my ($self, %opts) = @_; + $self->_make_feed_url('activities', part => 'snippet,contentDetails', %opts); +} + +=head2 activities($channel_id) + +Get activities for channel ID. + +=cut + +sub activities { + my ($self, $channel_id) = @_; + + if ($channel_id eq 'mine') { + return $self->my_activities; + } + + if ($channel_id !~ /^UC/) { + $channel_id = $self->channel_id_from_username($channel_id) // $channel_id; + } + + $self->_get_results($self->_make_activities_url(channelId => $channel_id)); +} + +=head2 activities_from_username($username) + +Get activities for username. + +=cut + +sub activities_from_username { + my ($self, $username) = @_; + return $self->activities($username); +} + +=head2 my_activities() + +Get authenticated user's activities. + +=cut + +sub my_activities { + my ($self) = @_; + $self->get_access_token() // return; + $self->_get_results($self->_make_activities_url(mine => 'true')); +} + +=head1 AUTHOR + +Trizen, C<< >> + + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc WWW::FairViewer::Activities + + +=head1 LICENSE AND COPYRIGHT + +Copyright 2013-2015 Trizen. + +This program is free software; you can redistribute it and/or modify it +under the terms of either: the GNU General Public License as published +by the Free Software Foundation; or the Artistic License. + +See L for more information. + +=cut + +1; # End of WWW::FairViewer::Activities diff --git a/lib/WWW/FairViewer/Authentication.pm b/lib/WWW/FairViewer/Authentication.pm new file mode 100644 index 0000000..4994f27 --- /dev/null +++ b/lib/WWW/FairViewer/Authentication.pm @@ -0,0 +1,216 @@ +package WWW::FairViewer::Authentication; + +use utf8; +use 5.014; +use warnings; + +=head1 NAME + +WWW::FairViewer::Authentication - OAuth login support. + +=head1 SYNOPSIS + + use WWW::FairViewer; + my $hash_ref = WWW::FairViewer->oauth_login($code); + +=head1 SUBROUTINES/METHODS + +=cut + +sub _get_token_oauth_url { + my ($self) = @_; + return $self->get_oauth_url() . 'token'; +} + +=head2 oauth_refresh_token() + +Refresh the access_token using the refresh_token. Returns a HASH ref with the `access_token` or undef. + +=cut + +sub oauth_refresh_token { + my ($self) = @_; + + my $json_data = $self->lwp_post( + $self->_get_token_oauth_url(), + [Content => $self->get_www_content_type, + client_id => $self->get_client_id() // return, + client_secret => $self->get_client_secret() // return, + refresh_token => $self->get_refresh_token() // return, + grant_type => 'refresh_token', + ] + ); + + return $self->parse_json_string($json_data); +} + +=head2 get_accounts_oauth_url() + +Creates an OAuth URL with the 'code' response type. (Google's authorization server) + +=cut + +sub get_accounts_oauth_url { + my ($self) = @_; + + my $url = $self->_append_url_args( + ($self->get_oauth_url() . 'auth'), + response_type => 'code', + client_id => $self->get_client_id() // return, + redirect_uri => $self->get_redirect_uri() // return, + scope => 'https://www.googleapis.com/auth/youtube.force-ssl', + access_type => 'offline', + ); + return $url; +} + +=head2 oauth_login($code) + +Returns a HASH ref with the access_token, refresh_token and some other info. + +The $code can be obtained by going to the URL returned by the C method. + +=cut + +sub oauth_login { + my ($self, $code) = @_; + + length($code) < 20 and return; + + my $json_data = $self->lwp_post( + $self->_get_token_oauth_url(), + [Content => $self->get_www_content_type, + client_id => $self->get_client_id() // return, + client_secret => $self->get_client_secret() // return, + redirect_uri => $self->get_redirect_uri() // return, + grant_type => 'authorization_code', + code => $code, + ] + ); + + return $self->parse_json_string($json_data); +} + +sub __AUTH_EOL__() { "\0\0\0" } + +=head2 load_authentication_tokens() + +Will try to load the access and refresh tokens from I. + +=cut + +sub load_authentication_tokens { + my ($self) = @_; + + if (defined $self->get_access_token and defined $self->get_refresh_token) { + return 1; + } + + my $file = $self->get_authentication_file() // return; + my $key = $self->get_key() // return; + + if (-f $file) { + local $/ = __AUTH_EOL__; + open my $fh, '<:raw', $file or return; + + my @tokens; + foreach my $i (0 .. 1) { + chomp(my $token = <$fh>); + $token =~ /\S/ || last; + push @tokens, $self->decode_token($token); + } + + $self->set_access_token($tokens[0]) // return; + $self->set_refresh_token($tokens[1]) // return; + + close $fh; + return 1; + } + + return; +} + +=head2 encode_token($token) + +Encode the token with the I and return it. + +=cut + +sub encode_token { + my ($self, $token) = @_; + + if (defined(my $key = $self->get_key)) { + require MIME::Base64; + return MIME::Base64::encode_base64($token ^ substr($key, -length($token))); + } + + return; +} + +=head2 decode_token($token) + +Decode the token with the I and return it. + +=cut + +sub decode_token { + my ($self, $token) = @_; + + if (defined(my $key = $self->get_key)) { + require MIME::Base64; + my $bin = MIME::Base64::decode_base64($token); + return $bin ^ substr($key, -length($bin)); + } + + return; +} + +=head2 save_authentication_tokens() + +Encode and save the access and refresh into the I. + +=cut + +sub save_authentication_tokens { + my ($self) = @_; + + my $file = $self->get_authentication_file() // return; + my $access_token = $self->get_access_token() // return; + my $refresh_token = $self->get_refresh_token() // return; + + if (open my $fh, '>:raw', $file) { + foreach my $token ($access_token, $refresh_token) { + print {$fh} $self->encode_token($token) . __AUTH_EOL__; + } + close $fh; + return 1; + } + + return; +} + +=head1 AUTHOR + +Trizen, C<< >> + + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc WWW::FairViewer::Authentication + + +=head1 LICENSE AND COPYRIGHT + +Copyright 2013-2015 Trizen. + +This program is free software; you can redistribute it and/or modify it +under the terms of either: the GNU General Public License as published +by the Free Software Foundation; or the Artistic License. + +See L for more information. + +=cut + +1; # End of WWW::FairViewer::Authentication diff --git a/lib/WWW/FairViewer/Channels.pm b/lib/WWW/FairViewer/Channels.pm new file mode 100644 index 0000000..d6c8d49 --- /dev/null +++ b/lib/WWW/FairViewer/Channels.pm @@ -0,0 +1,200 @@ +package WWW::FairViewer::Channels; + +use utf8; +use 5.014; +use warnings; + +=head1 NAME + +WWW::FairViewer::Channels - Channels interface. + +=head1 SYNOPSIS + + use WWW::FairViewer; + my $obj = WWW::FairViewer->new(%opts); + my $videos = $obj->channels_from_categoryID($category_id); + +=head1 SUBROUTINES/METHODS + +=cut + +sub _make_channels_url { + my ($self, %opts) = @_; + return $self->_make_feed_url('channels', %opts); +} + +sub videos_from_channel_id { + my ($self, $channel_id) = @_; + return $self->_get_results($self->_make_feed_url("channels/$channel_id/videos")); +} + +sub videos_from_username { + my ($self, $channel_id) = @_; + return $self->_get_results($self->_make_feed_url("channels/$channel_id/videos")); +} + +=head2 channels_from_categoryID($category_id) + +Return the YouTube channels associated with the specified category. + +=head2 channels_info($channel_id) + +Return information for the comma-separated list of the YouTube channel ID(s). + +=head1 Channel details + +For all functions, C<$channels->{results}{items}> contains: + +=cut + +{ + no strict 'refs'; + + foreach my $method ( + { + key => 'categoryId', + name => 'channels_from_guide_category', + }, + { + key => 'id', + name => 'channels_info', + }, + { + key => 'forUsername', + name => 'channels_from_username', + }, + ) { + *{__PACKAGE__ . '::' . $method->{name}} = sub { + my ($self, $channel_id) = @_; + return $self->_get_results($self->_make_channels_url($method->{key} => $channel_id)); + }; + } + + foreach my $part (qw(id contentDetails statistics topicDetails)) { + *{__PACKAGE__ . '::' . 'channels_' . $part} = sub { + my ($self, $id) = @_; + return $self->_get_results($self->_make_channels_url(id => $id, part => $part)); + }; + } +} + +=head2 my_channel() + +Returns info about the channel of the current authenticated user. + +=cut + +sub my_channel { + my ($self) = @_; + $self->get_access_token() // return; + return $self->_get_results($self->_make_channels_url(part => 'snippet', mine => 'true')); +} + +=head2 my_channel_id() + +Returns the channel ID of the current authenticated user. + +=cut + +sub my_channel_id { + my ($self) = @_; + + state $cache = {}; + + if (exists $cache->{id}) { + return $cache->{id}; + } + + $cache->{id} = undef; + my $channel = $self->my_channel() // return; + $cache->{id} = $channel->{results}{items}[0]{id} // return; +} + +=head2 channels_my_subscribers() + +Retrieve a list of channels that subscribed to the authenticated user's channel. + +=cut + +sub channels_my_subscribers { + my ($self) = @_; + $self->get_access_token() // return; + return $self->_get_results($self->_make_channels_url(mySubscribers => 'true')); +} + +=head2 channel_id_from_username($username) + +Return the channel ID for an username. + +=cut + +sub channel_id_from_username { + my ($self, $username) = @_; + + state $username_lookup = {}; + + if (exists $username_lookup->{$username}) { + return $username_lookup->{$username}; + } + + $username_lookup->{$username} = undef; + my $channel = $self->channels_from_username($username) // return; + $username_lookup->{$username} = $channel->{results}{items}[0]{id} // return; +} + +=head2 channel_title_from_id($channel_id) + +Return the channel title for a given channel ID. + +=cut + +sub channel_title_from_id { + my ($self, $channel_id) = @_; + + if ($channel_id eq 'mine') { + $channel_id = $self->my_channel_id(); + } + + my $info = $self->channels_info($channel_id // return) // return; + + ( ref($info) eq 'HASH' + and ref($info->{results}) eq 'HASH' + and ref($info->{results}{items}) eq 'ARRAY' + and ref($info->{results}{items}[0]) eq 'HASH') + ? $info->{results}{items}[0]{snippet}{title} + : (); +} + +=head2 channels_contentDetails($channelID) + +=head2 channels_statistics($channelID); + +=head2 channels_topicDetails($channelID) + +=cut + +=head1 AUTHOR + +Trizen, C<< >> + + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc WWW::FairViewer::Channels + + +=head1 LICENSE AND COPYRIGHT + +Copyright 2013-2015 Trizen. + +This program is free software; you can redistribute it and/or modify it +under the terms of either: the GNU General Public License as published +by the Free Software Foundation; or the Artistic License. + +See L for more information. + +=cut + +1; # End of WWW::FairViewer::Channels diff --git a/lib/WWW/FairViewer/CommentThreads.pm b/lib/WWW/FairViewer/CommentThreads.pm new file mode 100644 index 0000000..db8e3ea --- /dev/null +++ b/lib/WWW/FairViewer/CommentThreads.pm @@ -0,0 +1,98 @@ +package WWW::FairViewer::CommentThreads; + +use utf8; +use 5.014; +use warnings; + +=head1 NAME + +WWW::FairViewer::CommentThreads - Retrieve comments threads. + +=head1 SYNOPSIS + + use WWW::FairViewer; + my $obj = WWW::FairViewer->new(%opts); + my $videos = $obj->comments_from_video_id($video_id); + +=head1 SUBROUTINES/METHODS + +=cut + +sub _make_commentThreads_url { + my ($self, %opts) = @_; + return + $self->_make_feed_url( + 'commentThreads', + pageToken => $self->page_token, + %opts + ); +} + +=head2 comments_from_videoID($videoID) + +Retrieve comments from a video ID. + +=cut + +sub comments_from_video_id { + my ($self, $video_id) = @_; + $self->_get_results( + $self->_make_feed_url("comments/$video_id", + sort_by => $self->get_comments_order, + ), + ); +} + +=head2 comment_to_video_id($comment, $videoID) + +Send a comment to a video ID. + +=cut + +sub comment_to_video_id { + my ($self, $comment, $video_id) = @_; + + my $url = $self->_simple_feeds_url('commentThreads', part => 'snippet'); + + my $hash = { + "snippet" => { + + "topLevelComment" => { + "snippet" => { + "textOriginal" => $comment, + } + }, + "videoId" => $video_id, + + #"channelId" => $channel_id, + }, + }; + + $self->post_as_json($url, $hash); +} + +=head1 AUTHOR + +Trizen, C<< >> + + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc WWW::FairViewer::CommentThreads + + +=head1 LICENSE AND COPYRIGHT + +Copyright 2015-2016 Trizen. + +This program is free software; you can redistribute it and/or modify it +under the terms of either: the GNU General Public License as published +by the Free Software Foundation; or the Artistic License. + +See L for more information. + +=cut + +1; # End of WWW::FairViewer::CommentThreads diff --git a/lib/WWW/FairViewer/GetCaption.pm b/lib/WWW/FairViewer/GetCaption.pm new file mode 100644 index 0000000..24741b1 --- /dev/null +++ b/lib/WWW/FairViewer/GetCaption.pm @@ -0,0 +1,280 @@ +package WWW::FairViewer::GetCaption; + +use utf8; +use 5.014; +use warnings; + +=head1 NAME + +WWW::FairViewer::GetCaption - Save the YouTube closed captions as .srt files for a videoID. + +=head1 SYNOPSIS + + use WWW::FairViewer::GetCaption; + + my $yv_cap = WWW::FairViewer::GetCaption->new(%opts); + + print $yv_cap->get_caption($videoID); + +=head1 SUBROUTINES/METHODS + +=head2 new(%opts) + +Options: + +=over 4 + +=item captions => [] + +The captions data. + +=item captions_dir => "." + +Where to save the closed captions. + +=item languages => [qw(en es ro jp)] + +Preferred languages. First found is saved and returned. + +=back + +=cut + +sub new { + my ($class, %opts) = @_; + + my $self = bless {}, $class; + $self->{captions_dir} = undef; + $self->{captions} = []; + $self->{auto_captions} = 0; + $self->{languages} = [qw(en es)]; + + foreach my $key (keys %{$self}) { + $self->{$key} = delete $opts{$key} + if exists $opts{$key}; + } + + foreach my $invalid_key (keys %opts) { + warn "Invalid key: '${invalid_key}'"; + } + + return $self; +} + +=head2 find_caption_data() + +Find a caption data, based on the preferred languages. + +=cut + +sub find_caption_data { + my ($self) = @_; + + my @found; + foreach my $caption (@{$self->{captions}}) { + if (defined $caption->{languageCode}) { + foreach my $i (0 .. $#{$self->{languages}}) { + my $lang = $self->{languages}[$i]; + if ($caption->{languageCode} =~ /^\Q$lang\E(?:\z|[_-])/i) { + + # Automatic Speech Recognition + my $auto = defined($caption->{kind}) && lc($caption->{kind}) eq 'asr'; + + # Check against auto-generated captions + if ($auto and not $self->{auto_captions}) { + next; + } + + # Fuzzy match or auto-generated caption + if (lc($caption->{languageCode}) ne lc($lang) or $auto) { + $found[$i + (($auto ? 2 : 1) * scalar(@{$self->{languages}}))] = $caption; + } + + # Perfect match + else { + $i == 0 and return $caption; + $found[$i] = $caption; + } + } + } + } + } + + foreach my $caption (@found) { + return $caption if defined($caption); + } + + return; +} + +=head2 sec2time(@seconds) + +Convert a list of seconds to .srt times. + +=cut + +sub sec2time { + my $self = shift; + + my @out; + foreach my $sec (map { sprintf '%.3f', $_ } @_) { + push @out, + sprintf('%02d:%02d:%02d,%03d', ($sec / 3600 % 24, $sec / 60 % 60, $sec % 60, substr($sec, index($sec, '.') + 1))); + } + + return @out; +} + +=head2 xml2srt($xml_string) + +Convert the XML data to SubRip format. + +=cut + +sub xml2srt { + my ($self, $xml) = @_; + + require WWW::FairViewer::ParseXML; + my $hash = eval { WWW::FairViewer::ParseXML::xml2hash($xml) } // return; + + my $sections; + if ( exists $hash->{transcript} + and ref($hash->{transcript}) eq 'ARRAY' + and ref($hash->{transcript}[0]) eq 'HASH' + and exists $hash->{transcript}[0]{text}) { + $sections = $hash->{transcript}[0]{text}; + } + else { + return; + } + + require HTML::Entities; + + my @text; + foreach my $i (0 .. $#{$sections}) { + my $line = $sections->[$i]; + + if (not defined($line->{'-dur'})) { + if (exists $sections->[$i + 1]) { + $line->{'-dur'} = $sections->[$i + 1]{'-start'} - $line->{'-start'}; + } + else { + $line->{'-dur'} = 10; + } + } + + my $start = $line->{'-start'}; + my $end = $start + $line->{'-dur'}; + + push @text, + join("\n", + $i + 1, + join(' --> ', $self->sec2time($start, $end)), + HTML::Entities::decode_entities($line->{'#text'} // '')); + } + + return join("\n\n", @text); +} + +=head2 get_xml_data($caption_data) + +Get the XML content for a given caption data. + +=cut + +sub get_xml_data { + my ($self, $url) = @_; + + state $lwp = do { + + require LWP::UserAgent; + + my $agent = LWP::UserAgent->new( + timeout => 30, + env_proxy => 1, + agent => + 'Mozilla/5.0 (X11; Linux x86_64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/41.0.2272.101 Safari/537.36', + ); + + require LWP::ConnCache; + state $cache = LWP::ConnCache->new; + $cache->total_capacity(undef); # no limit + + state $accepted_encodings = do { + require HTTP::Message; + HTTP::Message::decodable(); + }; + + $agent->ssl_opts(Timeout => 30); + $agent->default_header('Accept-Encoding' => $accepted_encodings); + $agent->conn_cache($cache); + + $agent; + }; + + my $req = $lwp->get($url); + + if ($req->is_success) { + return $req->decoded_content; + } + + return; +} + +=head2 save_caption($video_ID) + +Save the caption in a .srt file and return its file path. + +=cut + +sub save_caption { + my ($self, $video_id) = @_; + + # Find one of the preferred languages + my $info = $self->find_caption_data() // return; + + require File::Spec; + my $filename = "${video_id}_$info->{languageCode}.srt"; + my $srt_file = File::Spec->catfile($self->{captions_dir} // File::Spec->tmpdir, $filename); + + # Return the srt file if it already exists + return $srt_file if (-e $srt_file); + + # Get XML data, then transform it to SubRip data + my $xml = $self->get_xml_data($info->{baseUrl} // return) // return; + my $srt = $self->xml2srt($xml) // return; + + # Write the SubRib data to the $srt_file + open(my $fh, '>:utf8', $srt_file) or return; + print {$fh} $srt, "\n"; + close $fh; + + # Return the .srt file path + return $srt_file; +} + +=head1 AUTHOR + +Trizen, C<< >> + + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc WWW::FairViewer::GetCaption + + +=head1 LICENSE AND COPYRIGHT + +Copyright 2012-2015 Trizen. + +This program is free software; you can redistribute it and/or modify it +under the terms of either: the GNU General Public License as published +by the Free Software Foundation; or the Artistic License. + +See L for more information. + +=cut + +1; # End of WWW::FairViewer::GetCaption diff --git a/lib/WWW/FairViewer/GuideCategories.pm b/lib/WWW/FairViewer/GuideCategories.pm new file mode 100644 index 0000000..a65670c --- /dev/null +++ b/lib/WWW/FairViewer/GuideCategories.pm @@ -0,0 +1,85 @@ +package WWW::FairViewer::GuideCategories; + +use utf8; +use 5.014; +use warnings; + +=head1 NAME + +WWW::FairViewer::GuideCategories - Categories interface. + +=head1 SYNOPSIS + + use WWW::FairViewer; + my $obj = WWW::FairViewer->new(%opts); + my $videos = $obj->youtube_categories('US'); + +=head1 SUBROUTINES/METHODS + +=cut + +sub _make_guideCategories_url { + my ($self, %opts) = @_; + + if (not exists $opts{id}) { + $opts{regionCode} //= $self->get_regionCode; + } + + $self->_make_feed_url('guideCategories', hl => $self->get_hl, %opts); +} + +=head2 guide_categories(;$region_id) + +Return guide categories for a specific region ID. + +=head2 guide_categories_info($category_id) + +Return info for a list of comma-separated category IDs. + +=cut + +{ + no strict 'refs'; + + foreach my $method ( + { + key => 'id', + name => 'guide_categories_info', + }, + { + key => 'regionCode', + name => 'guide_categories', + }, + ) { + *{__PACKAGE__ . '::' . $method->{name}} = sub { + my ($self, $id) = @_; + return $self->_get_results($self->_make_guideCategories_url($method->{key} => $id // return)); + }; + } +} + +=head1 AUTHOR + +Trizen, C<< >> + + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc WWW::FairViewer::GuideCategories + + +=head1 LICENSE AND COPYRIGHT + +Copyright 2013-2015 Trizen. + +This program is free software; you can redistribute it and/or modify it +under the terms of either: the GNU General Public License as published +by the Free Software Foundation; or the Artistic License. + +See L for more information. + +=cut + +1; # End of WWW::FairViewer::GuideCategories diff --git a/lib/WWW/FairViewer/Itags.pm b/lib/WWW/FairViewer/Itags.pm new file mode 100644 index 0000000..3a3f007 --- /dev/null +++ b/lib/WWW/FairViewer/Itags.pm @@ -0,0 +1,319 @@ +package WWW::FairViewer::Itags; + +use utf8; +use 5.014; +use warnings; + +=head1 NAME + +WWW::FairViewer::Itags - Get the YouTube itags. + +=head1 SYNOPSIS + + use WWW::FairViewer::Itags; + + my $yv_itags = WWW::FairViewer::Itags->new(); + + my $itags = $yv_itags->get_itags(); + my $res = $yv_itags->get_resolutions(); + +=head1 SUBROUTINES/METHODS + +=head2 new() + +Return the blessed object. + +=cut + +sub new { + my ($class) = @_; + bless {}, $class; +} + +=head2 get_itags() + +Get a HASH ref with the YouTube itags. {resolution => [itags]}. + +Reference: http://en.wikipedia.org/wiki/YouTube#Quality_and_formats + +=cut + +sub get_itags { +#<<< + scalar { + 'best' => [ + 38, # mp4 (3072p) (v-a) + [138, # mp4 (2160p-4320p) (v) + 266, # mp4 (2160p-2304p) (v) + ], + ], + + '2160' => [ + [ + 315, # webm HFR (v) + 272, # webm (v) + 313, # webm (v) + 401, # av1 (v) + ], + ], + + '1440' => [ + [ + 308, # webm HFR (v) + 271, # webm (v) + 264, # mp4 (v) + 400, # av1 (v) + ], + ], + + '1080' => [ + [303, # webm HFR (v) + 299, # mp4 HFR (v) + ], + 46, # webm (v-a) + 37, # mp4 (v-a) + [248, # webm (v) + 137, # mp4 (v) + 399, # av1 (v) + ], + 301, # mp4 (live) (v-a) + 96, # ts (live) (v-a) + ], + + '720' => [ + [302, # webm HFR (v) + 298, # mp4 HFR (v) + ], + 45, # webm (v-a) + 22, # mp4 (v-a) + [247, # webm (v) + 136, # mp4 (v) + 398, # av1 (v) + ], + 300, # mp4 (live) (v-a) + 120, # flv (live) (v-a) + 95, # ts (live) (v-a) + ], + + '480' => [ + 44, # webm (v-a) + 35, # flv (v-a) + [244, # webm (v) + 135, # mp4 (v) + 397, # av1 (v) + ], + 94, # mp4 (live) (v-a) + ], + + '360' => [ + 43, # webm (v-a) + 34, # flv (v-a) + [243, # webm (v) + 134, # mp4 (v) + 396, # av1 (v) + ], + 93, # mp4 (live) (v-a) + 18, # mp4 (v-a) + ], + + '240' => [ + 6, # flv (270p) (v-a) + 5, # flv (v-a) + 36, # 3gp (v-a) + 13, # 3gp (v-a) + [242, # webm (v) + 133, # mp4 (v) + 395, # av1 (v) + ], + 92, # mp4 (live) (v-a) + 132, # ts (live) (v-a) + ], + + '144' => [ + 17, # 3gp (v-a) + [278, # webm (v) + 160, # mp4 (v) + 394, # av1 (v) + ], + 91, # mp4 (live) (v-a) + 151, # ts (live) (v-a) + ], + + 'audio' => [172, # webm (192 kbps) + 251, # webm opus (128-160 kbps) + 171, # webm vorbis (92-128 kbps) + 140, # mp4a (128 kbps) + 141, # mp4a (256 kbps) + 250, # webm opus (64 kbps) + 249, # webm opus (48 kbps) + 139, # mp4a (48 kbps) + ], + }; +#>>> +} + +=head2 get_resolutions() + +Get an ARRAY ref with the supported resolutions ordered from highest to lowest. + +=cut + +sub get_resolutions { + my ($self) = @_; + + state $itags = $self->get_itags(); + return [ + grep { exists $itags->{$_} } + qw( + best + 2160 + 1440 + 1080 + 720 + 480 + 360 + 240 + 144 + audio + ) + ]; +} + +sub _find_streaming_url { + my ($self, %args) = @_; + + my $stream = $args{stream} // return; + my $resolution = $args{resolution} // return; + + foreach my $itag (@{$args{itags}->{$resolution}}) { + + if (ref($itag) eq 'ARRAY') { + + $args{dash} || next; + + foreach my $i (@{$itag}) { + + next if not exists $stream->{$i}; + + my $video_info = $stream->{$i}; + my $audio_info = $self->_find_streaming_url(%args, resolution => 'audio', dash => 0); + + if (defined $audio_info) { + $video_info->{__AUDIO__} = $audio_info; + return $video_info; + } + } + + next; + } + + if (exists $stream->{$itag}) { + if ($resolution eq 'audio' and not $args{dash_mp4_audio}) { + if ($itag == 140 or $itag == 141 or $itag == 139) { + next; # skip mp4 audio URLs + } + } + + my $entry = $stream->{$itag}; + + # Ignore segmented DASH URLs (they load pretty slow in mpv) + if (not $args{dash_segmented}) { + next if ($entry->{url} =~ m{^https://manifest\.googlevideo\.com/api/manifest/dash/}); + } + + return $entry; + } + } + + return; +} + +=head2 find_streaming_url(%options) + +Return the streaming URL which corresponds with the specified resolution. + + ( + urls => \@streaming_urls, + resolution => 'resolution_name', # from $obj->get_resolutions(), + dash => 1/0, # include or exclude DASH itags + dash_mp4_audio => 1/0, # include or exclude DASH videos with MP4 audio + dash_segmented => 1/0, # include or exclude segmented DASH videos + ) + +=cut + +sub find_streaming_url { + my ($self, %args) = @_; + + my $urls_array = $args{urls}; + my $resolution = $args{resolution}; + + state $itags = $self->get_itags(); + + if (defined($resolution) and $resolution =~ /^([0-9]+)/) { + $resolution = $1; + } + + my %stream; + foreach my $info_ref (@{$urls_array}) { + if (exists $info_ref->{itag} and exists $info_ref->{url}) { + $stream{$info_ref->{itag}} = $info_ref; + } + } + + $args{stream} = \%stream; + $args{itags} = $itags; + $args{resolution} = $resolution; + + my ($streaming, $found_resolution); + + # Try to find the wanted resolution + if (defined($resolution) and exists $itags->{$resolution}) { + $streaming = $self->_find_streaming_url(%args); + $found_resolution = $resolution; + } + + # Otherwise, find the best resolution available + if (not defined $streaming) { + + state $resolutions = $self->get_resolutions(); + + foreach my $res (@{$resolutions}) { + + $streaming = $self->_find_streaming_url(%args, resolution => $res); + + if (defined($streaming)) { + $found_resolution = $res; + last; + } + } + } + + wantarray ? ($streaming, $found_resolution) : $streaming; +} + +=head1 AUTHOR + +Trizen, C<< >> + + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc WWW::FairViewer::Itags + + +=head1 LICENSE AND COPYRIGHT + +Copyright 2012-2015 Trizen. + +This program is free software; you can redistribute it and/or modify it +under the terms of either: the GNU General Public License as published +by the Free Software Foundation; or the Artistic License. + +See L for more information. + +=cut + +1; # End of WWW::FairViewer::Itags diff --git a/lib/WWW/FairViewer/ParseJSON.pm b/lib/WWW/FairViewer/ParseJSON.pm new file mode 100644 index 0000000..1e2af77 --- /dev/null +++ b/lib/WWW/FairViewer/ParseJSON.pm @@ -0,0 +1,76 @@ +package WWW::FairViewer::ParseJSON; + +use utf8; +use 5.014; +use warnings; + +=head1 NAME + +WWW::FairViewer::ParseJSON - Parse JSON content. + +=head1 SYNOPSIS + + use WWW::FairViewer::ParseJSON; + my $obj = WWW::FairViewer::ParseJSON->new(%opts); + +=head1 SUBROUTINES/METHODS + +=cut + +=head2 parse_json_string($json_string) + +Parse a JSON string and return a HASH ref. + +=cut + +sub parse_json_string { + my ($self, $json) = @_; + + if (not defined($json) or $json eq '') { + return {}; + } + + require JSON; + my $hash = eval { JSON::decode_json($json) }; + return $@ ? do { warn "[JSON]: $@\n"; {} } : $hash; +} + +=head2 make_json_string($ref) + +Create a JSON string from a HASH or ARRAY ref. + +=cut + +sub make_json_string { + my ($self, $ref) = @_; + + require JSON; + my $str = eval { JSON::encode_json($ref) }; + return $@ ? do { warn "[JSON]: $@\n"; '' } : $str; +} + +=head1 AUTHOR + +Trizen, C<< >> + + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc WWW::FairViewer::ParseJSON + + +=head1 LICENSE AND COPYRIGHT + +Copyright 2013-2015 Trizen. + +This program is free software; you can redistribute it and/or modify it +under the terms of either: the GNU General Public License as published +by the Free Software Foundation; or the Artistic License. + +See L for more information. + +=cut + +1; # End of WWW::FairViewer::ParseJSON diff --git a/lib/WWW/FairViewer/ParseXML.pm b/lib/WWW/FairViewer/ParseXML.pm new file mode 100644 index 0000000..23e01a5 --- /dev/null +++ b/lib/WWW/FairViewer/ParseXML.pm @@ -0,0 +1,311 @@ +package WWW::FairViewer::ParseXML; + +use utf8; +use 5.014; +use warnings; + +=encoding utf8 + +=head1 NAME + +WWW::FairViewer::ParseXML - Convert XML to a HASH ref structure. + +=head1 SYNOPSIS + +Parse XML content and return an HASH ref structure. + +Usage: + + use WWW::FairViewer::ParseXML; + my $hash_ref = WWW::FairViewer::ParseXML::xml2hash($xml_string); + +=head1 SUBROUTINES/METHODS + +=head2 xml2hash($xml_string) + +Parse XML and return an HASH ref. + +=cut + +sub xml2hash { + my $xml = shift() // return; + + $xml = "$xml"; # copy the string + + my $xml_ref = {}; + + my %args = ( + attr => '-', + text => '#text', + empty => q{}, + @_ + ); + + my %ctags; + my $ref = $xml_ref; + + state $inv_chars = q{!"#$@%&'()*+,/;\\<=>?\]\[^`{|}~}; + state $valid_tag = qr{[^\-.\s0-9$inv_chars][^$inv_chars\s]*}; + + { + if ( + $xml =~ m{\G< \s* + ($valid_tag) \s* + ((?>$valid_tag\s*=\s*(?>".*?"|'.*?')|\s+)+)? \s* + (/)?\s*> \s* + }gcsxo + ) { + + my ($tag, $attrs, $closed) = ($1, $2, $3); + + if (defined $attrs) { + push @{$ctags{$tag}}, $ref; + + $ref = + ref $ref eq 'HASH' + ? ref $ref->{$tag} + ? $ref->{$tag} + : ( + defined $ref->{$tag} + ? ($ref->{$tag} = [$ref->{$tag}]) + : ($ref->{$tag} //= []) + ) + : ref $ref eq 'ARRAY' ? ref $ref->[-1]{$tag} + ? $ref->[-1]{$tag} + : ( + defined $ref->[-1]{$tag} + ? ($ref->[-1]{$tag} = [$ref->[-1]{$tag}]) + : ($ref->[-1]{$tag} //= []) + ) + : []; + + ++$#{$ref} if ref $ref eq 'ARRAY'; + + while ( + $attrs =~ m{\G + ($valid_tag) \s*=\s* + (?> + "(.*?)" + | + '(.*?)' + ) \s* + }gsxo + ) { + my ($key, $value) = ($1, $+); + $key = join(q{}, $args{attr}, $key); + if (ref $ref eq 'ARRAY') { + $ref->[-1]{$key} = _decode_entities($value); + } + elsif (ref $ref eq 'HASH') { + $ref->{$key} = $value; + } + } + + if (defined $closed) { + $ref = pop @{$ctags{$tag}}; + } + + if ($xml =~ m{\G<\s*/\s*\Q$tag\E\s*>\s*}gc) { + $ref = pop @{$ctags{$tag}}; + } + elsif ($xml =~ m{\G([^<]+)(?=<)}gsc) { + if (ref $ref eq 'ARRAY') { + $ref->[-1]{$args{text}} .= _decode_entities($1); + $ref = pop @{$ctags{$tag}}; + } + elsif (ref $ref eq 'HASH') { + $ref->{$args{text}} .= $1; + $ref = pop @{$ctags{$tag}}; + } + } + } + elsif (defined $closed) { + if (ref $ref eq 'ARRAY') { + if (exists $ref->[-1]{$tag}) { + if (ref $ref->[-1]{$tag} ne 'ARRAY') { + $ref->[-1]{$tag} = [$ref->[-1]{$tag}]; + } + push @{$ref->[-1]{$tag}}, $args{empty}; + } + else { + $ref->[-1]{$tag} = $args{empty}; + } + } + } + else { + if ($xml =~ /\G(?=<(?!!))/) { + push @{$ctags{$tag}}, $ref; + + $ref = + ref $ref eq 'HASH' + ? ref $ref->{$tag} + ? $ref->{$tag} + : ( + defined $ref->{$tag} + ? ($ref->{$tag} = [$ref->{$tag}]) + : ($ref->{$tag} //= []) + ) + : ref $ref eq 'ARRAY' ? ref $ref->[-1]{$tag} + ? $ref->[-1]{$tag} + : ( + defined $ref->[-1]{$tag} + ? ($ref->[-1]{$tag} = [$ref->[-1]{$tag}]) + : ($ref->[-1]{$tag} //= []) + ) + : []; + + ++$#{$ref} if ref $ref eq 'ARRAY'; + redo; + } + elsif ($xml =~ /\G\s*/gcs or $xml =~ /\G([^<]+)(?=<)/gsc) { + my ($text) = $1; + + if ($xml =~ m{\G<\s*/\s*\Q$tag\E\s*>\s*}gc) { + if (ref $ref eq 'ARRAY') { + if (exists $ref->[-1]{$tag}) { + if (ref $ref->[-1]{$tag} ne 'ARRAY') { + $ref->[-1]{$tag} = [$ref->[-1]{$tag}]; + } + push @{$ref->[-1]{$tag}}, $text; + } + else { + $ref->[-1]{$tag} .= _decode_entities($text); + } + } + elsif (ref $ref eq 'HASH') { + $ref->{$tag} .= $text; + } + } + else { + push @{$ctags{$tag}}, $ref; + + $ref = + ref $ref eq 'HASH' + ? ref $ref->{$tag} + ? $ref->{$tag} + : ( + defined $ref->{$tag} + ? ($ref->{$tag} = [$ref->{$tag}]) + : ($ref->{$tag} //= []) + ) + : ref $ref eq 'ARRAY' ? ref $ref->[-1]{$tag} + ? $ref->[-1]{$tag} + : ( + defined $ref->[-1]{$tag} + ? ($ref->[-1]{$tag} = [$ref->[-1]{$tag}]) + : ($ref->[-1]{$tag} //= []) + ) + : []; + + ++$#{$ref} if ref $ref eq 'ARRAY'; + + if (ref $ref eq 'ARRAY') { + if (exists $ref->[-1]{$tag}) { + if (ref $ref->[-1]{$tag} ne 'ARRAY') { + $ref->[-1] = [$ref->[-1]{$tag}]; + } + push @{$ref->[-1]}, {$args{text} => $text}; + } + else { + $ref->[-1]{$args{text}} .= $text; + } + } + elsif (ref $ref eq 'HASH') { + $ref->{$tag} .= $text; + } + } + } + } + + if ($xml =~ m{\G<\s*/\s*\Q$tag\E\s*>\s*}gc) { + ## tag closed - ok + } + + redo; + } + elsif ($xml =~ m{\G<\s*/\s*($valid_tag)\s*>\s*}gco) { + if (exists $ctags{$1} and @{$ctags{$1}}) { + $ref = pop @{$ctags{$1}}; + } + redo; + } + elsif ($xml =~ /\G\s*/gcs or $xml =~ m{\G([^<]+)(?=<)}gsc) { + if (ref $ref eq 'ARRAY') { + $ref->[-1]{$args{text}} .= $1; + } + elsif (ref $ref eq 'HASH') { + $ref->{$args{text}} .= $1; + } + redo; + } + elsif ($xml =~ /\G<\?/gc) { + $xml =~ /\G.*?\?>\s*/gcs or die "Invalid XML!"; + redo; + } + elsif ($xml =~ /\G\s*/gcs or die "Comment not closed!"; + redo; + } + elsif ($xml =~ /\G$valid_tag|\s+|".*?"|'.*?')*\[.*?\]>\s*/sgco + or $xml =~ /\G.*?>\s*/sgc + or die "DOCTYPE not closed!"; + redo; + } + elsif ($xml =~ /\G\z/gc) { + ## ok + } + elsif ($xml =~ /\G\s+/gc) { + redo; + } + else { + die "Syntax error near: --> ", [split(/\n/, substr($xml, pos(), 2**6))]->[0], " <--\n"; + } + } + + return $xml_ref; +} + +{ + my %entities = ( + 'amp' => '&', + 'quot' => '"', + 'apos' => "'", + 'gt' => '>', + 'lt' => '<', + ); + + state $ent_re = do { + local $" = '|'; + qr/&(@{[keys %entities]});/; + }; + + sub _decode_entities { + $_[0] =~ s/$ent_re/$entities{$1}/gor; + } +} + +=head1 AUTHOR + +Trizen, C<< >> + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc WWW::FairViewer::ParseXML + + +=head1 LICENSE AND COPYRIGHT + +Copyright 2012-2015 Trizen. + +This program is free software; you can redistribute it and/or modify it +under the terms of either: the GNU General Public License as published +by the Free Software Foundation; or the Artistic License. + +See L for more information. + +=cut + +1; # End of WWW::FairViewer::ParseXML diff --git a/lib/WWW/FairViewer/PlaylistItems.pm b/lib/WWW/FairViewer/PlaylistItems.pm new file mode 100644 index 0000000..767903e --- /dev/null +++ b/lib/WWW/FairViewer/PlaylistItems.pm @@ -0,0 +1,146 @@ +package WWW::FairViewer::PlaylistItems; + +use utf8; +use 5.014; +use warnings; + +=head1 NAME + +WWW::FairViewer::PlaylistItems - Manage playlist entries. + +=head1 SYNOPSIS + + use WWW::FairViewer; + my $obj = WWW::FairViewer->new(%opts); + my $videos = $obj->videos_from_playlistID($playlist_id); + +=head1 SUBROUTINES/METHODS + +=cut + +sub _make_playlistItems_url { + my ($self, %opts) = @_; + return + $self->_make_feed_url( + 'playlistItems', + pageToken => $self->page_token, + %opts + ); +} + +=head2 add_video_to_playlist($playlistID, $videoID; $position=1) + +Add a video to given playlist ID, at position 1 (by default) + +=cut + +sub add_video_to_playlist { + my ($self, $playlist_id, $video_id, $position) = @_; + + $self->get_access_token() // return; + + $playlist_id // return; + $video_id // return; + $position //= 0; + + my $hash = { + "snippet" => { + "playlistId" => $playlist_id, + "resourceId" => { + "videoId" => $video_id, + "kind" => "youtube#video" + }, + "position" => $position, + } + }; + + my $url = $self->_make_playlistItems_url(pageToken => undef); + $self->post_as_json($url, $hash); +} + +=head2 favorite_video($videoID) + +Favorite a video. Returns true on success. + +=cut + +sub favorite_video { + my ($self, $video_id) = @_; + $video_id // return; + $self->get_access_token() // return; + my $playlist_id = $self->get_playlist_id('favorites', mine => 'true') // return; + $self->add_video_to_playlist($playlist_id, $video_id); +} + +=head2 videos_from_playlist_id($playlist_id) + +Get videos from a specific playlistID. + +=cut + +sub videos_from_playlist_id { + my ($self, $id) = @_; + $self->_get_results($self->_make_feed_url("playlists/$id")); +} + +=head2 favorites($channel_id) + +=head2 uploads($channel_id) + +=head2 likes($channel_id) + +Get the favorites, uploads and likes for a given channel ID. + +=cut + +=head2 favorites_from_username($username) + +=head2 uploads_from_username($username) + +=head2 likes_from_username($username) + +Get the favorites, uploads and likes for a given YouTube username. + +=cut + +{ + no strict 'refs'; + foreach my $name (qw(favorites uploads likes)) { + + *{__PACKAGE__ . '::' . $name . '_from_username'} = sub { + my ($self, $username) = @_; + $self->videos_from_username($username); + }; + + *{__PACKAGE__ . '::' . $name} = sub { + my ($self, $channel_id) = @_; + $self->videos_from_channel_id($channel_id); + }; + } +} + +=head1 AUTHOR + +Trizen, C<< >> + + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc WWW::FairViewer::PlaylistItems + + +=head1 LICENSE AND COPYRIGHT + +Copyright 2013-2015 Trizen. + +This program is free software; you can redistribute it and/or modify it +under the terms of either: the GNU General Public License as published +by the Free Software Foundation; or the Artistic License. + +See L for more information. + +=cut + +1; # End of WWW::FairViewer::PlaylistItems diff --git a/lib/WWW/FairViewer/Playlists.pm b/lib/WWW/FairViewer/Playlists.pm new file mode 100644 index 0000000..2adef54 --- /dev/null +++ b/lib/WWW/FairViewer/Playlists.pm @@ -0,0 +1,124 @@ +package WWW::FairViewer::Playlists; + +use utf8; +use 5.014; +use warnings; + +=head1 NAME + +WWW::FairViewer::Playlists - Fair playlists handle. + +=head1 SYNOPSIS + + use WWW::FairViewer; + my $obj = WWW::FairViewer->new(%opts); + my $info = $obj->playlist_from_id($playlist_id); + +=head1 SUBROUTINES/METHODS + +=cut + +sub _make_playlists_url { + my ($self, %opts) = @_; + + if (not exists $opts{'part'}) { + $opts{'part'} = 'snippet,contentDetails'; + } + + $self->_make_feed_url( + 'playlists', + pageToken => $self->page_token, + %opts, + ); +} + +sub get_playlist_id { + my ($self, $playlist_name, %fields) = @_; + + my $url = $self->_simple_feeds_url('channels', qw(part contentDetails), %fields); + my $res = $self->_get_results($url); + + ref($res->{results}{items}) eq 'ARRAY' || return; + @{$res->{results}{items}} || return; + + return $res->{results}{items}[0]{contentDetails}{relatedPlaylists}{$playlist_name}; +} + +=head2 playlist_from_id($playlist_id) + +Return info for one or more playlists. +PlaylistIDs can be separated by commas. + +=cut + +sub playlist_from_id { + my ($self, $id, $part) = @_; + $self->_get_results($self->_make_playlists_url(id => $id, part => ($part // 'snippet'))); +} + +=head2 playlists($channel_id) + +Get and return playlists from a channel ID. + +=cut + +sub playlists { + my ($self, $channel_id) = @_; + $self->_get_results( + $self->_make_playlists_url( + ($channel_id and $channel_id ne 'mine') + ? (channelId => $channel_id) + : do { $self->get_access_token() // return; (mine => 'true') } + ) + ); +} + +=head2 playlists_from_username($username) + +Get and return the playlists created for a given username. + +=cut + +sub playlists_from_username { + my ($self, $username) = @_; + my $channel_id = $self->channel_id_from_username($username) // $username; + $self->playlists($channel_id); +} + +=head2 my_playlists() + +Get and return your playlists. + +=cut + +sub my_playlists { + my ($self) = @_; + $self->get_access_token() // return; + $self->_get_results($self->_make_playlists_url(mine => 'true')); +} + +=head1 AUTHOR + +Trizen, C<< >> + + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc WWW::FairViewer::Playlists + + +=head1 LICENSE AND COPYRIGHT + +Copyright 2013-2015 Trizen. + +This program is free software; you can redistribute it and/or modify it +under the terms of either: the GNU General Public License as published +by the Free Software Foundation; or the Artistic License. + +See L for more information. + +=cut + +1; # End of WWW::FairViewer::Playlists diff --git a/lib/WWW/FairViewer/RegularExpressions.pm b/lib/WWW/FairViewer/RegularExpressions.pm new file mode 100644 index 0000000..20d2a99 --- /dev/null +++ b/lib/WWW/FairViewer/RegularExpressions.pm @@ -0,0 +1,89 @@ +package WWW::FairViewer::RegularExpressions; + +use utf8; +use 5.014; +use warnings; + +require Exporter; +our @ISA = qw(Exporter); + +=head1 NAME + +WWW::FairViewer::RegularExpressions - Various utils. + +=head1 SYNOPSIS + + use WWW::FairViewer::RegularExpressions; + use WWW::FairViewer::RegularExpressions ($get_video_id_re); + +=cut + +my $opt_begin_chars = q{:;=}; # stdin option valid begin chars + +# Options +our $range_num_re = qr{^([0-9]{1,2}+)(?>-|\.\.)([0-9]{1,2}+)?\z}; +our $digit_or_equal_re = qr/(?(?=[1-9])|=)/; +our $non_digit_or_opt_re = qr{^(?!$range_num_re)(?>[0-9]{1,2}[^0-9]|[0-9]{3}|[^0-9$opt_begin_chars])}; + +# Generic name +my $generic_name_re = qr/[a-zA-Z0-9_.\-]{11,34}/; +our $valid_channel_id_re = qr{^(?:.*/channel/)?(?(?:\w+(?:[-.]++\w++)*|$generic_name_re))(?:/.*)?\z}; + +our $get_channel_videos_id_re = qr{^.*/channel/(?(?:\w+(?:[-.]++\w++)*|$generic_name_re))}; +our $get_channel_playlists_id_re = qr{$get_channel_videos_id_re/playlists}; + +our $get_username_videos_re = qr{^.*/user/(?[-.\w]+)}; +our $get_username_playlists_re = qr{$get_username_videos_re/playlists}; + +# Video ID +my $video_id_re = qr/[0-9A-Za-z_\-]{11}/; +our $valid_video_id_re = qr{^$video_id_re\z}; +our $get_video_id_re = qr{(?:%3F|\b)(?>v|embed|youtu[.]be)(?>[=/]|%3D)(?$video_id_re)}; + +# Playlist ID +our $valid_playlist_id_re = qr{^$generic_name_re\z}; +our $get_playlist_id_re = qr{(?:(?:(?>playlist\?list|view_play_list\?p|list)=)|\w#p/c/)(?$generic_name_re)\b}; + +our $valid_opt_re = qr{^[$opt_begin_chars]([A-Za-z]++(?:-[A-Za-z]++)?(?>${digit_or_equal_re}.*)?)$}; + +our @EXPORT = qw( + $range_num_re + $digit_or_equal_re + $non_digit_or_opt_re + $valid_channel_id_re + $valid_video_id_re + $get_video_id_re + $valid_playlist_id_re + $get_playlist_id_re + $valid_opt_re + $get_channel_videos_id_re + $get_channel_playlists_id_re + $get_username_videos_re + $get_username_playlists_re + ); + +=head1 AUTHOR + +Trizen, C<< >> + + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc WWW::FairViewer::RegularExpressions + + +=head1 LICENSE AND COPYRIGHT + +Copyright 2012-2013 Trizen. + +This program is free software; you can redistribute it and/or modify it +under the terms of either: the GNU General Public License as published +by the Free Software Foundation; or the Artistic License. + +See L for more information. + +=cut + +1; # End of WWW::FairViewer::RegularExpressions diff --git a/lib/WWW/FairViewer/Search.pm b/lib/WWW/FairViewer/Search.pm new file mode 100644 index 0000000..256e605 --- /dev/null +++ b/lib/WWW/FairViewer/Search.pm @@ -0,0 +1,175 @@ +package WWW::FairViewer::Search; + +use utf8; +use 5.014; +use warnings; + +=head1 NAME + +WWW::FairViewer::Search - Search functions for Fair API v3 + +=head1 SYNOPSIS + + use WWW::FairViewer; + my $obj = WWW::FairViewer->new(%opts); + $obj->search_videos(@keywords); + +=head1 SUBROUTINES/METHODS + +=cut + +sub _make_search_url { + my ($self, %opts) = @_; + + return $self->_make_feed_url( + 'search', + + topicId => $self->get_topicId, + regionCode => $self->get_regionCode, + + maxResults => $self->get_maxResults, + order => $self->get_order, + publishedAfter => $self->get_publishedAfter, + publishedBefore => $self->get_publishedBefore, + regionCode => $self->get_regionCode, + relevanceLanguage => $self->get_relevanceLanguage, + safeSearch => $self->get_safeSearch, + channelId => $self->get_channelId, + channelType => $self->get_channelType, + pageToken => $self->page_token, + + ( + $opts{type} eq 'video' + ? ( + videoCaption => $self->get_videoCaption, + videoCategoryId => $self->get_videoCategoryId, + videoDefinition => $self->get_videoDefinition, + videoDimension => $self->get_videoDimension, + videoDuration => $self->get_videoDuration, + videoEmbeddable => $self->get_videoEmbeddable, + videoLicense => $self->get_videoLicense, + videoSyndicated => $self->get_videoSyndicated, + videoType => $self->get_videoType, + eventType => $self->get_eventType, + ) + : () + ), + + %opts, + ); + +} + +=head2 search_for($types,$keywords;\%args) + +Search for a list of types (comma-separated). + +=cut + +sub search_for { + my ($self, $type, $keywords, $args) = @_; + + $keywords //= []; + if (ref $keywords ne 'ARRAY') { + $keywords = [split ' ', $keywords]; + } + + my $url = $self->_make_search_url( + type => $type, + q => $self->escape_string(join(' ', @{$keywords})), + (ref $args eq 'HASH' ? %{$args} : (part => 'snippet')), + ); + + return $self->_get_results($url); +} + +{ + no strict 'refs'; + + foreach my $pair ( + { + name => 'videos', + type => 'video', + }, + { + name => 'playlists', + type => 'playlist', + }, + { + name => 'channels', + type => 'channel', + }, + { + name => 'all', + type => 'video,channel,playlist', + } + ) { + *{__PACKAGE__ . '::' . "search_$pair->{name}"} = sub { + my $self = shift; + $self->search_for($pair->{type}, @_); + }; + } +} + +=head2 search_videos($keywords;\%args) + +Search and return the found video results. + +=cut + +=head2 search_playlists($keywords;\%args) + +Search and return the found playlists. + +=cut + +=head2 search_channels($keywords;\%args) + +Search and return the found channels. + +=cut + +=head2 search_all($keywords;\%args) + +Search and return the results. + +=cut + +=head2 related_to_videoID($id) + +Retrieves a list of videos that are related to the video +that the parameter value identifies. The parameter value must +be set to a YouTube video ID. + +=cut + +sub related_to_videoID { + my ($self, $id) = @_; + return $self->search_for('video', [], {relatedToVideoId => $id}); +} + +=head1 AUTHOR + +Trizen, C<< >> + + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc WWW::FairViewer::Search + + +=head1 LICENSE AND COPYRIGHT + +Copyright 2013-2015 Trizen. + +This program is free software; you can redistribute it and/or modify it +under the terms of either: the GNU General Public License as published +by the Free Software Foundation; or the Artistic License. + +See L for more information. + +=cut + +1; # End of WWW::FairViewer::Search diff --git a/lib/WWW/FairViewer/Subscriptions.pm b/lib/WWW/FairViewer/Subscriptions.pm new file mode 100644 index 0000000..eb8add9 --- /dev/null +++ b/lib/WWW/FairViewer/Subscriptions.pm @@ -0,0 +1,272 @@ +package WWW::FairViewer::Subscriptions; + +use utf8; +use 5.014; +use warnings; + +=head1 NAME + +WWW::FairViewer::Subscriptions - Subscriptions handler. + +=head1 SYNOPSIS + + use WWW::FairViewer; + my $obj = WWW::FairViewer->new(%opts); + my $videos = $obj->subscriptions_from_channelID($channel_id); + +=head1 SUBROUTINES/METHODS + +=cut + +sub _make_subscriptions_url { + my ($self, %opts) = @_; + return $self->_make_feed_url('subscriptions', %opts); +} + +=head2 subscribe_channel($channel_id) + +Subscribe to an YouTube channel. + +=cut + +sub subscribe_channel { + my ($self, $channel_id) = @_; + + my $resource = { + snippet => { + resourceId => { + kind => 'youtube#channel', + channelId => $channel_id, + } + } + }; + + my $url = $self->_simple_feeds_url('subscriptions', part => 'snippet'); + return $self->post_as_json($url, $resource); +} + +=head2 subscribe_channel_from_username($username) + +Subscribe to an YouTube channel via username. + +=cut + +sub subscribe_channel_from_username { + my ($self, $username) = @_; + $self->subscribe_channel($self->channel_id_from_username($username) // $username); +} + +=head2 subscriptions(;$channel_id) + +Retrieve the subscriptions for a channel ID or for the authenticated user. + +=cut + +sub subscriptions { + my ($self, $channel_id) = @_; + $self->_get_results( + $self->_make_subscriptions_url( + order => $self->get_subscriptions_order, + part => 'snippet', + ( + ($channel_id and $channel_id ne 'mine') + ? (channelId => $channel_id) + : do { $self->get_access_token() // return; (mine => 'true') } + ), + ) + ); +} + +=head2 subscriptions_from_username($username) + +Retrieve subscriptions for a given YouTube username. + +=cut + +sub subscriptions_from_username { + my ($self, $username) = @_; + $self->subscriptions($self->channel_id_from_username($username) // $username); +} + +=head2 subscription_videos(;$channel_id) + +Retrieve the video subscriptions for a channel ID or for the current authenticated user. + +=cut + +sub subscription_videos { + my ($self, $channel_id, $order) = @_; + + my $max_results = $self->get_maxResults(); + + my @subscription_items; + my $next_page_token; + + while (1) { + + my $url = $self->_make_subscriptions_url( + order => $self->get_subscriptions_order, + maxResults => 50, + part => 'snippet,contentDetails', + ($channel_id and $channel_id ne 'mine') + ? (channelId => $channel_id) + : do { $self->get_access_token() // return; (mine => 'true') }, + defined($next_page_token) ? (pageToken => $next_page_token) : (), + ); + + my $subscriptions = $self->_get_results($url)->{results}; + + if ( ref($subscriptions) eq 'HASH' + and ref($subscriptions->{items}) eq 'ARRAY') { + push @subscription_items, @{$subscriptions->{items}}; + } + + $next_page_token = $subscriptions->{nextPageToken} || last; + } + + my (undef, undef, undef, $mday, $mon, $year) = localtime; + + $mon += 1; + $year += 1900; + + my @videos; + foreach my $channel (@subscription_items) { + + my $new_items = $channel->{contentDetails}{newItemCount}; + + # Ignore channels with zero new items + $new_items > 0 || next; + + # Set the number of results + $self->set_maxResults(1); # don't load more than 1 video from each channel + # maybe, this value should be configurable (?) + + my $uploads = $self->uploads($channel->{snippet}{resourceId}{channelId}); + + (ref($uploads) eq 'HASH' and ref($uploads->{results}) eq 'HASH' and ref($uploads->{results}{items}) eq 'ARRAY') + || return; + + my $items = $uploads->{results}{items}; + + # Get and store the video uploads from each channel + foreach my $item (@$items) { + my $publishedAt = $item->{snippet}{publishedAt}; + my ($p_year, $p_mon, $p_mday) = $publishedAt =~ /^(\d{4})-(\d{2})-(\d{2})/; + + my $year_diff = $year - $p_year; + my $mon_diff = $mon - $p_mon; + my $mday_diff = $mday - $p_mday; + + my $days_diff = $year_diff * 365.2422 + $mon_diff * 30.436875 + $mday_diff; + + # Ignore old entries + if ($days_diff > 3) { + next; + } + + push @videos, $item; + } + + # Stop when the limit is reached + last if (@videos >= $max_results); + } + + # When there are no new videos, load one from each channel + if ($#videos == -1) { + foreach my $channel (@subscription_items) { + $self->set_maxResults(1); + push @videos, @{$self->uploads($channel->{snippet}{resourceId}{channelId})->{results}{items}}; + last if (@videos >= $max_results); + } + } + + $self->set_maxResults($max_results); + + state $parse_time_re = qr/^(\d{4})-(\d{2})-(\d{2})T(\d{2}):(\d{2}):(\d{2})/; + + @videos = + sort { + my ($y1, $M1, $d1, $h1, $m1, $s1) = $a->{snippet}{publishedAt} =~ $parse_time_re; + my ($y2, $M2, $d2, $h2, $m2, $s2) = $b->{snippet}{publishedAt} =~ $parse_time_re; + + ($y2 <=> $y1) || ($M2 <=> $M1) || ($d2 <=> $d1) || ($h2 <=> $h1) || ($m2 <=> $m1) || ($s2 <=> $s1) + } @videos; + + return {results => {pageInfo => {totalResults => $#videos + 1}, items => \@videos}}; +} + +=head2 subscription_videos_from_username($username) + +Retrieve the video subscriptions for a username. + +=cut + +sub subscription_videos_from_username { + my ($self, $username) = @_; + $self->subscription_videos($self->channel_id_from_username($username) // $username); +} + +=head2 subscriptions_from_channelID(%args) + +Get subscriptions for the specified channel ID. + +=head2 subscriptions_info($subscriptionID, %args) + +Get details for the comma-separated subscriptionID(s). + +=head3 HASH '%args' supports the following pairs: + + %args = ( + part => {contentDetails,id,snippet}, + forChannelId => $channelID, + maxResults => [0-50], + order => {alphabetical, relevance, unread}, + pageToken => {$nextPageToken, $prevPageToken}, + ); + +=cut + +{ + no strict 'refs'; + foreach my $method ( + { + key => 'id', + name => 'subscriptions_info', + }, + { + key => 'channelId', + name => 'subscriptions_from_channel_id', + } + ) { + *{__PACKAGE__ . '::' . $method->{name}} = sub { + my ($self, $id, %args) = @_; + return $self->_get_results($self->_make_subscriptions_url($method->{key} => $id, %args)); + }; + } +} + +=head1 AUTHOR + +Trizen, C<< >> + + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc WWW::FairViewer::Subscriptions + + +=head1 LICENSE AND COPYRIGHT + +Copyright 2013-2015 Trizen. + +This program is free software; you can redistribute it and/or modify it +under the terms of either: the GNU General Public License as published +by the Free Software Foundation; or the Artistic License. + +See L for more information. + +=cut + +1; # End of WWW::FairViewer::Subscriptions diff --git a/lib/WWW/FairViewer/Utils.pm b/lib/WWW/FairViewer/Utils.pm new file mode 100644 index 0000000..5a9296a --- /dev/null +++ b/lib/WWW/FairViewer/Utils.pm @@ -0,0 +1,801 @@ +package WWW::FairViewer::Utils; + +use utf8; +use 5.014; +use warnings; + +=head1 NAME + +WWW::FairViewer::Utils - Various utils. + +=head1 SYNOPSIS + + use WWW::FairViewer::Utils; + + my $yv_utils = WWW::FairViewer::Utils->new(%opts); + + print $yv_utils->format_time(3600); + +=head1 SUBROUTINES/METHODS + +=head2 new(%opts) + +Options: + +=over 4 + +=item thousand_separator => "" + +Character used as thousand separator. + +=item months => [] + +Month names for I + +=item youtube_url_format => "" + +A youtube URL format for sprintf(format, videoID). + +=back + +=cut + +sub new { + my ($class, %opts) = @_; + + my $self = bless { + thousand_separator => q{,}, + youtube_url_format => 'https://www.youtube.com/watch?v=%s', + }, $class; + + $self->{months} = [ + qw( + Jan Feb Mar + Apr May Jun + Jul Aug Sep + Oct Nov Dec + ) + ]; + + foreach my $key (keys %{$self}) { + $self->{$key} = delete $opts{$key} + if exists $opts{$key}; + } + + foreach my $invalid_key (keys %opts) { + warn "Invalid key: '${invalid_key}'"; + } + + return $self; +} + +=head2 extension($type) + +Returns the extension format from a given type. + +From a string like 'video/webm;+codecs="vp9"', it returns 'webm'. + +=cut + +sub extension { + my ($self, $type) = @_; + $type =~ /\bflv\b/i ? q{flv} + : $type =~ /\bwebm\b/i ? q{webm} + : $type =~ /\b3gpp?\b/i ? q{3gp} + : $type =~ m{^video/(\w+)} ? $1 + : $type =~ m{^audio/(\w+)} ? $1 + : q{mp4}; +} + +=head2 format_time($sec) + +Returns time from seconds. + +=cut + +sub format_time { + my ($self, $sec) = @_; + $sec >= 3600 + ? join q{:}, map { sprintf '%02d', $_ } $sec / 3600 % 24, $sec / 60 % 60, $sec % 60 + : join q{:}, map { sprintf '%02d', $_ } $sec / 60 % 60, $sec % 60; +} + +=head2 format_duration($duration) + +Return seconds from duration (PT1H20M10S). + +=cut + +# PT5M3S -> 05:03 +# PT1H20M10S -> 01:20:10 +# PT16S -> 00:16 + +sub format_duration { + my ($self, $duration) = @_; + + $duration // return 0; + my ($hour, $min, $sec) = (0, 0, 0); + + $hour = $1 if ($duration =~ /(\d+)H/); + $min = $1 if ($duration =~ /(\d+)M/); + $sec = $1 if ($duration =~ /(\d+)S/); + + $hour * 60 * 60 + $min * 60 + $sec; +} + +=head2 format_date($date) + +Return string "04 May 2010" from "2010-05-04T00:25:55.000Z" + +=cut + +sub format_date { + my ($self, $date) = @_; + + # 2010-05-04T00:25:55.000Z + # to: 04 May 2010 + + $date =~ s{^ + (?\d{4}) + - + (?\d{2}) + - + (?\d{2}) + .* + } + {$+{day} $self->{months}[$+{month} - 1] $+{year}}x; + + return $date; +} + +=head2 date_to_age($date) + +Return the (approximated) age for a given date of the form "2010-05-04T00:25:55.000Z". + +=cut + +sub date_to_age { + my ($self, $date) = @_; + + $date =~ m{^ + (?\d{4}) + - + (?\d{2}) + - + (?\d{2}) + [a-zA-Z] + (?\d{2}) + : + (?\d{2}) + : + (?\d{2}) + }x || return undef; + + my ($sec, $min, $hour, $day, $month, $year) = gmtime(time); + + $year += 1900; + $month += 1; + + my $lambda = sub { + + if ($year == $+{year}) { + if ($month == $+{month}) { + if ($day == $+{day}) { + if ($hour == $+{hour}) { + if ($min == $+{min}) { + return join(' ', $sec - $+{sec}, 'seconds'); + } + return join(' ', $min - $+{min}, 'minutes'); + } + return join(' ', $hour - $+{hour}, 'hours'); + } + return join(' ', $day - $+{day}, 'days'); + } + return join(' ', $month - $+{month}, 'months'); + } + + if ($year - $+{year} == 1) { + my $month_diff = $+{month} - $month; + if ($month_diff > 0) { + return join(' ', 12 - $month_diff, 'months'); + } + } + + return join(' ', $year - $+{year}, 'years'); + }; + + my $age = $lambda->(); + + if ($age =~ /^1\s/) { # singular mode + $age =~ s/s\z//; + } + + return $age; +} + +=head2 has_entries($result) + +Returns true if a given result has entries. + +=cut + +sub has_entries { + my ($self, $result) = @_; + + if (ref($result->{results}) eq 'HASH') { + + if (exists $result->{results}{comments}) { + return scalar @{$result->{results}{comments}} > 0; + } + + my $type = $result->{results}{type}//''; + + if ($type eq 'playlist') { + return $result->{results}{videoCount} > 0; + } + } + + if (ref($result->{results}) eq 'ARRAY') { + return scalar(@{$result->{results}}) > 0; + } + + return 1; # maybe? + #ref($result) eq 'HASH' and ($result->{results}{pageInfo}{totalResults} > 0); +} + +=head2 normalize_video_title($title, $fat32safe) + +Replace file-unsafe characters and trim spaces. + +=cut + +sub normalize_video_title { + my ($self, $title, $fat32safe) = @_; + + if ($fat32safe) { + $title =~ s/: / - /g; + $title =~ tr{:"*/?\\|}{;'+%!%%}; # " + $title =~ tr/<>//d; + } + else { + $title =~ tr{/}{%}; + } + + join(q{ }, split(q{ }, $title)); +} + +=head2 format_text(%opt) + +Formats a text with information from streaming and video info. + +The structure of C<%opt> is: + + ( + streaming => HASH, + info => HASH, + text => STRING, + escape => BOOL, + fat32safe => BOOL, + ) + +=cut + +sub format_text { + my ($self, %opt) = @_; + + my $streaming = $opt{streaming}; + my $info = $opt{info}; + my $text = $opt{text}; + my $escape = $opt{escape}; + my $fat32safe = $opt{fat32safe}; + + my %special_tokens = ( + ID => sub { $self->get_video_id($info) }, + AUTHOR => sub { $self->get_channel_title($info) }, + CHANNELID => sub { $self->get_channel_id($info) }, + DEFINITION => sub { $self->get_definition($info) }, + DIMENSION => sub { $self->get_dimension($info) }, + VIEWS => sub { $self->get_views($info) }, + VIEWS_SHORT => sub { $self->get_views_approx($info) }, + LIKES => sub { $self->get_likes($info) }, + DISLIKES => sub { $self->get_dislikes($info) }, + COMMENTS => sub { $self->get_comments($info) }, + DURATION => sub { $self->get_duration($info) }, + TIME => sub { $self->get_time($info) }, + TITLE => sub { $self->get_title($info) }, + FTITLE => sub { $self->normalize_video_title($self->get_title($info), $fat32safe) }, + CAPTION => sub { $self->get_caption($info) }, + PUBLISHED => sub { $self->get_publication_date($info) }, + AGE => sub { $self->get_publication_age($info) }, + AGE_SHORT => sub { $self->get_publication_age_approx($info) }, + DESCRIPTION => sub { $self->get_description($info) }, + + RATING => sub { + my $likes = $self->get_likes($info) // 0; + my $dislikes = $self->get_dislikes($info) // 0; + + my $rating = 0; + if ($likes + $dislikes > 0) { + $rating = $likes / ($likes + $dislikes) * 5; + } + + sprintf('%.2f', $rating); + }, + + ( + defined($streaming) + ? ( + RESOLUTION => sub { + $streaming->{resolution} =~ /^\d+\z/ + ? $streaming->{resolution} . 'p' + : $streaming->{resolution}; + }, + + ITAG => sub { $streaming->{streaming}{itag} }, + SUB => sub { $streaming->{srt_file} }, + VIDEO => sub { $streaming->{streaming}{url} }, + FORMAT => sub { $self->extension($streaming->{streaming}{type}) }, + + AUDIO => sub { + ref($streaming->{streaming}{__AUDIO__}) eq 'HASH' + ? $streaming->{streaming}{__AUDIO__}{url} + : q{}; + }, + + AOV => sub { + ref($streaming->{streaming}{__AUDIO__}) eq 'HASH' + ? $streaming->{streaming}{__AUDIO__}{url} + : $streaming->{streaming}{url}; + }, + ) + : () + ), + + URL => sub { sprintf($self->{youtube_url_format}, $self->get_video_id($info)) }, + ); + + my $tokens_re = do { + local $" = '|'; + qr/\*(@{[keys %special_tokens]})\*/; + }; + + my %special_escapes = ( + a => "\a", + b => "\b", + e => "\e", + f => "\f", + n => "\n", + r => "\r", + t => "\t", + ); + + my $escapes_re = do { + local $" = q{}; + qr/\\([@{[keys %special_escapes]}])/; + }; + + $text =~ s/$escapes_re/$special_escapes{$1}/g; + + $escape + ? $text =~ s/$tokens_re/\Q${\$special_tokens{$1}()}\E/gr + : $text =~ s/$tokens_re/${\$special_tokens{$1}()}/gr; +} + +=head2 set_thousands($num) + +Return the number with thousand separators. + +=cut + +sub set_thousands { # ugly, but fast + my ($self, $n) = @_; + + return 0 unless $n; + length($n) > 3 or return $n; + + my $l = length($n) - 3; + my $i = ($l - 1) % 3 + 1; + my $x = substr($n, 0, $i) . $self->{thousand_separator}; + + while ($i < $l) { + $x .= substr($n, $i, 3) . $self->{thousand_separator}; + $i += 3; + } + + return $x . substr($n, $i); +} + +=head2 get_video_id($info) + +Get videoID. + +=cut + +sub get_video_id { + my ($self, $info) = @_; + $info->{videoId}; + + #~ ref($info->{id}) eq 'HASH' ? $info->{id}{videoId} + #~ : exists($info->{snippet}{resourceId}{videoId}) ? $info->{snippet}{resourceId}{videoId} + #~ : exists($info->{contentDetails}{videoId}) ? $info->{contentDetails}{videoId} + #~ : exists($info->{contentDetails}{playlistItem}{resourceId}{videoId}) + #~ ? $info->{contentDetails}{playlistItem}{resourceId}{videoId} + #~ : exists($info->{contentDetails}{upload}{videoId}) ? $info->{contentDetails}{upload}{videoId} + #~ : do { + #~ my $id = $info->{id} // return undef; + + #~ if (length($id) != 11) { + #~ return undef; + #~ } + + #~ $id; + #~ }; +} + +sub get_playlist_id { + my ($self, $info) = @_; + $info->{playlistId}; +} + +sub get_playlist_video_count { + my ($self, $info) = @_; + $info->{videoCount}; +} + +=head2 get_description($info) + +Get description. + +=cut + +sub get_description { + my ($self, $info) = @_; + my $desc = $info->{description}; + (defined($desc) and $desc =~ /\S/) ? $desc : 'No description available...'; +} + +=head2 get_title($info) + +Get title. + +=cut + +sub get_title { + my ($self, $info) = @_; + $info->{title}; +} + +=head2 get_thumbnail_url($info;$type='default') + +Get thumbnail URL. + +=cut + +sub get_thumbnail_url { + my ($self, $info, $type) = @_; + + if (exists $info->{videoId}) { + $info->{type} = 'video'; + } + + if ($info->{type} eq 'playlist') { + return $info->{playlistThumbnail}; + } + + if ($info->{type} eq 'channel') { + ref($info->{authorThumbnails}) eq 'ARRAY' or return ''; + return $info->{authorThumbnails}[0]{url}; + } + + ref($info->{videoThumbnails}) eq 'ARRAY' or return ''; + + my @thumbs = @{$info->{videoThumbnails}}; + my @wanted = grep{$_->{quality} eq $type} @thumbs; + + if (@wanted) { + return $wanted[0]{url}; + } + + warn "[!] Couldn't find thumbnail of type <<$type>>..."; + $thumbs[0]{url}; +} + +sub get_channel_title { + my ($self, $info) = @_; + #$info->{snippet}{channelTitle} || $self->get_channel_id($info); + $info->{author}; +} + +sub get_author { + my ($self, $info) = @_; + $info->{author}; +} + +sub get_comment_id { + my ($self, $info) = @_; + $info->{commentId}; +} + +sub get_comment_content { + my ($self, $info) = @_; + $info->{content}; +} + +sub get_id { + my ($self, $info) = @_; + #$info->{id}; + $info->{videoId}; +} + +sub get_channel_id { + my ($self, $info) = @_; + #$info->{snippet}{resourceId}{channelId} // $info->{snippet}{channelId}; + $info->{authorId}; +} + +sub get_category_id { + my ($self, $info) = @_; + #$info->{snippet}{resourceId}{categoryId} // $info->{snippet}{categoryId}; + #"unknown"; + $info->{genre} // 'Unknown'; +} + +sub get_category_name { + my ($self, $info) = @_; + + state $categories = { + 1 => 'Film & Animation', + 2 => 'Autos & Vehicles', + 10 => 'Music', + 15 => 'Pets & Animals', + 17 => 'Sports', + 19 => 'Travel & Events', + 20 => 'Gaming', + 22 => 'People & Blogs', + 23 => 'Comedy', + 24 => 'Entertainment', + 25 => 'News & Politics', + 26 => 'Howto & Style', + 27 => 'Education', + 28 => 'Science & Technology', + 29 => 'Nonprofits & Activism', + }; + + #$categories->{$self->get_category_id($info) // ''} // 'Unknown'; + + $info->{genre} // 'Unknown'; +} + +sub get_publication_date { + my ($self, $info) = @_; + #$self->format_date($info->{snippet}{publishedAt}); + #$self->format_date + require Time::Piece; + my $time = Time::Piece->new($info->{published}); + $time->strftime("%d %B %Y"); +} + +sub get_publication_age { + my ($self, $info) = @_; + ($info->{publishedText} // '') =~ s/\sago\z//r;; +} + +sub get_publication_age_approx { + my ($self, $info) = @_; + + my $age = $self->get_publication_age($info) // ''; + + if ($age =~ /hour|min|sec/) { + return "0d"; + } + + if ($age =~ /^(\d+) day/) { + return "$1d"; + } + + if ($age =~ /^(\d+) week/) { + return "$1w"; + } + + if ($age =~ /^(\d+) month/) { + return "$1m"; + } + + if ($age =~ /^(\d+) year/) { + return "$1y"; + } + + return $age; +} + +sub get_duration { + my ($self, $info) = @_; + #$self->format_duration($info->{contentDetails}{duration}); + #$self->format_duration($info->{lengthSeconds}); + $info->{lengthSeconds}; +} + +sub get_time { + my ($self, $info) = @_; + + if ($info->{liveNow}) { + return 'LIVE'; + } + + $self->format_time($self->get_duration($info)); + + #$self->format_time($self->get_duration($info)); +} + +sub get_definition { + my ($self, $info) = @_; + #uc($info->{contentDetails}{definition} // '-'); + #...; + "unknown"; +} + +sub get_dimension { + my ($self, $info) = @_; + #uc($info->{contentDetails}{dimension}); + #...; + "unknown"; +} + +sub get_caption { + my ($self, $info) = @_; + #$info->{contentDetails}{caption}; + #...; + "unknown"; +} + +sub get_views { + my ($self, $info) = @_; + $info->{viewCount} // 0; +} + +sub get_views_approx { + my ($self, $info) = @_; + my $views = $self->get_views($info); + + if ($views < 1000) { + return $views; + } + + if ($views >= 10 * 1e9) { # ten billions + return sprintf("%dB", int($views / 1e9)); + } + + if ($views >= 1e9) { # billions + return sprintf("%.2gB", $views / 1e9); + } + + if ($views >= 10 * 1e6) { # ten millions + return sprintf("%dM", int($views / 1e6)); + } + + if ($views >= 1e6) { # millions + return sprintf("%.2gM", $views / 1e6); + } + + if ($views >= 10 * 1e3) { # ten thousands + return sprintf("%dK", int($views / 1e3)); + } + + if ($views >= 1e3) { # thousands + return sprintf("%.2gK", $views / 1e3); + } + + return $views; +} + +sub get_likes { + my ($self, $info) = @_; + $info->{likeCount} // 0; +} + +sub get_dislikes { + my ($self, $info) = @_; + $info->{dislikeCount} // 0; +} + +sub get_comments { + my ($self, $info) = @_; + #$info->{statistics}{commentCount}; + 1; +} + +{ + no strict 'refs'; + foreach my $pair ( + [playlist => {'playlist' => 1}], + [channel => {'channel' => 1}], + [video => {'video' => 1, 'playlistItem' => 1}], + [subscription => {'subscription' => 1}], + [activity => {'activity' => 1}], + ) { + + *{__PACKAGE__ . '::' . 'is_' . $pair->[0]} = sub { + my ($self, $item) = @_; + + if ($pair->[0] eq 'video') { + return 1 if exists $item->{videoId}; + } + + exists $pair->[1]{$item->{type} // ''}; + + #~ if (ref($item->{id}) eq 'HASH') { + #~ if (exists $pair->[1]{$item->{id}{kind}}) { + #~ return 1; + #~ } + #~ } + #~ elsif (exists $item->{kind}) { + #~ if (exists $pair->[1]{$item->{kind}}) { + #~ return 1; + #~ } + #~ } + + #~ return; + }; + + } +} + +sub is_channelID { + my ($self, $id) = @_; + $id || return; + $id eq 'mine' or $id =~ /^UC[-a-zA-Z0-9_]{22}\z/; +} + +sub is_videoID { + my ($self, $id) = @_; + $id || return; + $id =~ /^[-a-zA-Z0-9_]{11}\z/; +} + +sub period_to_date { + my ($self, $amount, $period) = @_; + + state $day = 60 * 60 * 24; + state $week = $day * 7; + state $month = $day * 30.4368; + state $year = $day * 365.242; + + my $time = $amount * ( + $period =~ /^d/i ? $day + : $period =~ /^w/i ? $week + : $period =~ /^m/i ? $month + : $period =~ /^y/i ? $year + : 0 + ); + + my $now = time; + my @time = gmtime($now - $time); + join('-', $time[5] + 1900, sprintf('%02d', $time[4] + 1), sprintf('%02d', $time[3])) . 'T' + . join(':', sprintf('%02d', $time[2]), sprintf('%02d', $time[1]), sprintf('%02d', $time[0])) . 'Z'; +} + +=head1 AUTHOR + +Trizen, C<< >> + + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc WWW::FairViewer::Utils + + +=head1 LICENSE AND COPYRIGHT + +Copyright 2012-2020 Trizen. + +This program is free software; you can redistribute it and/or modify it +under the terms of either: the GNU General Public License as published +by the Free Software Foundation; or the Artistic License. + +See L for more information. + +=cut + +1; # End of WWW::FairViewer::Utils diff --git a/lib/WWW/FairViewer/VideoCategories.pm b/lib/WWW/FairViewer/VideoCategories.pm new file mode 100644 index 0000000..2930948 --- /dev/null +++ b/lib/WWW/FairViewer/VideoCategories.pm @@ -0,0 +1,97 @@ +package WWW::FairViewer::VideoCategories; + +use utf8; +use 5.014; +use warnings; + +=head1 NAME + +WWW::FairViewer::VideoCategories - videoCategory resource handler. + +=head1 SYNOPSIS + + use WWW::FairViewer; + my $obj = WWW::FairViewer->new(%opts); + my $cats = $obj->video_categories(); + +=head1 SUBROUTINES/METHODS + +=cut + +sub _make_videoCategories_url { + my ($self, %opts) = @_; + + $self->_make_feed_url( + 'videoCategories', + hl => $self->get_hl, + %opts, + ); +} + +=head2 video_categories() + +Return video categories for a specific region ID. + +=cut + +sub video_categories { + my ($self) = @_; + + require File::Spec; + + my $region = $self->get_regionCode() // 'US'; + my $url = $self->_make_videoCategories_url(regionCode => $region); + my $file = File::Spec->catfile($self->get_config_dir, "categories-$region-" . $self->get_hl() . ".json"); + + my $json; + if (open(my $fh, '<:utf8', $file)) { + local $/; + $json = <$fh>; + close $fh; + } + else { + $json = $self->lwp_get($url, simple => 1); + open my $fh, '>:utf8', $file; + print {$fh} $json; + close $fh; + } + + return $self->parse_json_string($json); +} + +=head2 video_category_id_info($cagegory_id) + +Return info for the comma-separated specified category ID(s). + +=cut + +sub video_category_id_info { + my ($self, $id) = @_; + return $self->_get_results($self->_make_videoCategories_url(id => $id)); +} + +=head1 AUTHOR + +Trizen, C<< >> + + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc WWW::FairViewer::VideoCategories + + +=head1 LICENSE AND COPYRIGHT + +Copyright 2013-2015 Trizen. + +This program is free software; you can redistribute it and/or modify it +under the terms of either: the GNU General Public License as published +by the Free Software Foundation; or the Artistic License. + +See L for more information. + +=cut + +1; # End of WWW::FairViewer::VideoCategories diff --git a/lib/WWW/FairViewer/Videos.pm b/lib/WWW/FairViewer/Videos.pm new file mode 100644 index 0000000..3e44b52 --- /dev/null +++ b/lib/WWW/FairViewer/Videos.pm @@ -0,0 +1,230 @@ +package WWW::FairViewer::Videos; + +use utf8; +use 5.014; +use warnings; + +=head1 NAME + +WWW::FairViewer::Videos - videos handler. + +=head1 SYNOPSIS + + use WWW::FairViewer; + my $obj = WWW::FairViewer->new(%opts); + my $info = $obj->video_details($videoID); + +=head1 SUBROUTINES/METHODS + +=cut + +sub _make_videos_url { + my ($self, %opts) = @_; + return $self->_make_feed_url('videos', %opts); +} + +{ + no strict 'refs'; + foreach my $part ( + qw( + id + snippet + contentDetails + fileDetails + player + liveStreamingDetails + processingDetails + recordingDetails + statistics + status + suggestions + topicDetails + ) + ) { + *{__PACKAGE__ . '::' . 'video_' . $part} = sub { + my ($self, $id) = @_; + return $self->_get_results($self->_make_videos_url(id => $id, part => $part)); + }; + } +} + +=head2 videos_from_category($category_id) + +Get videos from a category ID. + +=cut + +sub videos_from_category { + my ($self, $cat_id) = @_; + $self->_get_results( + $self->_make_videos_url( + chart => $self->get_chart, + videoCategoryId => $cat_id, + ) + ); +} + +=head2 trending_videos_from_category($category_id) + +Get popular videos from a category ID. + +=cut + +sub trending_videos_from_category { + my ($self, $cat_id) = @_; + + my $results = do { + local $self->{publishedAfter} = do { + state $yv_utils = WWW::FairViewer::Utils->new; + $yv_utils->period_to_date(1, 'w'); + } if !defined($self->get_publishedAfter); + local $self->{videoCategoryId} = $cat_id; + local $self->{regionCode} = "US" if !defined($self->get_regionCode); + $self->search_videos(""); + }; + + return $results; +} + +=head2 popular_videos($channel_id) + +Get the most popular videos for a given channel ID. + +=cut + +sub popular_videos { + my ($self, $id) = @_; + + my $results = do { + local $self->{channelId} = $id; + local $self->{order} = 'viewCount'; + $self->search_videos(""); + }; + + return $results; +} + +=head2 my_likes() + +Get the videos liked by the authenticated user. + +=cut + +sub my_likes { + my ($self) = @_; + $self->get_access_token() // return; + $self->_get_results($self->_make_videos_url(myRating => 'like', pageToken => $self->page_token)); +} + +=head2 my_dislikes() + +Get the videos disliked by the authenticated user. + +=cut + +sub my_dislikes { + my ($self) = @_; + $self->get_access_token() // return; + $self->_get_results($self->_make_videos_url(myRating => 'dislike', pageToken => $self->page_token)); +} + +=head2 send_rating_to_video($videoID, $rating) + +Send rating to a video. $rating can be either 'like' or 'dislike'. + +=cut + +sub send_rating_to_video { + my ($self, $video_id, $rating) = @_; + + if ($rating eq 'none' or $rating eq 'like' or $rating eq 'dislike') { + my $url = $self->_simple_feeds_url('videos/rate', id => $video_id, rating => $rating); + return defined($self->lwp_post($url, $self->_auth_lwp_header())); + } + + return; +} + +=head2 like_video($videoID) + +Like a video. Returns true on success. + +=cut + +sub like_video { + my ($self, $video_id) = @_; + $self->send_rating_to_video($video_id, 'like'); +} + +=head2 dislike_video($videoID) + +Dislike a video. Returns true on success. + +=cut + +sub dislike_video { + my ($self, $video_id) = @_; + $self->send_rating_to_video($video_id, 'dislike'); +} + +=head2 videos_details($id, $part) + +Get info about a videoID, such as: channelId, title, description, +tags, and categoryId. + +Available values for I are: I, I, I +I, I, I and I. + +C<$part> string can contain more values, comma-separated. + +Example: + + part => 'snippet,contentDetails,statistics' + +When C<$part> is C, it defaults to I. + +=cut + +sub video_details { + my ($self, $id, $fields) = @_; + $fields //= $self->basic_video_info_fields; + $self->_get_results($self->_make_feed_url("videos/$id", fields => $fields)); +} + +=head2 Return details + +Each function returns a HASH ref, with a key called 'results', and another key, called 'url'. + +The 'url' key contains a string, which is the URL for the retrieved content. + +The 'results' key contains another HASH ref with the keys 'etag', 'items' and 'kind'. +From the 'results' key, only the 'items' are relevant to us. This key contains an ARRAY ref, +with a HASH ref for each result. An example of the item array's content are shown below. + +=cut + +=head1 AUTHOR + +Trizen, C<< >> + + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc WWW::FairViewer::Videos + + +=head1 LICENSE AND COPYRIGHT + +Copyright 2013-2015 Trizen. + +This program is free software; you can redistribute it and/or modify it +under the terms of either: the GNU General Public License as published +by the Free Software Foundation; or the Artistic License. + +See L for more information. + +=cut + +1; # End of WWW::FairViewer::Videos diff --git a/lib/WWW/StrawViewer.pm b/lib/WWW/StrawViewer.pm deleted file mode 100644 index 934dfc9..0000000 --- a/lib/WWW/StrawViewer.pm +++ /dev/null @@ -1,1121 +0,0 @@ -package WWW::StrawViewer; - -use utf8; -use 5.016; -use warnings; - -use parent qw( - WWW::StrawViewer::Search - WWW::StrawViewer::Videos - WWW::StrawViewer::Channels - WWW::StrawViewer::Playlists - WWW::StrawViewer::ParseJSON - WWW::StrawViewer::Activities - WWW::StrawViewer::Subscriptions - WWW::StrawViewer::PlaylistItems - WWW::StrawViewer::CommentThreads - WWW::StrawViewer::Authentication - WWW::StrawViewer::VideoCategories - ); - -=head1 NAME - -WWW::StrawViewer - A very easy interface to YouTube, using the API of invidio.us. - -=cut - -our $VERSION = '0.0.1'; - -=head1 SYNOPSIS - - use WWW::StrawViewer; - - my $yv_obj = WWW::StrawViewer->new(); - ... - -=head1 SUBROUTINES/METHODS - -=cut - -my %valid_options = ( - - # Main options - v => {valid => q[], default => 3}, - page => {valid => [qr/^(?!0+\z)\d+\z/], default => 1}, - http_proxy => {valid => [qr{.}], default => undef}, - hl => {valid => [qr/^\w+(?:[\-_]\w+)?\z/], default => undef}, - maxResults => {valid => [1 .. 50], default => 10}, - topicId => {valid => [qr/^./], default => undef}, - order => {valid => [qw(relevance date rating viewCount title videoCount)], default => undef}, - publishedAfter => {valid => [qr/^\d+/], default => undef}, - publishedBefore => {valid => [qr/^\d+/], default => undef}, - channelId => {valid => [qr/^[-\w]{2,}\z/], default => undef}, - channelType => {valid => [qw(any show)], default => undef}, - - # Video only options - videoCaption => {valid => [qw(any closedCaption none)], default => undef}, - videoDefinition => {valid => [qw(any high standard)], default => undef}, - videoCategoryId => {valid => [qr/^\d+\z/], default => undef}, - videoDimension => {valid => [qw(any 2d 3d)], default => undef}, - videoDuration => {valid => [qw(any short medium long)], default => undef}, - videoEmbeddable => {valid => [qw(any true)], default => undef}, - videoLicense => {valid => [qw(any creativeCommon youtube)], default => undef}, - videoSyndicated => {valid => [qw(any true)], default => undef}, - eventType => {valid => [qw(completed live upcoming)], default => undef}, - chart => {valid => [qw(mostPopular)], default => 'mostPopular'}, - - regionCode => {valid => [qr/^[A-Z]{2}\z/i], default => undef}, - relevanceLanguage => {valid => [qr/^[a-z](?:\-\w+)?\z/i], default => undef}, - safeSearch => {valid => [qw(none moderate strict)], default => undef}, - videoType => {valid => [qw(any episode movie)], default => undef}, - - comments_order => {valid => [qw(top new)], default => 'top'}, - subscriptions_order => {valid => [qw(alphabetical relevance unread)], default => undef}, - - # Misc - debug => {valid => [0 .. 3], default => 0}, - lwp_timeout => {valid => [qr/^\d+\z/], default => 1}, - config_dir => {valid => [qr/^./], default => q{.}}, - cache_dir => {valid => [qr/^./], default => q{.}}, - - # Booleans - lwp_env_proxy => {valid => [1, 0], default => 1}, - escape_utf8 => {valid => [1, 0], default => 0}, - prefer_mp4 => {valid => [1, 0], default => 0}, - prefer_av1 => {valid => [1, 0], default => 0}, - - # API/OAuth - key => {valid => [qr/^.{15}/], default => undef}, - client_id => {valid => [qr/^.{15}/], default => undef}, - client_secret => {valid => [qr/^.{15}/], default => undef}, - redirect_uri => {valid => [qr/^.{15}/], default => undef}, - access_token => {valid => [qr/^.{15}/], default => undef}, - refresh_token => {valid => [qr/^.{15}/], default => undef}, - - authentication_file => {valid => [qr/^./], default => undef}, - api_host => {valid => [qr{^https?://}], default => "https://invidio.us"}, - - # No input value allowed - api_path => {valid => q[], default => '/api/v1/'}, - video_info_url => {valid => q[], default => 'https://www.youtube.com/get_video_info'}, - oauth_url => {valid => q[], default => 'https://accounts.google.com/o/oauth2/'}, - video_info_args => {valid => q[], default => '?video_id=%s&el=detailpage&ps=default&eurl=&gl=US&hl=en'}, - www_content_type => {valid => q[], default => 'application/x-www-form-urlencoded'}, - - # LWP user agent - lwp_agent => {valid => [qr/^.{5}/], default => 'Mozilla/5.0 (X11; U; Linux i686; gzip; en-US) Chrome/10.0.648.45'}, -); - -sub _our_smartmatch { - my ($value, $arg) = @_; - - $value // return 0; - - if (ref($arg) eq '') { - return ($value eq $arg); - } - - if (ref($arg) eq ref(qr//)) { - return scalar($value =~ $arg); - } - - if (ref($arg) eq 'ARRAY') { - foreach my $item (@$arg) { - return 1 if __SUB__->($value, $item); - } - } - - return 0; -} - -sub basic_video_info_fields { - join( - ',', - qw( - title - videoId - description - published - publishedText - viewCount - likeCount - dislikeCount - genre - author - authorId - lengthSeconds - rating - liveNow - ) - ); -} - -sub extra_video_info_fields { - my ($self) = @_; - join( - ',', - $self->basic_video_info_fields, - qw( - subCountText - captions - isFamilyFriendly - ) - ); -} - -{ - no strict 'refs'; - - foreach my $key (keys %valid_options) { - - if (ref $valid_options{$key}{valid} eq 'ARRAY') { - - # Create the 'set_*' subroutines - *{__PACKAGE__ . '::set_' . $key} = sub { - my ($self, $value) = @_; - $self->{$key} = - _our_smartmatch($value, $valid_options{$key}{valid}) - ? $value - : $valid_options{$key}{default}; - }; - } - - # Create the 'get_*' subroutines - *{__PACKAGE__ . '::get_' . $key} = sub { - my ($self) = @_; - - if (not exists $self->{$key}) { - return ($self->{$key} = $valid_options{$key}{default}); - } - - $self->{$key}; - }; - } -} - -=head2 new(%opts) - -Returns a blessed object. - -=cut - -sub new { - my ($class, %opts) = @_; - - my $self = bless {}, $class; - - foreach my $key (keys %valid_options) { - if (exists $opts{$key}) { - my $method = "set_$key"; - $self->$method(delete $opts{$key}); - } - } - - foreach my $invalid_key (keys %opts) { - warn "Invalid key: '${invalid_key}'"; - } - - return $self; -} - -sub page_token { - my ($self) = @_; - - my $page = $self->get_page; - - # Don't generate the token for the first page - return undef if $page == 1; - - my $index = $page * $self->get_maxResults() - $self->get_maxResults(); - my $k = int($index / 128) - 1; - $index -= 128 * $k; - - my @f = (8, $index); - if ($k > 0 or $index > 127) { - push @f, $k + 1; - } - - require MIME::Base64; - MIME::Base64::encode_base64(pack('C*', @f, 16, 0)) =~ tr/=\n//dr; -} - -=head2 escape_string($string) - -Escapes a string with URI::Escape and returns it. - -=cut - -sub escape_string { - my ($self, $string) = @_; - - require URI::Escape; - - $self->get_escape_utf8 - ? URI::Escape::uri_escape_utf8($string) - : URI::Escape::uri_escape($string); -} - -=head2 set_lwp_useragent() - -Initializes the LWP::UserAgent module and returns it. - -=cut - -sub set_lwp_useragent { - my ($self) = @_; - - my $lwp = ( - eval { require LWP::UserAgent::Cached; 'LWP::UserAgent::Cached' } - // do { require LWP::UserAgent; 'LWP::UserAgent' } - ); - - $self->{lwp} = $lwp->new( - - cookie_jar => {}, # temporary cookies - timeout => $self->get_lwp_timeout, - show_progress => $self->get_debug, - agent => $self->get_lwp_agent, - - ssl_opts => {verify_hostname => 1, SSL_version => 'TLSv1_2'}, - - $lwp eq 'LWP::UserAgent::Cached' - ? ( - cache_dir => $self->get_cache_dir, - nocache_if => sub { - my ($response) = @_; - my $code = $response->code; - - $code >= 300 # do not cache any bad response - or $response->request->method ne 'GET' # cache only GET requests - - # don't cache if "cache-control" specifies "max-age=0" or "no-store" - or (($response->header('cache-control') // '') =~ /\b(?:max-age=0|no-store)\b/) - - # don't cache video or audio files - or (($response->header('content-type') // '') =~ /\b(?:video|audio)\b/); - }, - - recache_if => sub { - my ($response, $path) = @_; - not($response->is_fresh) # recache if the response expired - or ($response->code == 404 && -M $path > 1); # recache any 404 response older than 1 day - } - ) - : (), - - env_proxy => (defined($self->get_http_proxy) ? 0 : $self->get_lwp_env_proxy), - ); - - require LWP::ConnCache; - state $cache = LWP::ConnCache->new; - $cache->total_capacity(undef); # no limit - - state $accepted_encodings = do { - require HTTP::Message; - HTTP::Message::decodable(); - }; - - my $agent = $self->{lwp}; - $agent->ssl_opts(Timeout => 30); - $agent->default_header('Accept-Encoding' => $accepted_encodings); - $agent->conn_cache($cache); - $agent->proxy(['http', 'https'], $self->get_http_proxy) if defined($self->get_http_proxy); - - push @{$self->{lwp}->requests_redirectable}, 'POST'; - return $self->{lwp}; -} - -=head2 prepare_access_token() - -Returns a string. used as header, with the access token. - -=cut - -sub prepare_access_token { - my ($self) = @_; - - if (defined(my $auth = $self->get_access_token)) { - return "Bearer $auth"; - } - - return; -} - -sub _auth_lwp_header { - my ($self) = @_; - - my %lwp_header; - if (defined $self->get_access_token) { - $lwp_header{'Authorization'} = $self->prepare_access_token; - } - - return %lwp_header; -} - -sub _warn_reponse_error { - my ($resp, $url) = @_; - warn sprintf("[%s] Error occurred on URL: %s\n", $resp->status_line, $url =~ s/([&?])key=(.*?)&/${1}key=[...]&/r); -} - -=head2 lwp_get($url, %opt) - -Get and return the content for $url. - -Where %opt can be: - - simple => [bool] - -When the value of B is set to a true value, the -authentication header will not be set in the HTTP request. - -=cut - -sub lwp_get { - my ($self, $url, %opt) = @_; - - $url // return; - $self->{lwp} // $self->set_lwp_useragent(); - - my %lwp_header = ($opt{simple} ? () : $self->_auth_lwp_header); - my $response = $self->{lwp}->get($url, %lwp_header); - - if ($response->is_success) { - return $response->decoded_content; - } - - if ($response->status_line() =~ /^401 / and defined($self->get_refresh_token)) { - if (defined(my $refresh_token = $self->oauth_refresh_token())) { - if (defined $refresh_token->{access_token}) { - - $self->set_access_token($refresh_token->{access_token}); - - # Don't be tempted to use recursion here, because bad things will happen! - $response = $self->{lwp}->get($url, $self->_auth_lwp_header); - - if ($response->is_success) { - $self->save_authentication_tokens(); - return $response->decoded_content; - } - elsif ($response->status_line() =~ /^401 /) { - $self->set_refresh_token(); # refresh token was invalid - $self->set_access_token(); # access token is also broken - warn "[!] Can't refresh the access token! Logging out...\n"; - } - } - else { - warn "[!] Can't get the access_token! Logging out...\n"; - $self->set_refresh_token(); - $self->set_access_token(); - } - } - else { - warn "[!] Invalid refresh_token! Logging out...\n"; - $self->set_refresh_token(); - $self->set_access_token(); - } - } - - $opt{depth} ||= 0; - - # Try again on 500+ HTTP errors - if ( $opt{depth} < 3 - and $response->code() >= 500 - and $response->status_line() =~ /(?:Temporary|Server) Error|Timeout|Service Unavailable/i) { - return $self->lwp_get($url, %opt, depth => $opt{depth} + 1); - } - - _warn_reponse_error($response, $url); - return; -} - -=head2 lwp_post($url, [@args]) - -Post and return the content for $url. - -=cut - -sub lwp_post { - my ($self, $url, @args) = @_; - - $self->{lwp} // $self->set_lwp_useragent(); - - my $response = $self->{lwp}->post($url, @args); - - if ($response->is_success) { - return $response->decoded_content; - } - else { - _warn_reponse_error($response, $url); - } - - return; -} - -=head2 lwp_mirror($url, $output_file) - -Downloads the $url into $output_file. Returns true on success. - -=cut - -sub lwp_mirror { - my ($self, $url, $output_file) = @_; - $self->{lwp} // $self->set_lwp_useragent(); - $self->{lwp}->mirror($url, $output_file); -} - -sub _get_results { - my ($self, $url, %opt) = @_; - - return - scalar { - url => $url, - results => $self->parse_json_string($self->lwp_get($url, %opt)), - }; -} - -=head2 list_to_url_arguments(\%options) - -Returns a valid string of arguments, with defined values. - -=cut - -sub list_to_url_arguments { - my ($self, %args) = @_; - join(q{&}, map { "$_=$args{$_}" } grep { defined $args{$_} } sort keys %args); -} - -sub _append_url_args { - my ($self, $url, %args) = @_; - %args - ? ($url . ($url =~ /\?/ ? '&' : '?') . $self->list_to_url_arguments(%args)) - : $url; -} - -sub get_api_url { - my ($self) = @_; - join('', $self->get_api_host, $self->get_api_path); -} - -sub _simple_feeds_url { - my ($self, $path, %args) = @_; - $self->get_api_url . $path . '?' . $self->list_to_url_arguments(key => $self->get_key, %args); -} - -=head2 default_arguments(%args) - -Merge the default arguments with %args and concatenate them together. - -=cut - -sub default_arguments { - my ($self, %args) = @_; - - my %defaults = ( - - #key => $self->get_key, - #part => 'snippet', - #prettyPrint => 'false', - #maxResults => $self->get_maxResults, - #regionCode => $self->get_regionCode, - %args, - ); - - $self->list_to_url_arguments(%defaults); -} - -sub _make_feed_url { - my ($self, $path, %args) = @_; - my $extra_args = $self->default_arguments(%args); - my $url = $self->get_api_url . $path; - - if ($extra_args) { - $url .= '?' . $extra_args; - } - - return $url; -} - -sub _extract_from_invidious { - my ($self, $videoID) = @_; - - my $url = sprintf("https://invidio.us/api/v1/videos/%s?fields=formatStreams,adaptiveFormats", $videoID); - - my $tries = 3; - my $resp = $self->{lwp}->get($url); - - while (not $resp->is_success() and $resp->status_line() =~ /read timeout/i and --$tries >= 0) { - $resp = $self->{lwp}->get($url); - } - - $resp->is_success() || return; - - my $json = $resp->decoded_content() // return; - my $ref = $self->parse_json_string($json) // return; - - my @formats; - - # The entries are already in the format that we want. - if (exists($ref->{adaptiveFormats}) and ref($ref->{adaptiveFormats}) eq 'ARRAY') { - push @formats, @{$ref->{adaptiveFormats}}; - } - - if (exists($ref->{formatStreams}) and ref($ref->{formatStreams}) eq 'ARRAY') { - push @formats, @{$ref->{formatStreams}}; - } - - return @formats; -} - -sub _ytdl_is_available { - (state $x = system('youtube-dl', '--version')) == 0; -} - -sub _extract_from_ytdl { - my ($self, $videoID) = @_; - - $self->_ytdl_is_available() || return; - - my $json = $self->proxy_stdout('youtube-dl', '--all-formats', '--dump-single-json', - quotemeta("https://www.youtube.com/watch?v=" . $videoID)); - - my $ref = $self->parse_json_string($json); - - my @formats; - if (ref($ref) eq 'HASH' and exists($ref->{formats}) and ref($ref->{formats}) eq 'ARRAY') { - foreach my $format (@{$ref->{formats}}) { - if (exists($format->{format_id}) and exists($format->{url})) { - - my $entry = { - itag => $format->{format_id}, - url => $format->{url}, - type => ((($format->{format} // '') =~ /audio only/i) ? 'audio/' : 'video/') . $format->{ext}, - }; - - push @formats, $entry; - } - } - } - - return @formats; -} - -sub _fallback_extract_urls { - my ($self, $videoID) = @_; - - my @formats; - - if ($self->_ytdl_is_available) { - if ($self->get_debug) { - say STDERR ":: Using youtube-dl to extract the streaming URLs..."; - } - - push @formats, $self->_extract_from_ytdl($videoID); - - if ($self->get_debug) { - my $count = scalar(@formats); - say STDERR ":: Found $count streaming URLs..."; - } - - return @formats; - } - - # Use the API of invidio.us - if ($self->get_debug) { - say STDERR ":: Using invidio.us to extract the streaming URLs..."; - } - - push @formats, $self->_extract_from_invidious($videoID); - - if ($self->get_debug) { - say STDERR ":: Found ", scalar(@formats), " streaming URLs."; - } - - return @formats; -} - -=head2 parse_query_string($string, multi => [0,1]) - -Parse a query string and return a data structure back. - -When the B option is set to a true value, the function will store multiple values for a given key. - -Returns back a list of key-value pairs. - -=cut - -sub parse_query_string { - my ($self, $str, %opt) = @_; - - if (not defined($str)) { - return; - } - - require URI::Escape; - - my @pairs; - foreach my $statement (split(/,/, $str)) { - foreach my $pair (split(/&/, $statement)) { - push @pairs, $pair; - } - } - - my %result; - - foreach my $pair (@pairs) { - my ($key, $value) = split(/=/, $pair, 2); - - if (not defined($value) or $value eq '') { - next; - } - - $value = URI::Escape::uri_unescape($value =~ tr/+/ /r); - - if ($opt{multi}) { - push @{$result{$key}}, $value; - } - else { - $result{$key} = $value; - } - } - - return %result; -} - -sub _group_keys_with_values { - my ($self, %data) = @_; - - my @hashes; - - foreach my $key (keys %data) { - foreach my $i (0 .. $#{$data{$key}}) { - $hashes[$i]{$key} = $data{$key}[$i]; - } - } - - return @hashes; -} - -sub _old_extract_streaming_urls { - my ($self, $info, $videoID) = @_; - - if ($self->get_debug) { - say STDERR ":: Using `url_encoded_fmt_stream_map` to extract the streaming URLs..."; - } - - my %stream_map = $self->parse_query_string($info->{url_encoded_fmt_stream_map}, multi => 1); - my %adaptive_fmts = $self->parse_query_string($info->{adaptive_fmts}, multi => 1); - - if ($self->get_debug >= 2) { - require Data::Dump; - Data::Dump::pp(\%stream_map); - Data::Dump::pp(\%adaptive_fmts); - } - - my @results; - - push @results, $self->_group_keys_with_values(%stream_map); - push @results, $self->_group_keys_with_values(%adaptive_fmts); - - foreach my $video (@results) { - if (exists $video->{s}) { # has an encrypted signature :( - - if ($self->get_debug) { - say STDERR ":: Detected an encrypted signature..."; - } - - my @formats = $self->_fallback_extract_urls($videoID); - - foreach my $format (@formats) { - foreach my $ref (@results) { - if (defined($ref->{itag}) and ($ref->{itag} eq $format->{itag})) { - $ref->{url} = $format->{url}; - last; - } - } - } - - last; - } - } - - if ($info->{livestream} or $info->{live_playback}) { - - if ($self->get_debug) { - say STDERR ":: Live stream detected..."; - } - - if (my @formats = $self->_fallback_extract_urls($videoID)) { - @results = @formats; - } - elsif (exists $info->{hlsvp}) { - push @results, - { - itag => 38, - type => 'video/ts', - url => $info->{hlsvp}, - }; - } - } - - if ($self->get_debug) { - my $count = scalar(@results); - say STDERR ":: Found $count streaming URLs..."; - } - - return @results; -} - -sub _extract_streaming_urls { - my ($self, $info, $videoID) = @_; - - if (exists $info->{url_encoded_fmt_stream_map}) { - return $self->_old_extract_streaming_urls($info, $videoID); - } - - if ($self->get_debug) { - say STDERR ":: Using `player_response` to extract the streaming URLs..."; - } - - my $json = $self->parse_json_string($info->{player_response} // return); - - if ($self->get_debug >= 2) { - require Data::Dump; - Data::Dump::pp($json); - } - - ref($json) eq 'HASH' or return; - - my @results; - if (exists $json->{streamingData}) { - - my $streamingData = $json->{streamingData}; - - if (exists $streamingData->{adaptiveFormats}) { - push @results, @{$streamingData->{adaptiveFormats}}; - } - - if (exists $streamingData->{formats}) { - push @results, @{$streamingData->{formats}}; - } - } - - foreach my $item (@results) { - - if (exists $item->{cipher} and not exists $item->{url}) { - - my %data = $self->parse_query_string($item->{cipher}); - - $item->{url} = $data{url} if defined($data{url}); - - if (defined($data{s})) { # unclear how this can be decrypted... - require URI::Escape; - my $sig = $data{s}; - $sig = URI::Escape::uri_escape($sig); - $item->{url} .= "&sig=$sig"; - } - } - - if (exists $item->{mimeType}) { - $item->{type} = $item->{mimeType}; - } - } - - # Cipher streaming URLs are currently unsupported, so let's filter them out. - @results = grep { not exists $_->{cipher} } @results; - - # Keep only streams with contentLength > 0. - @results = grep { exists($_->{contentLength}) and $_->{contentLength} > 0 } @results; - - # Detect livestream - if (!@results and exists($json->{streamingData}) and exists($json->{streamingData}{hlsManifestUrl})) { - - if ($self->get_debug) { - say STDERR ":: Live stream detected..."; - } - - @results = $self->_fallback_extract_urls($videoID); - - if (!@results) { - push @results, - { - itag => 38, - type => "video/ts", - url => $json->{streamingData}{hlsManifestUrl}, - }; - } - } - - if ($self->get_debug) { - my $count = scalar(@results); - say STDERR ":: Found $count streaming URLs..."; - } - - return @results; -} - -sub _get_video_info { - my ($self, $videoID) = @_; - - my $url = $self->get_video_info_url() . sprintf($self->get_video_info_args(), $videoID); - my $content = $self->lwp_get($url, simple => 1) // return; - my %info = $self->parse_query_string($content); - - return %info; -} - -=head2 get_streaming_urls($videoID) - -Returns a list of streaming URLs for a videoID. -({itag=>..., url=>...}, {itag=>..., url=>....}, ...) - -=cut - -sub get_streaming_urls { - my ($self, $videoID) = @_; - - my %info = $self->_get_video_info($videoID); - my @streaming_urls = $self->_extract_streaming_urls(\%info, $videoID); - - my @caption_urls; - if (exists $info{player_response}) { - - require URI::Escape; - my $captions_json = URI::Escape::uri_unescape($info{player_response}); - my $caption_data = $self->parse_json_string($captions_json); - - if (eval { ref($caption_data->{captions}{playerCaptionsTracklistRenderer}{captionTracks}) eq 'ARRAY' }) { - push @caption_urls, @{$caption_data->{captions}{playerCaptionsTracklistRenderer}{captionTracks}}; - } - } - - # Try again with youtube-dl - if (!@streaming_urls or $info{status} =~ /fail|error/i) { - @streaming_urls = $self->_fallback_extract_urls($videoID); - } - - if ($self->get_prefer_mp4 or $self->get_prefer_av1) { - - my @video_urls; - my @audio_urls; - - require WWW::StrawViewer::Itags; - - my %audio_itags; - @audio_itags{@{WWW::StrawViewer::Itags->get_itags->{audio}}} = (); - - foreach my $url (@streaming_urls) { - - if (exists($audio_itags{$url->{itag}})) { - push @audio_urls, $url; - next; - } - - if ($url->{type} =~ /\bvideo\b/i) { - if ($self->get_prefer_mp4 and $url->{type} =~ /\bmp4\b/i) { - push @video_urls, $url; - } - elsif ($self->get_prefer_av1 and $url->{type} =~ /\bav[0-9]+\b/i) { - push @video_urls, $url; - } - } - else { - push @audio_urls, $url; - } - } - - if (@video_urls) { - @streaming_urls = (@video_urls, @audio_urls); - } - } - - # Filter out streams with `clen = 0`. - @streaming_urls = grep { defined($_->{clen}) ? ($_->{clen} > 0) : 1 } @streaming_urls; - - # Return the YouTube URL when there are no streaming URLs - if (!@streaming_urls) { - push @streaming_urls, - { - itag => 38, - type => "video/mp4", - url => "https://www.youtube.com/watch?v=$videoID", - }; - } - - if ($self->get_debug >= 2) { - require Data::Dump; - Data::Dump::pp(\%info) if ($self->get_debug >= 3); - Data::Dump::pp(\@streaming_urls); - Data::Dump::pp(\@caption_urls); - } - - return (\@streaming_urls, \@caption_urls, \%info); -} - -sub _request { - my ($self, $req) = @_; - - $self->{lwp} // $self->set_lwp_useragent(); - - my $res = $self->{lwp}->request($req); - - if ($res->is_success) { - return $res->decoded_content; - } - else { - warn 'Request error: ' . $res->status_line(); - } - - return; -} - -sub _prepare_request { - my ($self, $req, $length) = @_; - - $req->header('Content-Length' => $length) if ($length); - - if (defined $self->get_access_token) { - $req->header('Authorization' => $self->prepare_access_token); - } - - return 1; -} - -sub _save { - my ($self, $method, $uri, $content) = @_; - - require HTTP::Request; - my $req = HTTP::Request->new($method => $uri); - $req->content_type('application/json; charset=UTF-8'); - $self->_prepare_request($req, length($content)); - $req->content($content); - - $self->_request($req); -} - -sub post_as_json { - my ($self, $url, $ref) = @_; - my $json_str = $self->make_json_string($ref); - $self->_save('POST', $url, $json_str); -} - -sub next_page_with_token { - my ($self, $url, $token) = @_; - - my $pt_url = ( - $url =~ s{[?&]continuation=\K([^&]+)}{$token} - ? $url - : $self->_append_url_args($url, continuation => $token) - ); - - my $res = $self->_get_results($pt_url); - $res->{url} = $pt_url; - return $res; -} - -sub next_page { - my ($self, $url) = @_; - - my $pt_url = ( - $url =~ s{[?&]page=\K(\d+)}{$1+1}e - ? $url - : $self->_append_url_args($url, page => 2) - ); - - my $res = $self->_get_results($pt_url); - $res->{url} = $pt_url; - return $res; -} - -sub previous_page { - my ($self, $url) = @_; - - my $pt_url = ( - $url =~ s{[?&]page=\K(\d+)}{($1 > 2) ? ($1-1) : 1}e - ? $url - : $url - ); - - my $res = $self->_get_results($pt_url); - $res->{url} = $pt_url; - return $res; -} - -# SUBROUTINE FACTORY -{ - no strict 'refs'; - - # Create proxy_{exec,system} subroutines - foreach my $name ('exec', 'system', 'stdout') { - *{__PACKAGE__ . '::proxy_' . $name} = sub { - my ($self, @args) = @_; - - $self->{lwp} // $self->set_lwp_useragent(); - - local $ENV{http_proxy} = $self->{lwp}->proxy('http'); - local $ENV{https_proxy} = $self->{lwp}->proxy('https'); - - local $ENV{HTTP_PROXY} = $self->{lwp}->proxy('http'); - local $ENV{HTTPS_PROXY} = $self->{lwp}->proxy('https'); - - $name eq 'exec' ? exec(@args) - : $name eq 'system' ? system(@args) - : $name eq 'stdout' ? qx(@args) - : (); - }; - } -} - -=head1 AUTHOR - -Trizen, C<< >> - -=head1 SEE ALSO - -https://developers.google.com/youtube/v3/docs/ - -=head1 LICENSE AND COPYRIGHT - -Copyright 2012-2015 Trizen. - -This program is free software; you can redistribute it and/or modify it -under the terms of the the Artistic License (2.0). You may obtain a -copy of the full license at: - -L - -Any use, modification, and distribution of the Standard or Modified -Versions is governed by this Artistic License. By using, modifying or -distributing the Package, you accept this license. Do not use, modify, -or distribute the Package, if you do not accept this license. - -If your Modified Version has been derived from a Modified Version made -by someone other than you, you are nevertheless required to ensure that -your Modified Version complies with the requirements of this license. - -This license does not grant you the right to use any trademark, service -mark, tradename, or logo of the Copyright Holder. - -This license includes the non-exclusive, worldwide, free-of-charge -patent license to make, have made, use, offer to sell, sell, import and -otherwise transfer the Package with respect to any patent claims -licensable by the Copyright Holder that are necessarily infringed by the -Package. If you institute patent litigation (including a cross-claim or -counterclaim) against any party alleging that the Package constitutes -direct or contributory patent infringement, then this Artistic License -to you shall terminate on the date that such litigation is filed. - -Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER -AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. -THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR -PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY -YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR -CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR -CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, -EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - - -=cut - -1; # End of WWW::StrawViewer - -__END__ diff --git a/lib/WWW/StrawViewer/Activities.pm b/lib/WWW/StrawViewer/Activities.pm deleted file mode 100644 index 39a6a3d..0000000 --- a/lib/WWW/StrawViewer/Activities.pm +++ /dev/null @@ -1,93 +0,0 @@ -package WWW::StrawViewer::Activities; - -use utf8; -use 5.014; -use warnings; - -=head1 NAME - -WWW::StrawViewer::Activities - list of channel activity events that match the request criteria. - -=head1 SYNOPSIS - - use WWW::StrawViewer; - my $obj = WWW::StrawViewer->new(%opts); - my $activities = $obj->activities($channel_id); - -=head1 SUBROUTINES/METHODS - -=cut - -sub _make_activities_url { - my ($self, %opts) = @_; - $self->_make_feed_url('activities', part => 'snippet,contentDetails', %opts); -} - -=head2 activities($channel_id) - -Get activities for channel ID. - -=cut - -sub activities { - my ($self, $channel_id) = @_; - - if ($channel_id eq 'mine') { - return $self->my_activities; - } - - if ($channel_id !~ /^UC/) { - $channel_id = $self->channel_id_from_username($channel_id) // $channel_id; - } - - $self->_get_results($self->_make_activities_url(channelId => $channel_id)); -} - -=head2 activities_from_username($username) - -Get activities for username. - -=cut - -sub activities_from_username { - my ($self, $username) = @_; - return $self->activities($username); -} - -=head2 my_activities() - -Get authenticated user's activities. - -=cut - -sub my_activities { - my ($self) = @_; - $self->get_access_token() // return; - $self->_get_results($self->_make_activities_url(mine => 'true')); -} - -=head1 AUTHOR - -Trizen, C<< >> - - -=head1 SUPPORT - -You can find documentation for this module with the perldoc command. - - perldoc WWW::StrawViewer::Activities - - -=head1 LICENSE AND COPYRIGHT - -Copyright 2013-2015 Trizen. - -This program is free software; you can redistribute it and/or modify it -under the terms of either: the GNU General Public License as published -by the Free Software Foundation; or the Artistic License. - -See L for more information. - -=cut - -1; # End of WWW::StrawViewer::Activities diff --git a/lib/WWW/StrawViewer/Authentication.pm b/lib/WWW/StrawViewer/Authentication.pm deleted file mode 100644 index 1fa2368..0000000 --- a/lib/WWW/StrawViewer/Authentication.pm +++ /dev/null @@ -1,216 +0,0 @@ -package WWW::StrawViewer::Authentication; - -use utf8; -use 5.014; -use warnings; - -=head1 NAME - -WWW::StrawViewer::Authentication - OAuth login support. - -=head1 SYNOPSIS - - use WWW::StrawViewer; - my $hash_ref = WWW::StrawViewer->oauth_login($code); - -=head1 SUBROUTINES/METHODS - -=cut - -sub _get_token_oauth_url { - my ($self) = @_; - return $self->get_oauth_url() . 'token'; -} - -=head2 oauth_refresh_token() - -Refresh the access_token using the refresh_token. Returns a HASH ref with the `access_token` or undef. - -=cut - -sub oauth_refresh_token { - my ($self) = @_; - - my $json_data = $self->lwp_post( - $self->_get_token_oauth_url(), - [Content => $self->get_www_content_type, - client_id => $self->get_client_id() // return, - client_secret => $self->get_client_secret() // return, - refresh_token => $self->get_refresh_token() // return, - grant_type => 'refresh_token', - ] - ); - - return $self->parse_json_string($json_data); -} - -=head2 get_accounts_oauth_url() - -Creates an OAuth URL with the 'code' response type. (Google's authorization server) - -=cut - -sub get_accounts_oauth_url { - my ($self) = @_; - - my $url = $self->_append_url_args( - ($self->get_oauth_url() . 'auth'), - response_type => 'code', - client_id => $self->get_client_id() // return, - redirect_uri => $self->get_redirect_uri() // return, - scope => 'https://www.googleapis.com/auth/youtube.force-ssl', - access_type => 'offline', - ); - return $url; -} - -=head2 oauth_login($code) - -Returns a HASH ref with the access_token, refresh_token and some other info. - -The $code can be obtained by going to the URL returned by the C method. - -=cut - -sub oauth_login { - my ($self, $code) = @_; - - length($code) < 20 and return; - - my $json_data = $self->lwp_post( - $self->_get_token_oauth_url(), - [Content => $self->get_www_content_type, - client_id => $self->get_client_id() // return, - client_secret => $self->get_client_secret() // return, - redirect_uri => $self->get_redirect_uri() // return, - grant_type => 'authorization_code', - code => $code, - ] - ); - - return $self->parse_json_string($json_data); -} - -sub __AUTH_EOL__() { "\0\0\0" } - -=head2 load_authentication_tokens() - -Will try to load the access and refresh tokens from I. - -=cut - -sub load_authentication_tokens { - my ($self) = @_; - - if (defined $self->get_access_token and defined $self->get_refresh_token) { - return 1; - } - - my $file = $self->get_authentication_file() // return; - my $key = $self->get_key() // return; - - if (-f $file) { - local $/ = __AUTH_EOL__; - open my $fh, '<:raw', $file or return; - - my @tokens; - foreach my $i (0 .. 1) { - chomp(my $token = <$fh>); - $token =~ /\S/ || last; - push @tokens, $self->decode_token($token); - } - - $self->set_access_token($tokens[0]) // return; - $self->set_refresh_token($tokens[1]) // return; - - close $fh; - return 1; - } - - return; -} - -=head2 encode_token($token) - -Encode the token with the I and return it. - -=cut - -sub encode_token { - my ($self, $token) = @_; - - if (defined(my $key = $self->get_key)) { - require MIME::Base64; - return MIME::Base64::encode_base64($token ^ substr($key, -length($token))); - } - - return; -} - -=head2 decode_token($token) - -Decode the token with the I and return it. - -=cut - -sub decode_token { - my ($self, $token) = @_; - - if (defined(my $key = $self->get_key)) { - require MIME::Base64; - my $bin = MIME::Base64::decode_base64($token); - return $bin ^ substr($key, -length($bin)); - } - - return; -} - -=head2 save_authentication_tokens() - -Encode and save the access and refresh into the I. - -=cut - -sub save_authentication_tokens { - my ($self) = @_; - - my $file = $self->get_authentication_file() // return; - my $access_token = $self->get_access_token() // return; - my $refresh_token = $self->get_refresh_token() // return; - - if (open my $fh, '>:raw', $file) { - foreach my $token ($access_token, $refresh_token) { - print {$fh} $self->encode_token($token) . __AUTH_EOL__; - } - close $fh; - return 1; - } - - return; -} - -=head1 AUTHOR - -Trizen, C<< >> - - -=head1 SUPPORT - -You can find documentation for this module with the perldoc command. - - perldoc WWW::StrawViewer::Authentication - - -=head1 LICENSE AND COPYRIGHT - -Copyright 2013-2015 Trizen. - -This program is free software; you can redistribute it and/or modify it -under the terms of either: the GNU General Public License as published -by the Free Software Foundation; or the Artistic License. - -See L for more information. - -=cut - -1; # End of WWW::StrawViewer::Authentication diff --git a/lib/WWW/StrawViewer/Channels.pm b/lib/WWW/StrawViewer/Channels.pm deleted file mode 100644 index b2c2c99..0000000 --- a/lib/WWW/StrawViewer/Channels.pm +++ /dev/null @@ -1,200 +0,0 @@ -package WWW::StrawViewer::Channels; - -use utf8; -use 5.014; -use warnings; - -=head1 NAME - -WWW::StrawViewer::Channels - Channels interface. - -=head1 SYNOPSIS - - use WWW::StrawViewer; - my $obj = WWW::StrawViewer->new(%opts); - my $videos = $obj->channels_from_categoryID($category_id); - -=head1 SUBROUTINES/METHODS - -=cut - -sub _make_channels_url { - my ($self, %opts) = @_; - return $self->_make_feed_url('channels', %opts); -} - -sub videos_from_channel_id { - my ($self, $channel_id) = @_; - return $self->_get_results($self->_make_feed_url("channels/$channel_id/videos")); -} - -sub videos_from_username { - my ($self, $channel_id) = @_; - return $self->_get_results($self->_make_feed_url("channels/$channel_id/videos")); -} - -=head2 channels_from_categoryID($category_id) - -Return the YouTube channels associated with the specified category. - -=head2 channels_info($channel_id) - -Return information for the comma-separated list of the YouTube channel ID(s). - -=head1 Channel details - -For all functions, C<$channels->{results}{items}> contains: - -=cut - -{ - no strict 'refs'; - - foreach my $method ( - { - key => 'categoryId', - name => 'channels_from_guide_category', - }, - { - key => 'id', - name => 'channels_info', - }, - { - key => 'forUsername', - name => 'channels_from_username', - }, - ) { - *{__PACKAGE__ . '::' . $method->{name}} = sub { - my ($self, $channel_id) = @_; - return $self->_get_results($self->_make_channels_url($method->{key} => $channel_id)); - }; - } - - foreach my $part (qw(id contentDetails statistics topicDetails)) { - *{__PACKAGE__ . '::' . 'channels_' . $part} = sub { - my ($self, $id) = @_; - return $self->_get_results($self->_make_channels_url(id => $id, part => $part)); - }; - } -} - -=head2 my_channel() - -Returns info about the channel of the current authenticated user. - -=cut - -sub my_channel { - my ($self) = @_; - $self->get_access_token() // return; - return $self->_get_results($self->_make_channels_url(part => 'snippet', mine => 'true')); -} - -=head2 my_channel_id() - -Returns the channel ID of the current authenticated user. - -=cut - -sub my_channel_id { - my ($self) = @_; - - state $cache = {}; - - if (exists $cache->{id}) { - return $cache->{id}; - } - - $cache->{id} = undef; - my $channel = $self->my_channel() // return; - $cache->{id} = $channel->{results}{items}[0]{id} // return; -} - -=head2 channels_my_subscribers() - -Retrieve a list of channels that subscribed to the authenticated user's channel. - -=cut - -sub channels_my_subscribers { - my ($self) = @_; - $self->get_access_token() // return; - return $self->_get_results($self->_make_channels_url(mySubscribers => 'true')); -} - -=head2 channel_id_from_username($username) - -Return the channel ID for an username. - -=cut - -sub channel_id_from_username { - my ($self, $username) = @_; - - state $username_lookup = {}; - - if (exists $username_lookup->{$username}) { - return $username_lookup->{$username}; - } - - $username_lookup->{$username} = undef; - my $channel = $self->channels_from_username($username) // return; - $username_lookup->{$username} = $channel->{results}{items}[0]{id} // return; -} - -=head2 channel_title_from_id($channel_id) - -Return the channel title for a given channel ID. - -=cut - -sub channel_title_from_id { - my ($self, $channel_id) = @_; - - if ($channel_id eq 'mine') { - $channel_id = $self->my_channel_id(); - } - - my $info = $self->channels_info($channel_id // return) // return; - - ( ref($info) eq 'HASH' - and ref($info->{results}) eq 'HASH' - and ref($info->{results}{items}) eq 'ARRAY' - and ref($info->{results}{items}[0]) eq 'HASH') - ? $info->{results}{items}[0]{snippet}{title} - : (); -} - -=head2 channels_contentDetails($channelID) - -=head2 channels_statistics($channelID); - -=head2 channels_topicDetails($channelID) - -=cut - -=head1 AUTHOR - -Trizen, C<< >> - - -=head1 SUPPORT - -You can find documentation for this module with the perldoc command. - - perldoc WWW::StrawViewer::Channels - - -=head1 LICENSE AND COPYRIGHT - -Copyright 2013-2015 Trizen. - -This program is free software; you can redistribute it and/or modify it -under the terms of either: the GNU General Public License as published -by the Free Software Foundation; or the Artistic License. - -See L for more information. - -=cut - -1; # End of WWW::StrawViewer::Channels diff --git a/lib/WWW/StrawViewer/CommentThreads.pm b/lib/WWW/StrawViewer/CommentThreads.pm deleted file mode 100644 index 1eba143..0000000 --- a/lib/WWW/StrawViewer/CommentThreads.pm +++ /dev/null @@ -1,98 +0,0 @@ -package WWW::StrawViewer::CommentThreads; - -use utf8; -use 5.014; -use warnings; - -=head1 NAME - -WWW::StrawViewer::CommentThreads - Retrieve comments threads. - -=head1 SYNOPSIS - - use WWW::StrawViewer; - my $obj = WWW::StrawViewer->new(%opts); - my $videos = $obj->comments_from_video_id($video_id); - -=head1 SUBROUTINES/METHODS - -=cut - -sub _make_commentThreads_url { - my ($self, %opts) = @_; - return - $self->_make_feed_url( - 'commentThreads', - pageToken => $self->page_token, - %opts - ); -} - -=head2 comments_from_videoID($videoID) - -Retrieve comments from a video ID. - -=cut - -sub comments_from_video_id { - my ($self, $video_id) = @_; - $self->_get_results( - $self->_make_feed_url("comments/$video_id", - sort_by => $self->get_comments_order, - ), - ); -} - -=head2 comment_to_video_id($comment, $videoID) - -Send a comment to a video ID. - -=cut - -sub comment_to_video_id { - my ($self, $comment, $video_id) = @_; - - my $url = $self->_simple_feeds_url('commentThreads', part => 'snippet'); - - my $hash = { - "snippet" => { - - "topLevelComment" => { - "snippet" => { - "textOriginal" => $comment, - } - }, - "videoId" => $video_id, - - #"channelId" => $channel_id, - }, - }; - - $self->post_as_json($url, $hash); -} - -=head1 AUTHOR - -Trizen, C<< >> - - -=head1 SUPPORT - -You can find documentation for this module with the perldoc command. - - perldoc WWW::StrawViewer::CommentThreads - - -=head1 LICENSE AND COPYRIGHT - -Copyright 2015-2016 Trizen. - -This program is free software; you can redistribute it and/or modify it -under the terms of either: the GNU General Public License as published -by the Free Software Foundation; or the Artistic License. - -See L for more information. - -=cut - -1; # End of WWW::StrawViewer::CommentThreads diff --git a/lib/WWW/StrawViewer/GetCaption.pm b/lib/WWW/StrawViewer/GetCaption.pm deleted file mode 100644 index 81af4e2..0000000 --- a/lib/WWW/StrawViewer/GetCaption.pm +++ /dev/null @@ -1,280 +0,0 @@ -package WWW::StrawViewer::GetCaption; - -use utf8; -use 5.014; -use warnings; - -=head1 NAME - -WWW::StrawViewer::GetCaption - Save the YouTube closed captions as .srt files for a videoID. - -=head1 SYNOPSIS - - use WWW::StrawViewer::GetCaption; - - my $yv_cap = WWW::StrawViewer::GetCaption->new(%opts); - - print $yv_cap->get_caption($videoID); - -=head1 SUBROUTINES/METHODS - -=head2 new(%opts) - -Options: - -=over 4 - -=item captions => [] - -The captions data. - -=item captions_dir => "." - -Where to save the closed captions. - -=item languages => [qw(en es ro jp)] - -Preferred languages. First found is saved and returned. - -=back - -=cut - -sub new { - my ($class, %opts) = @_; - - my $self = bless {}, $class; - $self->{captions_dir} = undef; - $self->{captions} = []; - $self->{auto_captions} = 0; - $self->{languages} = [qw(en es)]; - - foreach my $key (keys %{$self}) { - $self->{$key} = delete $opts{$key} - if exists $opts{$key}; - } - - foreach my $invalid_key (keys %opts) { - warn "Invalid key: '${invalid_key}'"; - } - - return $self; -} - -=head2 find_caption_data() - -Find a caption data, based on the preferred languages. - -=cut - -sub find_caption_data { - my ($self) = @_; - - my @found; - foreach my $caption (@{$self->{captions}}) { - if (defined $caption->{languageCode}) { - foreach my $i (0 .. $#{$self->{languages}}) { - my $lang = $self->{languages}[$i]; - if ($caption->{languageCode} =~ /^\Q$lang\E(?:\z|[_-])/i) { - - # Automatic Speech Recognition - my $auto = defined($caption->{kind}) && lc($caption->{kind}) eq 'asr'; - - # Check against auto-generated captions - if ($auto and not $self->{auto_captions}) { - next; - } - - # Fuzzy match or auto-generated caption - if (lc($caption->{languageCode}) ne lc($lang) or $auto) { - $found[$i + (($auto ? 2 : 1) * scalar(@{$self->{languages}}))] = $caption; - } - - # Perfect match - else { - $i == 0 and return $caption; - $found[$i] = $caption; - } - } - } - } - } - - foreach my $caption (@found) { - return $caption if defined($caption); - } - - return; -} - -=head2 sec2time(@seconds) - -Convert a list of seconds to .srt times. - -=cut - -sub sec2time { - my $self = shift; - - my @out; - foreach my $sec (map { sprintf '%.3f', $_ } @_) { - push @out, - sprintf('%02d:%02d:%02d,%03d', ($sec / 3600 % 24, $sec / 60 % 60, $sec % 60, substr($sec, index($sec, '.') + 1))); - } - - return @out; -} - -=head2 xml2srt($xml_string) - -Convert the XML data to SubRip format. - -=cut - -sub xml2srt { - my ($self, $xml) = @_; - - require WWW::StrawViewer::ParseXML; - my $hash = eval { WWW::StrawViewer::ParseXML::xml2hash($xml) } // return; - - my $sections; - if ( exists $hash->{transcript} - and ref($hash->{transcript}) eq 'ARRAY' - and ref($hash->{transcript}[0]) eq 'HASH' - and exists $hash->{transcript}[0]{text}) { - $sections = $hash->{transcript}[0]{text}; - } - else { - return; - } - - require HTML::Entities; - - my @text; - foreach my $i (0 .. $#{$sections}) { - my $line = $sections->[$i]; - - if (not defined($line->{'-dur'})) { - if (exists $sections->[$i + 1]) { - $line->{'-dur'} = $sections->[$i + 1]{'-start'} - $line->{'-start'}; - } - else { - $line->{'-dur'} = 10; - } - } - - my $start = $line->{'-start'}; - my $end = $start + $line->{'-dur'}; - - push @text, - join("\n", - $i + 1, - join(' --> ', $self->sec2time($start, $end)), - HTML::Entities::decode_entities($line->{'#text'} // '')); - } - - return join("\n\n", @text); -} - -=head2 get_xml_data($caption_data) - -Get the XML content for a given caption data. - -=cut - -sub get_xml_data { - my ($self, $url) = @_; - - state $lwp = do { - - require LWP::UserAgent; - - my $agent = LWP::UserAgent->new( - timeout => 30, - env_proxy => 1, - agent => - 'Mozilla/5.0 (X11; Linux x86_64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/41.0.2272.101 Safari/537.36', - ); - - require LWP::ConnCache; - state $cache = LWP::ConnCache->new; - $cache->total_capacity(undef); # no limit - - state $accepted_encodings = do { - require HTTP::Message; - HTTP::Message::decodable(); - }; - - $agent->ssl_opts(Timeout => 30); - $agent->default_header('Accept-Encoding' => $accepted_encodings); - $agent->conn_cache($cache); - - $agent; - }; - - my $req = $lwp->get($url); - - if ($req->is_success) { - return $req->decoded_content; - } - - return; -} - -=head2 save_caption($video_ID) - -Save the caption in a .srt file and return its file path. - -=cut - -sub save_caption { - my ($self, $video_id) = @_; - - # Find one of the preferred languages - my $info = $self->find_caption_data() // return; - - require File::Spec; - my $filename = "${video_id}_$info->{languageCode}.srt"; - my $srt_file = File::Spec->catfile($self->{captions_dir} // File::Spec->tmpdir, $filename); - - # Return the srt file if it already exists - return $srt_file if (-e $srt_file); - - # Get XML data, then transform it to SubRip data - my $xml = $self->get_xml_data($info->{baseUrl} // return) // return; - my $srt = $self->xml2srt($xml) // return; - - # Write the SubRib data to the $srt_file - open(my $fh, '>:utf8', $srt_file) or return; - print {$fh} $srt, "\n"; - close $fh; - - # Return the .srt file path - return $srt_file; -} - -=head1 AUTHOR - -Trizen, C<< >> - - -=head1 SUPPORT - -You can find documentation for this module with the perldoc command. - - perldoc WWW::StrawViewer::GetCaption - - -=head1 LICENSE AND COPYRIGHT - -Copyright 2012-2015 Trizen. - -This program is free software; you can redistribute it and/or modify it -under the terms of either: the GNU General Public License as published -by the Free Software Foundation; or the Artistic License. - -See L for more information. - -=cut - -1; # End of WWW::StrawViewer::GetCaption diff --git a/lib/WWW/StrawViewer/GuideCategories.pm b/lib/WWW/StrawViewer/GuideCategories.pm deleted file mode 100644 index 1f164b1..0000000 --- a/lib/WWW/StrawViewer/GuideCategories.pm +++ /dev/null @@ -1,85 +0,0 @@ -package WWW::StrawViewer::GuideCategories; - -use utf8; -use 5.014; -use warnings; - -=head1 NAME - -WWW::StrawViewer::GuideCategories - Categories interface. - -=head1 SYNOPSIS - - use WWW::StrawViewer; - my $obj = WWW::StrawViewer->new(%opts); - my $videos = $obj->youtube_categories('US'); - -=head1 SUBROUTINES/METHODS - -=cut - -sub _make_guideCategories_url { - my ($self, %opts) = @_; - - if (not exists $opts{id}) { - $opts{regionCode} //= $self->get_regionCode; - } - - $self->_make_feed_url('guideCategories', hl => $self->get_hl, %opts); -} - -=head2 guide_categories(;$region_id) - -Return guide categories for a specific region ID. - -=head2 guide_categories_info($category_id) - -Return info for a list of comma-separated category IDs. - -=cut - -{ - no strict 'refs'; - - foreach my $method ( - { - key => 'id', - name => 'guide_categories_info', - }, - { - key => 'regionCode', - name => 'guide_categories', - }, - ) { - *{__PACKAGE__ . '::' . $method->{name}} = sub { - my ($self, $id) = @_; - return $self->_get_results($self->_make_guideCategories_url($method->{key} => $id // return)); - }; - } -} - -=head1 AUTHOR - -Trizen, C<< >> - - -=head1 SUPPORT - -You can find documentation for this module with the perldoc command. - - perldoc WWW::StrawViewer::GuideCategories - - -=head1 LICENSE AND COPYRIGHT - -Copyright 2013-2015 Trizen. - -This program is free software; you can redistribute it and/or modify it -under the terms of either: the GNU General Public License as published -by the Free Software Foundation; or the Artistic License. - -See L for more information. - -=cut - -1; # End of WWW::StrawViewer::GuideCategories diff --git a/lib/WWW/StrawViewer/Itags.pm b/lib/WWW/StrawViewer/Itags.pm deleted file mode 100644 index 95ed483..0000000 --- a/lib/WWW/StrawViewer/Itags.pm +++ /dev/null @@ -1,319 +0,0 @@ -package WWW::StrawViewer::Itags; - -use utf8; -use 5.014; -use warnings; - -=head1 NAME - -WWW::StrawViewer::Itags - Get the YouTube itags. - -=head1 SYNOPSIS - - use WWW::StrawViewer::Itags; - - my $yv_itags = WWW::StrawViewer::Itags->new(); - - my $itags = $yv_itags->get_itags(); - my $res = $yv_itags->get_resolutions(); - -=head1 SUBROUTINES/METHODS - -=head2 new() - -Return the blessed object. - -=cut - -sub new { - my ($class) = @_; - bless {}, $class; -} - -=head2 get_itags() - -Get a HASH ref with the YouTube itags. {resolution => [itags]}. - -Reference: http://en.wikipedia.org/wiki/YouTube#Quality_and_formats - -=cut - -sub get_itags { -#<<< - scalar { - 'best' => [ - 38, # mp4 (3072p) (v-a) - [138, # mp4 (2160p-4320p) (v) - 266, # mp4 (2160p-2304p) (v) - ], - ], - - '2160' => [ - [ - 315, # webm HFR (v) - 272, # webm (v) - 313, # webm (v) - 401, # av1 (v) - ], - ], - - '1440' => [ - [ - 308, # webm HFR (v) - 271, # webm (v) - 264, # mp4 (v) - 400, # av1 (v) - ], - ], - - '1080' => [ - [303, # webm HFR (v) - 299, # mp4 HFR (v) - ], - 46, # webm (v-a) - 37, # mp4 (v-a) - [248, # webm (v) - 137, # mp4 (v) - 399, # av1 (v) - ], - 301, # mp4 (live) (v-a) - 96, # ts (live) (v-a) - ], - - '720' => [ - [302, # webm HFR (v) - 298, # mp4 HFR (v) - ], - 45, # webm (v-a) - 22, # mp4 (v-a) - [247, # webm (v) - 136, # mp4 (v) - 398, # av1 (v) - ], - 300, # mp4 (live) (v-a) - 120, # flv (live) (v-a) - 95, # ts (live) (v-a) - ], - - '480' => [ - 44, # webm (v-a) - 35, # flv (v-a) - [244, # webm (v) - 135, # mp4 (v) - 397, # av1 (v) - ], - 94, # mp4 (live) (v-a) - ], - - '360' => [ - 43, # webm (v-a) - 34, # flv (v-a) - [243, # webm (v) - 134, # mp4 (v) - 396, # av1 (v) - ], - 93, # mp4 (live) (v-a) - 18, # mp4 (v-a) - ], - - '240' => [ - 6, # flv (270p) (v-a) - 5, # flv (v-a) - 36, # 3gp (v-a) - 13, # 3gp (v-a) - [242, # webm (v) - 133, # mp4 (v) - 395, # av1 (v) - ], - 92, # mp4 (live) (v-a) - 132, # ts (live) (v-a) - ], - - '144' => [ - 17, # 3gp (v-a) - [278, # webm (v) - 160, # mp4 (v) - 394, # av1 (v) - ], - 91, # mp4 (live) (v-a) - 151, # ts (live) (v-a) - ], - - 'audio' => [172, # webm (192 kbps) - 251, # webm opus (128-160 kbps) - 171, # webm vorbis (92-128 kbps) - 140, # mp4a (128 kbps) - 141, # mp4a (256 kbps) - 250, # webm opus (64 kbps) - 249, # webm opus (48 kbps) - 139, # mp4a (48 kbps) - ], - }; -#>>> -} - -=head2 get_resolutions() - -Get an ARRAY ref with the supported resolutions ordered from highest to lowest. - -=cut - -sub get_resolutions { - my ($self) = @_; - - state $itags = $self->get_itags(); - return [ - grep { exists $itags->{$_} } - qw( - best - 2160 - 1440 - 1080 - 720 - 480 - 360 - 240 - 144 - audio - ) - ]; -} - -sub _find_streaming_url { - my ($self, %args) = @_; - - my $stream = $args{stream} // return; - my $resolution = $args{resolution} // return; - - foreach my $itag (@{$args{itags}->{$resolution}}) { - - if (ref($itag) eq 'ARRAY') { - - $args{dash} || next; - - foreach my $i (@{$itag}) { - - next if not exists $stream->{$i}; - - my $video_info = $stream->{$i}; - my $audio_info = $self->_find_streaming_url(%args, resolution => 'audio', dash => 0); - - if (defined $audio_info) { - $video_info->{__AUDIO__} = $audio_info; - return $video_info; - } - } - - next; - } - - if (exists $stream->{$itag}) { - if ($resolution eq 'audio' and not $args{dash_mp4_audio}) { - if ($itag == 140 or $itag == 141 or $itag == 139) { - next; # skip mp4 audio URLs - } - } - - my $entry = $stream->{$itag}; - - # Ignore segmented DASH URLs (they load pretty slow in mpv) - if (not $args{dash_segmented}) { - next if ($entry->{url} =~ m{^https://manifest\.googlevideo\.com/api/manifest/dash/}); - } - - return $entry; - } - } - - return; -} - -=head2 find_streaming_url(%options) - -Return the streaming URL which corresponds with the specified resolution. - - ( - urls => \@streaming_urls, - resolution => 'resolution_name', # from $obj->get_resolutions(), - dash => 1/0, # include or exclude DASH itags - dash_mp4_audio => 1/0, # include or exclude DASH videos with MP4 audio - dash_segmented => 1/0, # include or exclude segmented DASH videos - ) - -=cut - -sub find_streaming_url { - my ($self, %args) = @_; - - my $urls_array = $args{urls}; - my $resolution = $args{resolution}; - - state $itags = $self->get_itags(); - - if (defined($resolution) and $resolution =~ /^([0-9]+)/) { - $resolution = $1; - } - - my %stream; - foreach my $info_ref (@{$urls_array}) { - if (exists $info_ref->{itag} and exists $info_ref->{url}) { - $stream{$info_ref->{itag}} = $info_ref; - } - } - - $args{stream} = \%stream; - $args{itags} = $itags; - $args{resolution} = $resolution; - - my ($streaming, $found_resolution); - - # Try to find the wanted resolution - if (defined($resolution) and exists $itags->{$resolution}) { - $streaming = $self->_find_streaming_url(%args); - $found_resolution = $resolution; - } - - # Otherwise, find the best resolution available - if (not defined $streaming) { - - state $resolutions = $self->get_resolutions(); - - foreach my $res (@{$resolutions}) { - - $streaming = $self->_find_streaming_url(%args, resolution => $res); - - if (defined($streaming)) { - $found_resolution = $res; - last; - } - } - } - - wantarray ? ($streaming, $found_resolution) : $streaming; -} - -=head1 AUTHOR - -Trizen, C<< >> - - -=head1 SUPPORT - -You can find documentation for this module with the perldoc command. - - perldoc WWW::StrawViewer::Itags - - -=head1 LICENSE AND COPYRIGHT - -Copyright 2012-2015 Trizen. - -This program is free software; you can redistribute it and/or modify it -under the terms of either: the GNU General Public License as published -by the Free Software Foundation; or the Artistic License. - -See L for more information. - -=cut - -1; # End of WWW::StrawViewer::Itags diff --git a/lib/WWW/StrawViewer/ParseJSON.pm b/lib/WWW/StrawViewer/ParseJSON.pm deleted file mode 100644 index e2e7d65..0000000 --- a/lib/WWW/StrawViewer/ParseJSON.pm +++ /dev/null @@ -1,76 +0,0 @@ -package WWW::StrawViewer::ParseJSON; - -use utf8; -use 5.014; -use warnings; - -=head1 NAME - -WWW::StrawViewer::ParseJSON - Parse JSON content. - -=head1 SYNOPSIS - - use WWW::StrawViewer::ParseJSON; - my $obj = WWW::StrawViewer::ParseJSON->new(%opts); - -=head1 SUBROUTINES/METHODS - -=cut - -=head2 parse_json_string($json_string) - -Parse a JSON string and return a HASH ref. - -=cut - -sub parse_json_string { - my ($self, $json) = @_; - - if (not defined($json) or $json eq '') { - return {}; - } - - require JSON; - my $hash = eval { JSON::decode_json($json) }; - return $@ ? do { warn "[JSON]: $@\n"; {} } : $hash; -} - -=head2 make_json_string($ref) - -Create a JSON string from a HASH or ARRAY ref. - -=cut - -sub make_json_string { - my ($self, $ref) = @_; - - require JSON; - my $str = eval { JSON::encode_json($ref) }; - return $@ ? do { warn "[JSON]: $@\n"; '' } : $str; -} - -=head1 AUTHOR - -Trizen, C<< >> - - -=head1 SUPPORT - -You can find documentation for this module with the perldoc command. - - perldoc WWW::StrawViewer::ParseJSON - - -=head1 LICENSE AND COPYRIGHT - -Copyright 2013-2015 Trizen. - -This program is free software; you can redistribute it and/or modify it -under the terms of either: the GNU General Public License as published -by the Free Software Foundation; or the Artistic License. - -See L for more information. - -=cut - -1; # End of WWW::StrawViewer::ParseJSON diff --git a/lib/WWW/StrawViewer/ParseXML.pm b/lib/WWW/StrawViewer/ParseXML.pm deleted file mode 100644 index b6039b1..0000000 --- a/lib/WWW/StrawViewer/ParseXML.pm +++ /dev/null @@ -1,311 +0,0 @@ -package WWW::StrawViewer::ParseXML; - -use utf8; -use 5.014; -use warnings; - -=encoding utf8 - -=head1 NAME - -WWW::StrawViewer::ParseXML - Convert XML to a HASH ref structure. - -=head1 SYNOPSIS - -Parse XML content and return an HASH ref structure. - -Usage: - - use WWW::StrawViewer::ParseXML; - my $hash_ref = WWW::StrawViewer::ParseXML::xml2hash($xml_string); - -=head1 SUBROUTINES/METHODS - -=head2 xml2hash($xml_string) - -Parse XML and return an HASH ref. - -=cut - -sub xml2hash { - my $xml = shift() // return; - - $xml = "$xml"; # copy the string - - my $xml_ref = {}; - - my %args = ( - attr => '-', - text => '#text', - empty => q{}, - @_ - ); - - my %ctags; - my $ref = $xml_ref; - - state $inv_chars = q{!"#$@%&'()*+,/;\\<=>?\]\[^`{|}~}; - state $valid_tag = qr{[^\-.\s0-9$inv_chars][^$inv_chars\s]*}; - - { - if ( - $xml =~ m{\G< \s* - ($valid_tag) \s* - ((?>$valid_tag\s*=\s*(?>".*?"|'.*?')|\s+)+)? \s* - (/)?\s*> \s* - }gcsxo - ) { - - my ($tag, $attrs, $closed) = ($1, $2, $3); - - if (defined $attrs) { - push @{$ctags{$tag}}, $ref; - - $ref = - ref $ref eq 'HASH' - ? ref $ref->{$tag} - ? $ref->{$tag} - : ( - defined $ref->{$tag} - ? ($ref->{$tag} = [$ref->{$tag}]) - : ($ref->{$tag} //= []) - ) - : ref $ref eq 'ARRAY' ? ref $ref->[-1]{$tag} - ? $ref->[-1]{$tag} - : ( - defined $ref->[-1]{$tag} - ? ($ref->[-1]{$tag} = [$ref->[-1]{$tag}]) - : ($ref->[-1]{$tag} //= []) - ) - : []; - - ++$#{$ref} if ref $ref eq 'ARRAY'; - - while ( - $attrs =~ m{\G - ($valid_tag) \s*=\s* - (?> - "(.*?)" - | - '(.*?)' - ) \s* - }gsxo - ) { - my ($key, $value) = ($1, $+); - $key = join(q{}, $args{attr}, $key); - if (ref $ref eq 'ARRAY') { - $ref->[-1]{$key} = _decode_entities($value); - } - elsif (ref $ref eq 'HASH') { - $ref->{$key} = $value; - } - } - - if (defined $closed) { - $ref = pop @{$ctags{$tag}}; - } - - if ($xml =~ m{\G<\s*/\s*\Q$tag\E\s*>\s*}gc) { - $ref = pop @{$ctags{$tag}}; - } - elsif ($xml =~ m{\G([^<]+)(?=<)}gsc) { - if (ref $ref eq 'ARRAY') { - $ref->[-1]{$args{text}} .= _decode_entities($1); - $ref = pop @{$ctags{$tag}}; - } - elsif (ref $ref eq 'HASH') { - $ref->{$args{text}} .= $1; - $ref = pop @{$ctags{$tag}}; - } - } - } - elsif (defined $closed) { - if (ref $ref eq 'ARRAY') { - if (exists $ref->[-1]{$tag}) { - if (ref $ref->[-1]{$tag} ne 'ARRAY') { - $ref->[-1]{$tag} = [$ref->[-1]{$tag}]; - } - push @{$ref->[-1]{$tag}}, $args{empty}; - } - else { - $ref->[-1]{$tag} = $args{empty}; - } - } - } - else { - if ($xml =~ /\G(?=<(?!!))/) { - push @{$ctags{$tag}}, $ref; - - $ref = - ref $ref eq 'HASH' - ? ref $ref->{$tag} - ? $ref->{$tag} - : ( - defined $ref->{$tag} - ? ($ref->{$tag} = [$ref->{$tag}]) - : ($ref->{$tag} //= []) - ) - : ref $ref eq 'ARRAY' ? ref $ref->[-1]{$tag} - ? $ref->[-1]{$tag} - : ( - defined $ref->[-1]{$tag} - ? ($ref->[-1]{$tag} = [$ref->[-1]{$tag}]) - : ($ref->[-1]{$tag} //= []) - ) - : []; - - ++$#{$ref} if ref $ref eq 'ARRAY'; - redo; - } - elsif ($xml =~ /\G\s*/gcs or $xml =~ /\G([^<]+)(?=<)/gsc) { - my ($text) = $1; - - if ($xml =~ m{\G<\s*/\s*\Q$tag\E\s*>\s*}gc) { - if (ref $ref eq 'ARRAY') { - if (exists $ref->[-1]{$tag}) { - if (ref $ref->[-1]{$tag} ne 'ARRAY') { - $ref->[-1]{$tag} = [$ref->[-1]{$tag}]; - } - push @{$ref->[-1]{$tag}}, $text; - } - else { - $ref->[-1]{$tag} .= _decode_entities($text); - } - } - elsif (ref $ref eq 'HASH') { - $ref->{$tag} .= $text; - } - } - else { - push @{$ctags{$tag}}, $ref; - - $ref = - ref $ref eq 'HASH' - ? ref $ref->{$tag} - ? $ref->{$tag} - : ( - defined $ref->{$tag} - ? ($ref->{$tag} = [$ref->{$tag}]) - : ($ref->{$tag} //= []) - ) - : ref $ref eq 'ARRAY' ? ref $ref->[-1]{$tag} - ? $ref->[-1]{$tag} - : ( - defined $ref->[-1]{$tag} - ? ($ref->[-1]{$tag} = [$ref->[-1]{$tag}]) - : ($ref->[-1]{$tag} //= []) - ) - : []; - - ++$#{$ref} if ref $ref eq 'ARRAY'; - - if (ref $ref eq 'ARRAY') { - if (exists $ref->[-1]{$tag}) { - if (ref $ref->[-1]{$tag} ne 'ARRAY') { - $ref->[-1] = [$ref->[-1]{$tag}]; - } - push @{$ref->[-1]}, {$args{text} => $text}; - } - else { - $ref->[-1]{$args{text}} .= $text; - } - } - elsif (ref $ref eq 'HASH') { - $ref->{$tag} .= $text; - } - } - } - } - - if ($xml =~ m{\G<\s*/\s*\Q$tag\E\s*>\s*}gc) { - ## tag closed - ok - } - - redo; - } - elsif ($xml =~ m{\G<\s*/\s*($valid_tag)\s*>\s*}gco) { - if (exists $ctags{$1} and @{$ctags{$1}}) { - $ref = pop @{$ctags{$1}}; - } - redo; - } - elsif ($xml =~ /\G\s*/gcs or $xml =~ m{\G([^<]+)(?=<)}gsc) { - if (ref $ref eq 'ARRAY') { - $ref->[-1]{$args{text}} .= $1; - } - elsif (ref $ref eq 'HASH') { - $ref->{$args{text}} .= $1; - } - redo; - } - elsif ($xml =~ /\G<\?/gc) { - $xml =~ /\G.*?\?>\s*/gcs or die "Invalid XML!"; - redo; - } - elsif ($xml =~ /\G\s*/gcs or die "Comment not closed!"; - redo; - } - elsif ($xml =~ /\G$valid_tag|\s+|".*?"|'.*?')*\[.*?\]>\s*/sgco - or $xml =~ /\G.*?>\s*/sgc - or die "DOCTYPE not closed!"; - redo; - } - elsif ($xml =~ /\G\z/gc) { - ## ok - } - elsif ($xml =~ /\G\s+/gc) { - redo; - } - else { - die "Syntax error near: --> ", [split(/\n/, substr($xml, pos(), 2**6))]->[0], " <--\n"; - } - } - - return $xml_ref; -} - -{ - my %entities = ( - 'amp' => '&', - 'quot' => '"', - 'apos' => "'", - 'gt' => '>', - 'lt' => '<', - ); - - state $ent_re = do { - local $" = '|'; - qr/&(@{[keys %entities]});/; - }; - - sub _decode_entities { - $_[0] =~ s/$ent_re/$entities{$1}/gor; - } -} - -=head1 AUTHOR - -Trizen, C<< >> - -=head1 SUPPORT - -You can find documentation for this module with the perldoc command. - - perldoc WWW::StrawViewer::ParseXML - - -=head1 LICENSE AND COPYRIGHT - -Copyright 2012-2015 Trizen. - -This program is free software; you can redistribute it and/or modify it -under the terms of either: the GNU General Public License as published -by the Free Software Foundation; or the Artistic License. - -See L for more information. - -=cut - -1; # End of WWW::StrawViewer::ParseXML diff --git a/lib/WWW/StrawViewer/PlaylistItems.pm b/lib/WWW/StrawViewer/PlaylistItems.pm deleted file mode 100644 index ab41a0d..0000000 --- a/lib/WWW/StrawViewer/PlaylistItems.pm +++ /dev/null @@ -1,146 +0,0 @@ -package WWW::StrawViewer::PlaylistItems; - -use utf8; -use 5.014; -use warnings; - -=head1 NAME - -WWW::StrawViewer::PlaylistItems - Manage playlist entries. - -=head1 SYNOPSIS - - use WWW::StrawViewer; - my $obj = WWW::StrawViewer->new(%opts); - my $videos = $obj->videos_from_playlistID($playlist_id); - -=head1 SUBROUTINES/METHODS - -=cut - -sub _make_playlistItems_url { - my ($self, %opts) = @_; - return - $self->_make_feed_url( - 'playlistItems', - pageToken => $self->page_token, - %opts - ); -} - -=head2 add_video_to_playlist($playlistID, $videoID; $position=1) - -Add a video to given playlist ID, at position 1 (by default) - -=cut - -sub add_video_to_playlist { - my ($self, $playlist_id, $video_id, $position) = @_; - - $self->get_access_token() // return; - - $playlist_id // return; - $video_id // return; - $position //= 0; - - my $hash = { - "snippet" => { - "playlistId" => $playlist_id, - "resourceId" => { - "videoId" => $video_id, - "kind" => "youtube#video" - }, - "position" => $position, - } - }; - - my $url = $self->_make_playlistItems_url(pageToken => undef); - $self->post_as_json($url, $hash); -} - -=head2 favorite_video($videoID) - -Favorite a video. Returns true on success. - -=cut - -sub favorite_video { - my ($self, $video_id) = @_; - $video_id // return; - $self->get_access_token() // return; - my $playlist_id = $self->get_playlist_id('favorites', mine => 'true') // return; - $self->add_video_to_playlist($playlist_id, $video_id); -} - -=head2 videos_from_playlist_id($playlist_id) - -Get videos from a specific playlistID. - -=cut - -sub videos_from_playlist_id { - my ($self, $id) = @_; - $self->_get_results($self->_make_feed_url("playlists/$id")); -} - -=head2 favorites($channel_id) - -=head2 uploads($channel_id) - -=head2 likes($channel_id) - -Get the favorites, uploads and likes for a given channel ID. - -=cut - -=head2 favorites_from_username($username) - -=head2 uploads_from_username($username) - -=head2 likes_from_username($username) - -Get the favorites, uploads and likes for a given YouTube username. - -=cut - -{ - no strict 'refs'; - foreach my $name (qw(favorites uploads likes)) { - - *{__PACKAGE__ . '::' . $name . '_from_username'} = sub { - my ($self, $username) = @_; - $self->videos_from_username($username); - }; - - *{__PACKAGE__ . '::' . $name} = sub { - my ($self, $channel_id) = @_; - $self->videos_from_channel_id($channel_id); - }; - } -} - -=head1 AUTHOR - -Trizen, C<< >> - - -=head1 SUPPORT - -You can find documentation for this module with the perldoc command. - - perldoc WWW::StrawViewer::PlaylistItems - - -=head1 LICENSE AND COPYRIGHT - -Copyright 2013-2015 Trizen. - -This program is free software; you can redistribute it and/or modify it -under the terms of either: the GNU General Public License as published -by the Free Software Foundation; or the Artistic License. - -See L for more information. - -=cut - -1; # End of WWW::StrawViewer::PlaylistItems diff --git a/lib/WWW/StrawViewer/Playlists.pm b/lib/WWW/StrawViewer/Playlists.pm deleted file mode 100644 index 5d4e07d..0000000 --- a/lib/WWW/StrawViewer/Playlists.pm +++ /dev/null @@ -1,124 +0,0 @@ -package WWW::StrawViewer::Playlists; - -use utf8; -use 5.014; -use warnings; - -=head1 NAME - -WWW::StrawViewer::Playlists - Straw playlists handle. - -=head1 SYNOPSIS - - use WWW::StrawViewer; - my $obj = WWW::StrawViewer->new(%opts); - my $info = $obj->playlist_from_id($playlist_id); - -=head1 SUBROUTINES/METHODS - -=cut - -sub _make_playlists_url { - my ($self, %opts) = @_; - - if (not exists $opts{'part'}) { - $opts{'part'} = 'snippet,contentDetails'; - } - - $self->_make_feed_url( - 'playlists', - pageToken => $self->page_token, - %opts, - ); -} - -sub get_playlist_id { - my ($self, $playlist_name, %fields) = @_; - - my $url = $self->_simple_feeds_url('channels', qw(part contentDetails), %fields); - my $res = $self->_get_results($url); - - ref($res->{results}{items}) eq 'ARRAY' || return; - @{$res->{results}{items}} || return; - - return $res->{results}{items}[0]{contentDetails}{relatedPlaylists}{$playlist_name}; -} - -=head2 playlist_from_id($playlist_id) - -Return info for one or more playlists. -PlaylistIDs can be separated by commas. - -=cut - -sub playlist_from_id { - my ($self, $id, $part) = @_; - $self->_get_results($self->_make_playlists_url(id => $id, part => ($part // 'snippet'))); -} - -=head2 playlists($channel_id) - -Get and return playlists from a channel ID. - -=cut - -sub playlists { - my ($self, $channel_id) = @_; - $self->_get_results( - $self->_make_playlists_url( - ($channel_id and $channel_id ne 'mine') - ? (channelId => $channel_id) - : do { $self->get_access_token() // return; (mine => 'true') } - ) - ); -} - -=head2 playlists_from_username($username) - -Get and return the playlists created for a given username. - -=cut - -sub playlists_from_username { - my ($self, $username) = @_; - my $channel_id = $self->channel_id_from_username($username) // $username; - $self->playlists($channel_id); -} - -=head2 my_playlists() - -Get and return your playlists. - -=cut - -sub my_playlists { - my ($self) = @_; - $self->get_access_token() // return; - $self->_get_results($self->_make_playlists_url(mine => 'true')); -} - -=head1 AUTHOR - -Trizen, C<< >> - - -=head1 SUPPORT - -You can find documentation for this module with the perldoc command. - - perldoc WWW::StrawViewer::Playlists - - -=head1 LICENSE AND COPYRIGHT - -Copyright 2013-2015 Trizen. - -This program is free software; you can redistribute it and/or modify it -under the terms of either: the GNU General Public License as published -by the Free Software Foundation; or the Artistic License. - -See L for more information. - -=cut - -1; # End of WWW::StrawViewer::Playlists diff --git a/lib/WWW/StrawViewer/RegularExpressions.pm b/lib/WWW/StrawViewer/RegularExpressions.pm deleted file mode 100644 index edf9dd5..0000000 --- a/lib/WWW/StrawViewer/RegularExpressions.pm +++ /dev/null @@ -1,89 +0,0 @@ -package WWW::StrawViewer::RegularExpressions; - -use utf8; -use 5.014; -use warnings; - -require Exporter; -our @ISA = qw(Exporter); - -=head1 NAME - -WWW::StrawViewer::RegularExpressions - Various utils. - -=head1 SYNOPSIS - - use WWW::StrawViewer::RegularExpressions; - use WWW::StrawViewer::RegularExpressions ($get_video_id_re); - -=cut - -my $opt_begin_chars = q{:;=}; # stdin option valid begin chars - -# Options -our $range_num_re = qr{^([0-9]{1,2}+)(?>-|\.\.)([0-9]{1,2}+)?\z}; -our $digit_or_equal_re = qr/(?(?=[1-9])|=)/; -our $non_digit_or_opt_re = qr{^(?!$range_num_re)(?>[0-9]{1,2}[^0-9]|[0-9]{3}|[^0-9$opt_begin_chars])}; - -# Generic name -my $generic_name_re = qr/[a-zA-Z0-9_.\-]{11,34}/; -our $valid_channel_id_re = qr{^(?:.*/channel/)?(?(?:\w+(?:[-.]++\w++)*|$generic_name_re))(?:/.*)?\z}; - -our $get_channel_videos_id_re = qr{^.*/channel/(?(?:\w+(?:[-.]++\w++)*|$generic_name_re))}; -our $get_channel_playlists_id_re = qr{$get_channel_videos_id_re/playlists}; - -our $get_username_videos_re = qr{^.*/user/(?[-.\w]+)}; -our $get_username_playlists_re = qr{$get_username_videos_re/playlists}; - -# Video ID -my $video_id_re = qr/[0-9A-Za-z_\-]{11}/; -our $valid_video_id_re = qr{^$video_id_re\z}; -our $get_video_id_re = qr{(?:%3F|\b)(?>v|embed|youtu[.]be)(?>[=/]|%3D)(?$video_id_re)}; - -# Playlist ID -our $valid_playlist_id_re = qr{^$generic_name_re\z}; -our $get_playlist_id_re = qr{(?:(?:(?>playlist\?list|view_play_list\?p|list)=)|\w#p/c/)(?$generic_name_re)\b}; - -our $valid_opt_re = qr{^[$opt_begin_chars]([A-Za-z]++(?:-[A-Za-z]++)?(?>${digit_or_equal_re}.*)?)$}; - -our @EXPORT = qw( - $range_num_re - $digit_or_equal_re - $non_digit_or_opt_re - $valid_channel_id_re - $valid_video_id_re - $get_video_id_re - $valid_playlist_id_re - $get_playlist_id_re - $valid_opt_re - $get_channel_videos_id_re - $get_channel_playlists_id_re - $get_username_videos_re - $get_username_playlists_re - ); - -=head1 AUTHOR - -Trizen, C<< >> - - -=head1 SUPPORT - -You can find documentation for this module with the perldoc command. - - perldoc WWW::StrawViewer::RegularExpressions - - -=head1 LICENSE AND COPYRIGHT - -Copyright 2012-2013 Trizen. - -This program is free software; you can redistribute it and/or modify it -under the terms of either: the GNU General Public License as published -by the Free Software Foundation; or the Artistic License. - -See L for more information. - -=cut - -1; # End of WWW::StrawViewer::RegularExpressions diff --git a/lib/WWW/StrawViewer/Search.pm b/lib/WWW/StrawViewer/Search.pm deleted file mode 100644 index 67b8982..0000000 --- a/lib/WWW/StrawViewer/Search.pm +++ /dev/null @@ -1,175 +0,0 @@ -package WWW::StrawViewer::Search; - -use utf8; -use 5.014; -use warnings; - -=head1 NAME - -WWW::StrawViewer::Search - Search functions for Straw API v3 - -=head1 SYNOPSIS - - use WWW::StrawViewer; - my $obj = WWW::StrawViewer->new(%opts); - $obj->search_videos(@keywords); - -=head1 SUBROUTINES/METHODS - -=cut - -sub _make_search_url { - my ($self, %opts) = @_; - - return $self->_make_feed_url( - 'search', - - topicId => $self->get_topicId, - regionCode => $self->get_regionCode, - - maxResults => $self->get_maxResults, - order => $self->get_order, - publishedAfter => $self->get_publishedAfter, - publishedBefore => $self->get_publishedBefore, - regionCode => $self->get_regionCode, - relevanceLanguage => $self->get_relevanceLanguage, - safeSearch => $self->get_safeSearch, - channelId => $self->get_channelId, - channelType => $self->get_channelType, - pageToken => $self->page_token, - - ( - $opts{type} eq 'video' - ? ( - videoCaption => $self->get_videoCaption, - videoCategoryId => $self->get_videoCategoryId, - videoDefinition => $self->get_videoDefinition, - videoDimension => $self->get_videoDimension, - videoDuration => $self->get_videoDuration, - videoEmbeddable => $self->get_videoEmbeddable, - videoLicense => $self->get_videoLicense, - videoSyndicated => $self->get_videoSyndicated, - videoType => $self->get_videoType, - eventType => $self->get_eventType, - ) - : () - ), - - %opts, - ); - -} - -=head2 search_for($types,$keywords;\%args) - -Search for a list of types (comma-separated). - -=cut - -sub search_for { - my ($self, $type, $keywords, $args) = @_; - - $keywords //= []; - if (ref $keywords ne 'ARRAY') { - $keywords = [split ' ', $keywords]; - } - - my $url = $self->_make_search_url( - type => $type, - q => $self->escape_string(join(' ', @{$keywords})), - (ref $args eq 'HASH' ? %{$args} : (part => 'snippet')), - ); - - return $self->_get_results($url); -} - -{ - no strict 'refs'; - - foreach my $pair ( - { - name => 'videos', - type => 'video', - }, - { - name => 'playlists', - type => 'playlist', - }, - { - name => 'channels', - type => 'channel', - }, - { - name => 'all', - type => 'video,channel,playlist', - } - ) { - *{__PACKAGE__ . '::' . "search_$pair->{name}"} = sub { - my $self = shift; - $self->search_for($pair->{type}, @_); - }; - } -} - -=head2 search_videos($keywords;\%args) - -Search and return the found video results. - -=cut - -=head2 search_playlists($keywords;\%args) - -Search and return the found playlists. - -=cut - -=head2 search_channels($keywords;\%args) - -Search and return the found channels. - -=cut - -=head2 search_all($keywords;\%args) - -Search and return the results. - -=cut - -=head2 related_to_videoID($id) - -Retrieves a list of videos that are related to the video -that the parameter value identifies. The parameter value must -be set to a YouTube video ID. - -=cut - -sub related_to_videoID { - my ($self, $id) = @_; - return $self->search_for('video', [], {relatedToVideoId => $id}); -} - -=head1 AUTHOR - -Trizen, C<< >> - - -=head1 SUPPORT - -You can find documentation for this module with the perldoc command. - - perldoc WWW::StrawViewer::Search - - -=head1 LICENSE AND COPYRIGHT - -Copyright 2013-2015 Trizen. - -This program is free software; you can redistribute it and/or modify it -under the terms of either: the GNU General Public License as published -by the Free Software Foundation; or the Artistic License. - -See L for more information. - -=cut - -1; # End of WWW::StrawViewer::Search diff --git a/lib/WWW/StrawViewer/Subscriptions.pm b/lib/WWW/StrawViewer/Subscriptions.pm deleted file mode 100644 index 063a875..0000000 --- a/lib/WWW/StrawViewer/Subscriptions.pm +++ /dev/null @@ -1,272 +0,0 @@ -package WWW::StrawViewer::Subscriptions; - -use utf8; -use 5.014; -use warnings; - -=head1 NAME - -WWW::StrawViewer::Subscriptions - Subscriptions handler. - -=head1 SYNOPSIS - - use WWW::StrawViewer; - my $obj = WWW::StrawViewer->new(%opts); - my $videos = $obj->subscriptions_from_channelID($channel_id); - -=head1 SUBROUTINES/METHODS - -=cut - -sub _make_subscriptions_url { - my ($self, %opts) = @_; - return $self->_make_feed_url('subscriptions', %opts); -} - -=head2 subscribe_channel($channel_id) - -Subscribe to an YouTube channel. - -=cut - -sub subscribe_channel { - my ($self, $channel_id) = @_; - - my $resource = { - snippet => { - resourceId => { - kind => 'youtube#channel', - channelId => $channel_id, - } - } - }; - - my $url = $self->_simple_feeds_url('subscriptions', part => 'snippet'); - return $self->post_as_json($url, $resource); -} - -=head2 subscribe_channel_from_username($username) - -Subscribe to an YouTube channel via username. - -=cut - -sub subscribe_channel_from_username { - my ($self, $username) = @_; - $self->subscribe_channel($self->channel_id_from_username($username) // $username); -} - -=head2 subscriptions(;$channel_id) - -Retrieve the subscriptions for a channel ID or for the authenticated user. - -=cut - -sub subscriptions { - my ($self, $channel_id) = @_; - $self->_get_results( - $self->_make_subscriptions_url( - order => $self->get_subscriptions_order, - part => 'snippet', - ( - ($channel_id and $channel_id ne 'mine') - ? (channelId => $channel_id) - : do { $self->get_access_token() // return; (mine => 'true') } - ), - ) - ); -} - -=head2 subscriptions_from_username($username) - -Retrieve subscriptions for a given YouTube username. - -=cut - -sub subscriptions_from_username { - my ($self, $username) = @_; - $self->subscriptions($self->channel_id_from_username($username) // $username); -} - -=head2 subscription_videos(;$channel_id) - -Retrieve the video subscriptions for a channel ID or for the current authenticated user. - -=cut - -sub subscription_videos { - my ($self, $channel_id, $order) = @_; - - my $max_results = $self->get_maxResults(); - - my @subscription_items; - my $next_page_token; - - while (1) { - - my $url = $self->_make_subscriptions_url( - order => $self->get_subscriptions_order, - maxResults => 50, - part => 'snippet,contentDetails', - ($channel_id and $channel_id ne 'mine') - ? (channelId => $channel_id) - : do { $self->get_access_token() // return; (mine => 'true') }, - defined($next_page_token) ? (pageToken => $next_page_token) : (), - ); - - my $subscriptions = $self->_get_results($url)->{results}; - - if ( ref($subscriptions) eq 'HASH' - and ref($subscriptions->{items}) eq 'ARRAY') { - push @subscription_items, @{$subscriptions->{items}}; - } - - $next_page_token = $subscriptions->{nextPageToken} || last; - } - - my (undef, undef, undef, $mday, $mon, $year) = localtime; - - $mon += 1; - $year += 1900; - - my @videos; - foreach my $channel (@subscription_items) { - - my $new_items = $channel->{contentDetails}{newItemCount}; - - # Ignore channels with zero new items - $new_items > 0 || next; - - # Set the number of results - $self->set_maxResults(1); # don't load more than 1 video from each channel - # maybe, this value should be configurable (?) - - my $uploads = $self->uploads($channel->{snippet}{resourceId}{channelId}); - - (ref($uploads) eq 'HASH' and ref($uploads->{results}) eq 'HASH' and ref($uploads->{results}{items}) eq 'ARRAY') - || return; - - my $items = $uploads->{results}{items}; - - # Get and store the video uploads from each channel - foreach my $item (@$items) { - my $publishedAt = $item->{snippet}{publishedAt}; - my ($p_year, $p_mon, $p_mday) = $publishedAt =~ /^(\d{4})-(\d{2})-(\d{2})/; - - my $year_diff = $year - $p_year; - my $mon_diff = $mon - $p_mon; - my $mday_diff = $mday - $p_mday; - - my $days_diff = $year_diff * 365.2422 + $mon_diff * 30.436875 + $mday_diff; - - # Ignore old entries - if ($days_diff > 3) { - next; - } - - push @videos, $item; - } - - # Stop when the limit is reached - last if (@videos >= $max_results); - } - - # When there are no new videos, load one from each channel - if ($#videos == -1) { - foreach my $channel (@subscription_items) { - $self->set_maxResults(1); - push @videos, @{$self->uploads($channel->{snippet}{resourceId}{channelId})->{results}{items}}; - last if (@videos >= $max_results); - } - } - - $self->set_maxResults($max_results); - - state $parse_time_re = qr/^(\d{4})-(\d{2})-(\d{2})T(\d{2}):(\d{2}):(\d{2})/; - - @videos = - sort { - my ($y1, $M1, $d1, $h1, $m1, $s1) = $a->{snippet}{publishedAt} =~ $parse_time_re; - my ($y2, $M2, $d2, $h2, $m2, $s2) = $b->{snippet}{publishedAt} =~ $parse_time_re; - - ($y2 <=> $y1) || ($M2 <=> $M1) || ($d2 <=> $d1) || ($h2 <=> $h1) || ($m2 <=> $m1) || ($s2 <=> $s1) - } @videos; - - return {results => {pageInfo => {totalResults => $#videos + 1}, items => \@videos}}; -} - -=head2 subscription_videos_from_username($username) - -Retrieve the video subscriptions for a username. - -=cut - -sub subscription_videos_from_username { - my ($self, $username) = @_; - $self->subscription_videos($self->channel_id_from_username($username) // $username); -} - -=head2 subscriptions_from_channelID(%args) - -Get subscriptions for the specified channel ID. - -=head2 subscriptions_info($subscriptionID, %args) - -Get details for the comma-separated subscriptionID(s). - -=head3 HASH '%args' supports the following pairs: - - %args = ( - part => {contentDetails,id,snippet}, - forChannelId => $channelID, - maxResults => [0-50], - order => {alphabetical, relevance, unread}, - pageToken => {$nextPageToken, $prevPageToken}, - ); - -=cut - -{ - no strict 'refs'; - foreach my $method ( - { - key => 'id', - name => 'subscriptions_info', - }, - { - key => 'channelId', - name => 'subscriptions_from_channel_id', - } - ) { - *{__PACKAGE__ . '::' . $method->{name}} = sub { - my ($self, $id, %args) = @_; - return $self->_get_results($self->_make_subscriptions_url($method->{key} => $id, %args)); - }; - } -} - -=head1 AUTHOR - -Trizen, C<< >> - - -=head1 SUPPORT - -You can find documentation for this module with the perldoc command. - - perldoc WWW::StrawViewer::Subscriptions - - -=head1 LICENSE AND COPYRIGHT - -Copyright 2013-2015 Trizen. - -This program is free software; you can redistribute it and/or modify it -under the terms of either: the GNU General Public License as published -by the Free Software Foundation; or the Artistic License. - -See L for more information. - -=cut - -1; # End of WWW::StrawViewer::Subscriptions diff --git a/lib/WWW/StrawViewer/Utils.pm b/lib/WWW/StrawViewer/Utils.pm deleted file mode 100644 index 153aab9..0000000 --- a/lib/WWW/StrawViewer/Utils.pm +++ /dev/null @@ -1,801 +0,0 @@ -package WWW::StrawViewer::Utils; - -use utf8; -use 5.014; -use warnings; - -=head1 NAME - -WWW::StrawViewer::Utils - Various utils. - -=head1 SYNOPSIS - - use WWW::StrawViewer::Utils; - - my $yv_utils = WWW::StrawViewer::Utils->new(%opts); - - print $yv_utils->format_time(3600); - -=head1 SUBROUTINES/METHODS - -=head2 new(%opts) - -Options: - -=over 4 - -=item thousand_separator => "" - -Character used as thousand separator. - -=item months => [] - -Month names for I - -=item youtube_url_format => "" - -A youtube URL format for sprintf(format, videoID). - -=back - -=cut - -sub new { - my ($class, %opts) = @_; - - my $self = bless { - thousand_separator => q{,}, - youtube_url_format => 'https://www.youtube.com/watch?v=%s', - }, $class; - - $self->{months} = [ - qw( - Jan Feb Mar - Apr May Jun - Jul Aug Sep - Oct Nov Dec - ) - ]; - - foreach my $key (keys %{$self}) { - $self->{$key} = delete $opts{$key} - if exists $opts{$key}; - } - - foreach my $invalid_key (keys %opts) { - warn "Invalid key: '${invalid_key}'"; - } - - return $self; -} - -=head2 extension($type) - -Returns the extension format from a given type. - -From a string like 'video/webm;+codecs="vp9"', it returns 'webm'. - -=cut - -sub extension { - my ($self, $type) = @_; - $type =~ /\bflv\b/i ? q{flv} - : $type =~ /\bwebm\b/i ? q{webm} - : $type =~ /\b3gpp?\b/i ? q{3gp} - : $type =~ m{^video/(\w+)} ? $1 - : $type =~ m{^audio/(\w+)} ? $1 - : q{mp4}; -} - -=head2 format_time($sec) - -Returns time from seconds. - -=cut - -sub format_time { - my ($self, $sec) = @_; - $sec >= 3600 - ? join q{:}, map { sprintf '%02d', $_ } $sec / 3600 % 24, $sec / 60 % 60, $sec % 60 - : join q{:}, map { sprintf '%02d', $_ } $sec / 60 % 60, $sec % 60; -} - -=head2 format_duration($duration) - -Return seconds from duration (PT1H20M10S). - -=cut - -# PT5M3S -> 05:03 -# PT1H20M10S -> 01:20:10 -# PT16S -> 00:16 - -sub format_duration { - my ($self, $duration) = @_; - - $duration // return 0; - my ($hour, $min, $sec) = (0, 0, 0); - - $hour = $1 if ($duration =~ /(\d+)H/); - $min = $1 if ($duration =~ /(\d+)M/); - $sec = $1 if ($duration =~ /(\d+)S/); - - $hour * 60 * 60 + $min * 60 + $sec; -} - -=head2 format_date($date) - -Return string "04 May 2010" from "2010-05-04T00:25:55.000Z" - -=cut - -sub format_date { - my ($self, $date) = @_; - - # 2010-05-04T00:25:55.000Z - # to: 04 May 2010 - - $date =~ s{^ - (?\d{4}) - - - (?\d{2}) - - - (?\d{2}) - .* - } - {$+{day} $self->{months}[$+{month} - 1] $+{year}}x; - - return $date; -} - -=head2 date_to_age($date) - -Return the (approximated) age for a given date of the form "2010-05-04T00:25:55.000Z". - -=cut - -sub date_to_age { - my ($self, $date) = @_; - - $date =~ m{^ - (?\d{4}) - - - (?\d{2}) - - - (?\d{2}) - [a-zA-Z] - (?\d{2}) - : - (?\d{2}) - : - (?\d{2}) - }x || return undef; - - my ($sec, $min, $hour, $day, $month, $year) = gmtime(time); - - $year += 1900; - $month += 1; - - my $lambda = sub { - - if ($year == $+{year}) { - if ($month == $+{month}) { - if ($day == $+{day}) { - if ($hour == $+{hour}) { - if ($min == $+{min}) { - return join(' ', $sec - $+{sec}, 'seconds'); - } - return join(' ', $min - $+{min}, 'minutes'); - } - return join(' ', $hour - $+{hour}, 'hours'); - } - return join(' ', $day - $+{day}, 'days'); - } - return join(' ', $month - $+{month}, 'months'); - } - - if ($year - $+{year} == 1) { - my $month_diff = $+{month} - $month; - if ($month_diff > 0) { - return join(' ', 12 - $month_diff, 'months'); - } - } - - return join(' ', $year - $+{year}, 'years'); - }; - - my $age = $lambda->(); - - if ($age =~ /^1\s/) { # singular mode - $age =~ s/s\z//; - } - - return $age; -} - -=head2 has_entries($result) - -Returns true if a given result has entries. - -=cut - -sub has_entries { - my ($self, $result) = @_; - - if (ref($result->{results}) eq 'HASH') { - - if (exists $result->{results}{comments}) { - return scalar @{$result->{results}{comments}} > 0; - } - - my $type = $result->{results}{type}//''; - - if ($type eq 'playlist') { - return $result->{results}{videoCount} > 0; - } - } - - if (ref($result->{results}) eq 'ARRAY') { - return scalar(@{$result->{results}}) > 0; - } - - return 1; # maybe? - #ref($result) eq 'HASH' and ($result->{results}{pageInfo}{totalResults} > 0); -} - -=head2 normalize_video_title($title, $fat32safe) - -Replace file-unsafe characters and trim spaces. - -=cut - -sub normalize_video_title { - my ($self, $title, $fat32safe) = @_; - - if ($fat32safe) { - $title =~ s/: / - /g; - $title =~ tr{:"*/?\\|}{;'+%!%%}; # " - $title =~ tr/<>//d; - } - else { - $title =~ tr{/}{%}; - } - - join(q{ }, split(q{ }, $title)); -} - -=head2 format_text(%opt) - -Formats a text with information from streaming and video info. - -The structure of C<%opt> is: - - ( - streaming => HASH, - info => HASH, - text => STRING, - escape => BOOL, - fat32safe => BOOL, - ) - -=cut - -sub format_text { - my ($self, %opt) = @_; - - my $streaming = $opt{streaming}; - my $info = $opt{info}; - my $text = $opt{text}; - my $escape = $opt{escape}; - my $fat32safe = $opt{fat32safe}; - - my %special_tokens = ( - ID => sub { $self->get_video_id($info) }, - AUTHOR => sub { $self->get_channel_title($info) }, - CHANNELID => sub { $self->get_channel_id($info) }, - DEFINITION => sub { $self->get_definition($info) }, - DIMENSION => sub { $self->get_dimension($info) }, - VIEWS => sub { $self->get_views($info) }, - VIEWS_SHORT => sub { $self->get_views_approx($info) }, - LIKES => sub { $self->get_likes($info) }, - DISLIKES => sub { $self->get_dislikes($info) }, - COMMENTS => sub { $self->get_comments($info) }, - DURATION => sub { $self->get_duration($info) }, - TIME => sub { $self->get_time($info) }, - TITLE => sub { $self->get_title($info) }, - FTITLE => sub { $self->normalize_video_title($self->get_title($info), $fat32safe) }, - CAPTION => sub { $self->get_caption($info) }, - PUBLISHED => sub { $self->get_publication_date($info) }, - AGE => sub { $self->get_publication_age($info) }, - AGE_SHORT => sub { $self->get_publication_age_approx($info) }, - DESCRIPTION => sub { $self->get_description($info) }, - - RATING => sub { - my $likes = $self->get_likes($info) // 0; - my $dislikes = $self->get_dislikes($info) // 0; - - my $rating = 0; - if ($likes + $dislikes > 0) { - $rating = $likes / ($likes + $dislikes) * 5; - } - - sprintf('%.2f', $rating); - }, - - ( - defined($streaming) - ? ( - RESOLUTION => sub { - $streaming->{resolution} =~ /^\d+\z/ - ? $streaming->{resolution} . 'p' - : $streaming->{resolution}; - }, - - ITAG => sub { $streaming->{streaming}{itag} }, - SUB => sub { $streaming->{srt_file} }, - VIDEO => sub { $streaming->{streaming}{url} }, - FORMAT => sub { $self->extension($streaming->{streaming}{type}) }, - - AUDIO => sub { - ref($streaming->{streaming}{__AUDIO__}) eq 'HASH' - ? $streaming->{streaming}{__AUDIO__}{url} - : q{}; - }, - - AOV => sub { - ref($streaming->{streaming}{__AUDIO__}) eq 'HASH' - ? $streaming->{streaming}{__AUDIO__}{url} - : $streaming->{streaming}{url}; - }, - ) - : () - ), - - URL => sub { sprintf($self->{youtube_url_format}, $self->get_video_id($info)) }, - ); - - my $tokens_re = do { - local $" = '|'; - qr/\*(@{[keys %special_tokens]})\*/; - }; - - my %special_escapes = ( - a => "\a", - b => "\b", - e => "\e", - f => "\f", - n => "\n", - r => "\r", - t => "\t", - ); - - my $escapes_re = do { - local $" = q{}; - qr/\\([@{[keys %special_escapes]}])/; - }; - - $text =~ s/$escapes_re/$special_escapes{$1}/g; - - $escape - ? $text =~ s/$tokens_re/\Q${\$special_tokens{$1}()}\E/gr - : $text =~ s/$tokens_re/${\$special_tokens{$1}()}/gr; -} - -=head2 set_thousands($num) - -Return the number with thousand separators. - -=cut - -sub set_thousands { # ugly, but fast - my ($self, $n) = @_; - - return 0 unless $n; - length($n) > 3 or return $n; - - my $l = length($n) - 3; - my $i = ($l - 1) % 3 + 1; - my $x = substr($n, 0, $i) . $self->{thousand_separator}; - - while ($i < $l) { - $x .= substr($n, $i, 3) . $self->{thousand_separator}; - $i += 3; - } - - return $x . substr($n, $i); -} - -=head2 get_video_id($info) - -Get videoID. - -=cut - -sub get_video_id { - my ($self, $info) = @_; - $info->{videoId}; - - #~ ref($info->{id}) eq 'HASH' ? $info->{id}{videoId} - #~ : exists($info->{snippet}{resourceId}{videoId}) ? $info->{snippet}{resourceId}{videoId} - #~ : exists($info->{contentDetails}{videoId}) ? $info->{contentDetails}{videoId} - #~ : exists($info->{contentDetails}{playlistItem}{resourceId}{videoId}) - #~ ? $info->{contentDetails}{playlistItem}{resourceId}{videoId} - #~ : exists($info->{contentDetails}{upload}{videoId}) ? $info->{contentDetails}{upload}{videoId} - #~ : do { - #~ my $id = $info->{id} // return undef; - - #~ if (length($id) != 11) { - #~ return undef; - #~ } - - #~ $id; - #~ }; -} - -sub get_playlist_id { - my ($self, $info) = @_; - $info->{playlistId}; -} - -sub get_playlist_video_count { - my ($self, $info) = @_; - $info->{videoCount}; -} - -=head2 get_description($info) - -Get description. - -=cut - -sub get_description { - my ($self, $info) = @_; - my $desc = $info->{description}; - (defined($desc) and $desc =~ /\S/) ? $desc : 'No description available...'; -} - -=head2 get_title($info) - -Get title. - -=cut - -sub get_title { - my ($self, $info) = @_; - $info->{title}; -} - -=head2 get_thumbnail_url($info;$type='default') - -Get thumbnail URL. - -=cut - -sub get_thumbnail_url { - my ($self, $info, $type) = @_; - - if (exists $info->{videoId}) { - $info->{type} = 'video'; - } - - if ($info->{type} eq 'playlist') { - return $info->{playlistThumbnail}; - } - - if ($info->{type} eq 'channel') { - ref($info->{authorThumbnails}) eq 'ARRAY' or return ''; - return $info->{authorThumbnails}[0]{url}; - } - - ref($info->{videoThumbnails}) eq 'ARRAY' or return ''; - - my @thumbs = @{$info->{videoThumbnails}}; - my @wanted = grep{$_->{quality} eq $type} @thumbs; - - if (@wanted) { - return $wanted[0]{url}; - } - - warn "[!] Couldn't find thumbnail of type <<$type>>..."; - $thumbs[0]{url}; -} - -sub get_channel_title { - my ($self, $info) = @_; - #$info->{snippet}{channelTitle} || $self->get_channel_id($info); - $info->{author}; -} - -sub get_author { - my ($self, $info) = @_; - $info->{author}; -} - -sub get_comment_id { - my ($self, $info) = @_; - $info->{commentId}; -} - -sub get_comment_content { - my ($self, $info) = @_; - $info->{content}; -} - -sub get_id { - my ($self, $info) = @_; - #$info->{id}; - $info->{videoId}; -} - -sub get_channel_id { - my ($self, $info) = @_; - #$info->{snippet}{resourceId}{channelId} // $info->{snippet}{channelId}; - $info->{authorId}; -} - -sub get_category_id { - my ($self, $info) = @_; - #$info->{snippet}{resourceId}{categoryId} // $info->{snippet}{categoryId}; - #"unknown"; - $info->{genre} // 'Unknown'; -} - -sub get_category_name { - my ($self, $info) = @_; - - state $categories = { - 1 => 'Film & Animation', - 2 => 'Autos & Vehicles', - 10 => 'Music', - 15 => 'Pets & Animals', - 17 => 'Sports', - 19 => 'Travel & Events', - 20 => 'Gaming', - 22 => 'People & Blogs', - 23 => 'Comedy', - 24 => 'Entertainment', - 25 => 'News & Politics', - 26 => 'Howto & Style', - 27 => 'Education', - 28 => 'Science & Technology', - 29 => 'Nonprofits & Activism', - }; - - #$categories->{$self->get_category_id($info) // ''} // 'Unknown'; - - $info->{genre} // 'Unknown'; -} - -sub get_publication_date { - my ($self, $info) = @_; - #$self->format_date($info->{snippet}{publishedAt}); - #$self->format_date - require Time::Piece; - my $time = Time::Piece->new($info->{published}); - $time->strftime("%d %B %Y"); -} - -sub get_publication_age { - my ($self, $info) = @_; - ($info->{publishedText} // '') =~ s/\sago\z//r;; -} - -sub get_publication_age_approx { - my ($self, $info) = @_; - - my $age = $self->get_publication_age($info) // ''; - - if ($age =~ /hour|min|sec/) { - return "0d"; - } - - if ($age =~ /^(\d+) day/) { - return "$1d"; - } - - if ($age =~ /^(\d+) week/) { - return "$1w"; - } - - if ($age =~ /^(\d+) month/) { - return "$1m"; - } - - if ($age =~ /^(\d+) year/) { - return "$1y"; - } - - return $age; -} - -sub get_duration { - my ($self, $info) = @_; - #$self->format_duration($info->{contentDetails}{duration}); - #$self->format_duration($info->{lengthSeconds}); - $info->{lengthSeconds}; -} - -sub get_time { - my ($self, $info) = @_; - - if ($info->{liveNow}) { - return 'LIVE'; - } - - $self->format_time($self->get_duration($info)); - - #$self->format_time($self->get_duration($info)); -} - -sub get_definition { - my ($self, $info) = @_; - #uc($info->{contentDetails}{definition} // '-'); - #...; - "unknown"; -} - -sub get_dimension { - my ($self, $info) = @_; - #uc($info->{contentDetails}{dimension}); - #...; - "unknown"; -} - -sub get_caption { - my ($self, $info) = @_; - #$info->{contentDetails}{caption}; - #...; - "unknown"; -} - -sub get_views { - my ($self, $info) = @_; - $info->{viewCount} // 0; -} - -sub get_views_approx { - my ($self, $info) = @_; - my $views = $self->get_views($info); - - if ($views < 1000) { - return $views; - } - - if ($views >= 10 * 1e9) { # ten billions - return sprintf("%dB", int($views / 1e9)); - } - - if ($views >= 1e9) { # billions - return sprintf("%.2gB", $views / 1e9); - } - - if ($views >= 10 * 1e6) { # ten millions - return sprintf("%dM", int($views / 1e6)); - } - - if ($views >= 1e6) { # millions - return sprintf("%.2gM", $views / 1e6); - } - - if ($views >= 10 * 1e3) { # ten thousands - return sprintf("%dK", int($views / 1e3)); - } - - if ($views >= 1e3) { # thousands - return sprintf("%.2gK", $views / 1e3); - } - - return $views; -} - -sub get_likes { - my ($self, $info) = @_; - $info->{likeCount} // 0; -} - -sub get_dislikes { - my ($self, $info) = @_; - $info->{dislikeCount} // 0; -} - -sub get_comments { - my ($self, $info) = @_; - #$info->{statistics}{commentCount}; - 1; -} - -{ - no strict 'refs'; - foreach my $pair ( - [playlist => {'playlist' => 1}], - [channel => {'channel' => 1}], - [video => {'video' => 1, 'playlistItem' => 1}], - [subscription => {'subscription' => 1}], - [activity => {'activity' => 1}], - ) { - - *{__PACKAGE__ . '::' . 'is_' . $pair->[0]} = sub { - my ($self, $item) = @_; - - if ($pair->[0] eq 'video') { - return 1 if exists $item->{videoId}; - } - - exists $pair->[1]{$item->{type} // ''}; - - #~ if (ref($item->{id}) eq 'HASH') { - #~ if (exists $pair->[1]{$item->{id}{kind}}) { - #~ return 1; - #~ } - #~ } - #~ elsif (exists $item->{kind}) { - #~ if (exists $pair->[1]{$item->{kind}}) { - #~ return 1; - #~ } - #~ } - - #~ return; - }; - - } -} - -sub is_channelID { - my ($self, $id) = @_; - $id || return; - $id eq 'mine' or $id =~ /^UC[-a-zA-Z0-9_]{22}\z/; -} - -sub is_videoID { - my ($self, $id) = @_; - $id || return; - $id =~ /^[-a-zA-Z0-9_]{11}\z/; -} - -sub period_to_date { - my ($self, $amount, $period) = @_; - - state $day = 60 * 60 * 24; - state $week = $day * 7; - state $month = $day * 30.4368; - state $year = $day * 365.242; - - my $time = $amount * ( - $period =~ /^d/i ? $day - : $period =~ /^w/i ? $week - : $period =~ /^m/i ? $month - : $period =~ /^y/i ? $year - : 0 - ); - - my $now = time; - my @time = gmtime($now - $time); - join('-', $time[5] + 1900, sprintf('%02d', $time[4] + 1), sprintf('%02d', $time[3])) . 'T' - . join(':', sprintf('%02d', $time[2]), sprintf('%02d', $time[1]), sprintf('%02d', $time[0])) . 'Z'; -} - -=head1 AUTHOR - -Trizen, C<< >> - - -=head1 SUPPORT - -You can find documentation for this module with the perldoc command. - - perldoc WWW::StrawViewer::Utils - - -=head1 LICENSE AND COPYRIGHT - -Copyright 2012-2020 Trizen. - -This program is free software; you can redistribute it and/or modify it -under the terms of either: the GNU General Public License as published -by the Free Software Foundation; or the Artistic License. - -See L for more information. - -=cut - -1; # End of WWW::StrawViewer::Utils diff --git a/lib/WWW/StrawViewer/VideoCategories.pm b/lib/WWW/StrawViewer/VideoCategories.pm deleted file mode 100644 index 30e2e6e..0000000 --- a/lib/WWW/StrawViewer/VideoCategories.pm +++ /dev/null @@ -1,97 +0,0 @@ -package WWW::StrawViewer::VideoCategories; - -use utf8; -use 5.014; -use warnings; - -=head1 NAME - -WWW::StrawViewer::VideoCategories - videoCategory resource handler. - -=head1 SYNOPSIS - - use WWW::StrawViewer; - my $obj = WWW::StrawViewer->new(%opts); - my $cats = $obj->video_categories(); - -=head1 SUBROUTINES/METHODS - -=cut - -sub _make_videoCategories_url { - my ($self, %opts) = @_; - - $self->_make_feed_url( - 'videoCategories', - hl => $self->get_hl, - %opts, - ); -} - -=head2 video_categories() - -Return video categories for a specific region ID. - -=cut - -sub video_categories { - my ($self) = @_; - - require File::Spec; - - my $region = $self->get_regionCode() // 'US'; - my $url = $self->_make_videoCategories_url(regionCode => $region); - my $file = File::Spec->catfile($self->get_config_dir, "categories-$region-" . $self->get_hl() . ".json"); - - my $json; - if (open(my $fh, '<:utf8', $file)) { - local $/; - $json = <$fh>; - close $fh; - } - else { - $json = $self->lwp_get($url, simple => 1); - open my $fh, '>:utf8', $file; - print {$fh} $json; - close $fh; - } - - return $self->parse_json_string($json); -} - -=head2 video_category_id_info($cagegory_id) - -Return info for the comma-separated specified category ID(s). - -=cut - -sub video_category_id_info { - my ($self, $id) = @_; - return $self->_get_results($self->_make_videoCategories_url(id => $id)); -} - -=head1 AUTHOR - -Trizen, C<< >> - - -=head1 SUPPORT - -You can find documentation for this module with the perldoc command. - - perldoc WWW::StrawViewer::VideoCategories - - -=head1 LICENSE AND COPYRIGHT - -Copyright 2013-2015 Trizen. - -This program is free software; you can redistribute it and/or modify it -under the terms of either: the GNU General Public License as published -by the Free Software Foundation; or the Artistic License. - -See L for more information. - -=cut - -1; # End of WWW::StrawViewer::VideoCategories diff --git a/lib/WWW/StrawViewer/Videos.pm b/lib/WWW/StrawViewer/Videos.pm deleted file mode 100644 index 11bf60b..0000000 --- a/lib/WWW/StrawViewer/Videos.pm +++ /dev/null @@ -1,230 +0,0 @@ -package WWW::StrawViewer::Videos; - -use utf8; -use 5.014; -use warnings; - -=head1 NAME - -WWW::StrawViewer::Videos - videos handler. - -=head1 SYNOPSIS - - use WWW::StrawViewer; - my $obj = WWW::StrawViewer->new(%opts); - my $info = $obj->video_details($videoID); - -=head1 SUBROUTINES/METHODS - -=cut - -sub _make_videos_url { - my ($self, %opts) = @_; - return $self->_make_feed_url('videos', %opts); -} - -{ - no strict 'refs'; - foreach my $part ( - qw( - id - snippet - contentDetails - fileDetails - player - liveStreamingDetails - processingDetails - recordingDetails - statistics - status - suggestions - topicDetails - ) - ) { - *{__PACKAGE__ . '::' . 'video_' . $part} = sub { - my ($self, $id) = @_; - return $self->_get_results($self->_make_videos_url(id => $id, part => $part)); - }; - } -} - -=head2 videos_from_category($category_id) - -Get videos from a category ID. - -=cut - -sub videos_from_category { - my ($self, $cat_id) = @_; - $self->_get_results( - $self->_make_videos_url( - chart => $self->get_chart, - videoCategoryId => $cat_id, - ) - ); -} - -=head2 trending_videos_from_category($category_id) - -Get popular videos from a category ID. - -=cut - -sub trending_videos_from_category { - my ($self, $cat_id) = @_; - - my $results = do { - local $self->{publishedAfter} = do { - state $yv_utils = WWW::StrawViewer::Utils->new; - $yv_utils->period_to_date(1, 'w'); - } if !defined($self->get_publishedAfter); - local $self->{videoCategoryId} = $cat_id; - local $self->{regionCode} = "US" if !defined($self->get_regionCode); - $self->search_videos(""); - }; - - return $results; -} - -=head2 popular_videos($channel_id) - -Get the most popular videos for a given channel ID. - -=cut - -sub popular_videos { - my ($self, $id) = @_; - - my $results = do { - local $self->{channelId} = $id; - local $self->{order} = 'viewCount'; - $self->search_videos(""); - }; - - return $results; -} - -=head2 my_likes() - -Get the videos liked by the authenticated user. - -=cut - -sub my_likes { - my ($self) = @_; - $self->get_access_token() // return; - $self->_get_results($self->_make_videos_url(myRating => 'like', pageToken => $self->page_token)); -} - -=head2 my_dislikes() - -Get the videos disliked by the authenticated user. - -=cut - -sub my_dislikes { - my ($self) = @_; - $self->get_access_token() // return; - $self->_get_results($self->_make_videos_url(myRating => 'dislike', pageToken => $self->page_token)); -} - -=head2 send_rating_to_video($videoID, $rating) - -Send rating to a video. $rating can be either 'like' or 'dislike'. - -=cut - -sub send_rating_to_video { - my ($self, $video_id, $rating) = @_; - - if ($rating eq 'none' or $rating eq 'like' or $rating eq 'dislike') { - my $url = $self->_simple_feeds_url('videos/rate', id => $video_id, rating => $rating); - return defined($self->lwp_post($url, $self->_auth_lwp_header())); - } - - return; -} - -=head2 like_video($videoID) - -Like a video. Returns true on success. - -=cut - -sub like_video { - my ($self, $video_id) = @_; - $self->send_rating_to_video($video_id, 'like'); -} - -=head2 dislike_video($videoID) - -Dislike a video. Returns true on success. - -=cut - -sub dislike_video { - my ($self, $video_id) = @_; - $self->send_rating_to_video($video_id, 'dislike'); -} - -=head2 videos_details($id, $part) - -Get info about a videoID, such as: channelId, title, description, -tags, and categoryId. - -Available values for I are: I, I, I -I, I, I and I. - -C<$part> string can contain more values, comma-separated. - -Example: - - part => 'snippet,contentDetails,statistics' - -When C<$part> is C, it defaults to I. - -=cut - -sub video_details { - my ($self, $id, $fields) = @_; - $fields //= $self->basic_video_info_fields; - $self->_get_results($self->_make_feed_url("videos/$id", fields => $fields)); -} - -=head2 Return details - -Each function returns a HASH ref, with a key called 'results', and another key, called 'url'. - -The 'url' key contains a string, which is the URL for the retrieved content. - -The 'results' key contains another HASH ref with the keys 'etag', 'items' and 'kind'. -From the 'results' key, only the 'items' are relevant to us. This key contains an ARRAY ref, -with a HASH ref for each result. An example of the item array's content are shown below. - -=cut - -=head1 AUTHOR - -Trizen, C<< >> - - -=head1 SUPPORT - -You can find documentation for this module with the perldoc command. - - perldoc WWW::StrawViewer::Videos - - -=head1 LICENSE AND COPYRIGHT - -Copyright 2013-2015 Trizen. - -This program is free software; you can redistribute it and/or modify it -under the terms of either: the GNU General Public License as published -by the Free Software Foundation; or the Artistic License. - -See L for more information. - -=cut - -1; # End of WWW::StrawViewer::Videos -- cgit v1.2.3