File Coverage

blib/lib/WWW/YouTube/Info/Simple.pm

Criterion	Covered	Total	%
statement	76	105	72.3
branch	22	56	39.2
condition	2	12	16.6
subroutine	12	14	85.7
pod	5	5	100.0
total	117	192	60.9

package WWW::YouTube::Info::Simple;

use 5.008;
use strict;
use warnings;

require Exporter;
require WWW::YouTube::Info;

our @ISA = qw(
  Exporter
  WWW::YouTube::Info
);

our @EXPORT = qw(
);

our $VERSION = '0.11';

use Carp;
use Data::Dumper;

=head1 NAME

WWW::YouTube::Info::Simple - simple interface to WWW::YouTube::Info

=head1 SYNOPSIS

=head2 Perhaps a little code snippet?

  #!/usr/bin/perl

  use strict;
  use warnings;

  use WWW::YouTube::Info::Simple;

  # id taken from YouTube video URL
  my $id = 'foobar';

  my $yt = WWW::YouTube::Info::Simple->new($id);

  # hash reference holds values gained via https://youtube.com/get_video_info?video_id=foobar
  my $info = $yt->get_info();
  # this is basically an inheritance to get_info() at WWW::YouTube::Info
  # $info->{title}          # e.g.: Foo+bar+-+%27Foobar%27
  # $info->{author}         # e.g.: foobar
  # $info->{keywords}       # e.g.: Foo%2Cbar%2CFoobar
  # $info->{length_seconds} # e.g.: 60
  # $info->{fmt_map}        # e.g.: 22%2F1280x720%2F9%2F0%2F115%2C35%2F854x480%2F9%2F0%2F115%2C34%2F640x360%2F9%2 ..
  # $info->{fmt_url_map}    # e.g.: 22%7Chttps%3A%2F%2Fv14.lscache1.c.youtube.com%2Fvideoplayback%3Fip%3D131.0.0. ..
  # $info->{fmt_stream_map} # e.g.: 22%7Chttps%3A%2F%2Fv14.lscache1.c.youtube.com%2Fvideoplayback%3Fip%3D131.0.0. ..

  # array reference holds values keywords
  my $keys = $yt->get_keywords();
  # $keys->[0] # e.g.: Foo
  # $keys->[1] # e.g.: bar
  # ..

  # hash reference holds values quality -> resolution
  my $res = $yt->get_resolution();
  # $res->{35} # e.g.: 854x480
  # $res->{22} # e.g.: 1280x720
  # ..

  # URL and masquerading decoded title
  my $title = $yt->get_title(); # e.g.: Foo bar - 'Foobar'

  # hash reference holds values quality -> url
  my $url = $yt->get_url();
  # $url->{35} e.g.: https://v14.lscache1.c.youtube.com/videoplayback?ip=131.0.0.0 ..
  # $url->{22} e.g.: https://v14.lscache1.c.youtube.com/videoplayback?ip=131.0.0.0 ..
  # ..

  # URL decoded RTMPE URL
  my $conn = $yt->get_conn(); # e.g.: rtmpe://cp59009.edgefcs.net/youtube?auth=daEcaboc8dvawbcbxazdobDcZajcDdgcfae ..

  # Remark:
  # You might want to check $info->{status} before further workout,
  # as some videos have copyright issues indicated, for instance, by
  # $info->{status} ne 'ok'.

=head1 DESCRIPTION

I guess its pretty much self-explanatory ..

=head1 METHODS

=cut

=head2 get_keywords

Returns undef if status ne 'ok'.
Croaks if not available.

=cut

sub get_keywords {
  my ($self) = @_;

  $self->get_info() unless exists($self->{info});
  return if ( $self->{info}->{status} ne 'ok' );

  my $keywords = $self->{info}->{'keywords'};
  croak "no keywords found!" unless $keywords;

  my @keywords_parts = split /%2C/, $keywords;
  foreach my $item ( @keywords_parts ) {
    next unless $item;
    $item = _url_decode($item);
    push @{$self->{keywords}}, $item;
  }

  return $self->{keywords};
}

=head2 get_resolution

Returns undef if status ne 'ok'.
Croaks if not available.

=cut

sub get_resolution {
  my ($self) = @_;

  $self->get_info() unless exists($self->{info});
  return if ( $self->{info}->{status} ne 'ok' );

  # quality and resolution
  my $fmt_map = $self->{info}->{'fmt_map'};
  unless ( $fmt_map ) {
    # fallback to fmt_list
    # as fmt_map doesnt't seem to be supported any more
    croak "no resolutions found!" unless $self->_fmt_list();
  }
  else {
    # process fmt_map
    my @fmt_map_parts = split /%2F9%2F0%2F115%2C/, $fmt_map;
    foreach my $item ( @fmt_map_parts ) {
      my ($quality, $resolution) = split /%2F/, $item;
      next unless $quality and $resolution;
      $self->{resolution}->{$quality} = $resolution;
    }
  }

  return $self->{resolution};
}

=head2 get_title

Returns undef if status ne 'ok'.
Croaks if not available.

=cut

