diff options
Diffstat (limited to 'lib/WWW/StrawViewer.pm')
| -rw-r--r-- | lib/WWW/StrawViewer.pm | 1045 |
1 files changed, 1045 insertions, 0 deletions
diff --git a/lib/WWW/StrawViewer.pm b/lib/WWW/StrawViewer.pm new file mode 100644 index 0000000..ecd31c9 --- /dev/null +++ b/lib/WWW/StrawViewer.pm @@ -0,0 +1,1045 @@ +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. + +=cut + +our $VERSION = '3.7.4'; + +=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(time relevance)], default => 'time'}, + 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}, + + use_invidious_api => {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}, + + # No input value allowed + feeds_url => {valid => q[], default => 'https://invidio.us/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; +} + +{ + 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( + + 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 >= 500 # do not cache any bad response + or $code == 401 # don't cache an unauthorized 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<simple> 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 _simple_feeds_url { + my ($self, $suburl, %args) = @_; + $self->get_feeds_url() . $suburl . '?' . $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) = @_; + $self->get_feeds_url() . $path . '?' . $self->default_arguments(%args); +} + +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 _extract_from_ytdl { + my ($self, $videoID) = @_; + + ((state $x = system('youtube-dl', '--version')) == 0) || 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->get_use_invidious_api) { # 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."; + } + + @formats && return @formats; + } + + 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; +} + +=head2 parse_query_string($string, multi => [0,1]) + +Parse a query string and return a data structure back. + +When the B<multi> 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); +} + +# SUBROUTINE FACTORY +{ + no strict 'refs'; + + # Create {next,previous}_page subroutines + foreach my $name ('next_page', 'previous_page') { + *{__PACKAGE__ . '::' . $name} = sub { + my ($self, $url, $token) = @_; + + my $pt_url = ( + $url =~ s/[?&]pageToken=\K[^&]+/$token/ + ? $url + : $self->_append_url_args($url, pageToken => $token) + ); + + my $res = $self->_get_results($pt_url); + $res->{url} = $pt_url; + return $res; + }; + } + + # 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<< <echo dHJpemVuQHByb3Rvbm1haWwuY29tCg== | base64 -d> >> + +=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<http://www.perlfoundation.org/artistic_license_2_0> + +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__ |