sub get_title {
  my ($self) = @_;

  $self->get_info() unless exists($self->{info});
  return if ( $self->{info}->{status} ne 'ok' );

  my $title = $self->{info}->{'title'};
  croak "no title found!" unless $title;

  $title = _url_decode($title);
  $title =~ s/\+/ /g;
  $self->{title} = $title;

  return $self->{title};
}

=head2 get_url

Returns undef if status ne 'ok'.
Croaks if not available.

  use WWW::YouTube::Info::Simple;

  # id taken from YouTube video URL
  my $id = 'foobar';

  my $yt = WWW::YouTube::Info::Simple->new($id);

  # hash reference holds values quality -> url
  my $url = $yt->get_url();
  # $url->{35} e.g.: https://v14.lscache1.c.youtube.com/videoplayback?ip=131.0.0.0 ..
  # $url->{22} e.g.: https://v14.lscache1.c.youtube.com/videoplayback?ip=131.0.0.0 ..
  # ..

YouTube videos can be downloaded in given qualities by means of these URLs and the usual suspects (C, ..).

=cut

sub get_url {
  my ($self) = @_;

  $self->get_info() unless exists($self->{info});
  return if ( $self->{info}->{status} ne 'ok' );

  # quality and URL
  my $fmt_url_map = $self->{info}->{'fmt_url_map'};
  unless ( $fmt_url_map ) {
    # fallback to url_encoded_fmt_stream_map
    # as fmt_url_map doesnt't seem to be supported any more
    croak "no URLs found!" unless $self->_url_encoded_fmt_stream_map();
  }
  else {
    # process fmt_url_map
    my @fmt_url_map_parts = split /%2C/, $fmt_url_map;
    foreach my $item ( @fmt_url_map_parts ) {
      my ($quality, $url) = split /%7C/, $item;
      next unless $quality and $url;
      $url = _url_decode($url);
      $self->{url}->{$quality} = $url;
    }
  }

  return $self->{url};
}

=head2 get_conn

Returns undef if status ne 'ok'.
Croaks if not available.

  use WWW::YouTube::Info::Simple;

  # id taken from YouTube video URL
  my $id = 'foobar';

  my $yt = WWW::YouTube::Info::Simple->new($id);

  # URL decoded RTMPE URL
  my $conn = $yt->get_conn(); # e.g.: rtmpe://cp59009.edgefcs.net/youtube?auth=daEcaboc8dvawbcbxazdobDcZajcDdgcfae ..

A YouTube RTMPE stream can be accessed via this URL and downloaded by
means of the usual suspects (C, ..).
The URL looses its validity after approx. 30 seconds (experimental value).
Gathering a fresh RTMPE URL regarding the same VIDEO_ID and the
C capability might circumvent this inconvenience.

=cut

sub get_conn {
  my ($self) = @_;

  $self->get_info() unless exists($self->{info});
  return if ( $self->{info}->{status} ne 'ok' );

  my $conn = $self->{info}->{'conn'};
  croak "no conn found!" unless $conn;

  $self->{conn} = _url_decode($conn);

  return $self->{conn};
}


sub _url_encoded_fmt_stream_map {
  my ($self) = @_;

  $self->get_info() unless exists($self->{info});
  return if ( $self->{info}->{status} ne 'ok' );

  # quality and URL
  my $url_encoded_fmt_stream_map = $self->{info}->{'url_encoded_fmt_stream_map'};
  return unless $url_encoded_fmt_stream_map;

  my @url_encoded_fmt_stream_map_parts = split /%2C/, $url_encoded_fmt_stream_map;
  foreach my $item ( @url_encoded_fmt_stream_map_parts ) {
    $item = _url_decode($item);
    (my $url = $item) =~ s/.*url=(.*)(?:&.*|$)/$1/;
    $url = _url_decode($url);
    (my $quality = $url) =~ s/.*&itag=(\d+)&.*/$1/;

    # fix multiple occurrences of parameters
    my ($url_base, $params) = split /\?/, $url;
    my %params_uniq = map { $_ => 1 } split /&/, $params;
    my $params_uniq = join('&', keys %params_uniq);
    $url = $url_base . '?' . $params_uniq;

    next unless $quality and $url;
    $self->{url}->{$quality} = $url;
  }

  return $self->{url};
}

sub _fmt_list {
  my ($self) = @_;

  $self->get_info() unless exists($self->{info});
  return if ( $self->{info}->{status} ne 'ok' );

  # quality and resolution
  my $fmt_list = $self->{info}->{'fmt_list'};
  return unless $fmt_list;

  my @fmt_list_parts = split /%2C/, $fmt_list;
  foreach my $item ( @fmt_list_parts ) {
    my ($quality, $resolution, @rest) = split /%2F/, $item;
    next unless $quality and $resolution;
    $self->{resolution}->{$quality} = $resolution;
  }

  return $self->{resolution};
}

sub _url_encode {
  my $string = shift;

  # URLencode
  $string =~ s/([^A-Za-z0-9])/sprintf("%%%02X", ord($1))/seg;

  return $string;
}

sub _url_decode {
  my $string = shift;

  # URLdecode
  $string =~ s/\%([A-Fa-f0-9]{2})/pack('C', hex($1))/seg;

  return $string;
}

1;

__END__