Added files.
Esse commit está contido em:
trizen
+94
@@ -0,0 +1,94 @@
|
||||
|
||||
use utf8;
|
||||
use 5.010;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Module::Build;
|
||||
|
||||
my $gtk = grep { /^--?gtk3?\z/ } @ARGV;
|
||||
|
||||
my $builder = Module::Build->new(
|
||||
|
||||
module_name => 'WWW::PipeViewer',
|
||||
license => 'perl',
|
||||
dist_author => q{Trizen <echo dHJpemVuQHByb3Rvbm1haWwuY29tCg== | base64 -d>},
|
||||
dist_version_from => 'lib/WWW/PipeViewer.pm',
|
||||
release_status => 'stable',
|
||||
|
||||
build_requires => {
|
||||
'Test::More' => 0,
|
||||
},
|
||||
|
||||
extra_manify_args => { utf8 => 1 },
|
||||
|
||||
configure_requires => {
|
||||
'Module::Build' => 0,
|
||||
},
|
||||
|
||||
get_options => {
|
||||
'gtk3' => {
|
||||
type => '!',
|
||||
store => \$gtk,
|
||||
},
|
||||
},
|
||||
|
||||
requires => {
|
||||
'perl' => 5.016,
|
||||
'Data::Dump' => 0,
|
||||
'File::Spec' => 0,
|
||||
'File::Spec::Functions' => 0,
|
||||
'File::Path' => 0,
|
||||
'Getopt::Long' => 0,
|
||||
'HTTP::Request' => 0,
|
||||
'JSON' => 0,
|
||||
'Encode' => 0,
|
||||
'Memoize' => 0,
|
||||
'MIME::Base64' => 0,
|
||||
'List::Util' => 0,
|
||||
'LWP::UserAgent' => 0,
|
||||
'LWP::Protocol::https' => 0,
|
||||
'Term::ANSIColor' => 0,
|
||||
'Term::ReadLine' => 0,
|
||||
'Text::ParseWords' => 0,
|
||||
'Text::Wrap' => 0,
|
||||
'URI::Escape' => 0,
|
||||
|
||||
$gtk
|
||||
? (
|
||||
'Gtk3' => 0,
|
||||
'File::ShareDir' => 0,
|
||||
'Storable' => 0,
|
||||
'Digest::MD5' => 0,
|
||||
)
|
||||
: (),
|
||||
},
|
||||
|
||||
recommends => {
|
||||
'LWP::UserAgent::Cached' => 0, # cache support
|
||||
'Term::ReadLine::Gnu' => 0, # for better STDIN support (+history)
|
||||
'JSON::XS' => 0, # faster JSON to HASH conversion
|
||||
'Mozilla::CA' => 0, # just in case if there are SSL problems
|
||||
},
|
||||
|
||||
auto_features => {
|
||||
fixed_width_support => {
|
||||
description => "Print the results in a fixed-width format (--fixed-width, -W)",
|
||||
requires => {
|
||||
'Unicode::GCString' => 0, # this is recommended
|
||||
#'Text::CharWidth' => 0, # this works as fallback
|
||||
},
|
||||
},
|
||||
},
|
||||
|
||||
add_to_cleanup => ['WWW-PipeViewer-*'],
|
||||
create_makefile_pl => 'traditional',
|
||||
);
|
||||
|
||||
$builder->script_files(
|
||||
['bin/pipe-viewer',
|
||||
($gtk ? ('bin/gtk-pipe-viewer') : ()),
|
||||
]
|
||||
);
|
||||
|
||||
$builder->share_dir('share') if $gtk;
|
||||
$builder->create_build_script();
|
||||
+10
@@ -0,0 +1,10 @@
|
||||
# Revision history for pipe-viewer.
|
||||
|
||||
# For all changes, check out the release notes at:
|
||||
# https://github.com/trizen/pipe-viewer/releases
|
||||
|
||||
[CHANGELOG]
|
||||
|
||||
Version 0.0.1
|
||||
|
||||
- To be released soon.
|
||||
+201
@@ -0,0 +1,201 @@
|
||||
The Artistic License 2.0
|
||||
|
||||
Copyright (c) 2000-2006, The Perl Foundation.
|
||||
|
||||
Everyone is permitted to copy and distribute verbatim copies
|
||||
of this license document, but changing it is not allowed.
|
||||
|
||||
Preamble
|
||||
|
||||
This license establishes the terms under which a given free software
|
||||
Package may be copied, modified, distributed, and/or redistributed.
|
||||
The intent is that the Copyright Holder maintains some artistic
|
||||
control over the development of that Package while still keeping the
|
||||
Package available as open source and free software.
|
||||
|
||||
You are always permitted to make arrangements wholly outside of this
|
||||
license directly with the Copyright Holder of a given Package. If the
|
||||
terms of this license do not permit the full use that you propose to
|
||||
make of the Package, you should contact the Copyright Holder and seek
|
||||
a different licensing arrangement.
|
||||
|
||||
Definitions
|
||||
|
||||
"Copyright Holder" means the individual(s) or organization(s)
|
||||
named in the copyright notice for the entire Package.
|
||||
|
||||
"Contributor" means any party that has contributed code or other
|
||||
material to the Package, in accordance with the Copyright Holder's
|
||||
procedures.
|
||||
|
||||
"You" and "your" means any person who would like to copy,
|
||||
distribute, or modify the Package.
|
||||
|
||||
"Package" means the collection of files distributed by the
|
||||
Copyright Holder, and derivatives of that collection and/or of
|
||||
those files. A given Package may consist of either the Standard
|
||||
Version, or a Modified Version.
|
||||
|
||||
"Distribute" means providing a copy of the Package or making it
|
||||
accessible to anyone else, or in the case of a company or
|
||||
organization, to others outside of your company or organization.
|
||||
|
||||
"Distributor Fee" means any fee that you charge for Distributing
|
||||
this Package or providing support for this Package to another
|
||||
party. It does not mean licensing fees.
|
||||
|
||||
"Standard Version" refers to the Package if it has not been
|
||||
modified, or has been modified only in ways explicitly requested
|
||||
by the Copyright Holder.
|
||||
|
||||
"Modified Version" means the Package, if it has been changed, and
|
||||
such changes were not explicitly requested by the Copyright
|
||||
Holder.
|
||||
|
||||
"Original License" means this Artistic License as Distributed with
|
||||
the Standard Version of the Package, in its current version or as
|
||||
it may be modified by The Perl Foundation in the future.
|
||||
|
||||
"Source" form means the source code, documentation source, and
|
||||
configuration files for the Package.
|
||||
|
||||
"Compiled" form means the compiled bytecode, object code, binary,
|
||||
or any other form resulting from mechanical transformation or
|
||||
translation of the Source form.
|
||||
|
||||
|
||||
Permission for Use and Modification Without Distribution
|
||||
|
||||
(1) You are permitted to use the Standard Version and create and use
|
||||
Modified Versions for any purpose without restriction, provided that
|
||||
you do not Distribute the Modified Version.
|
||||
|
||||
|
||||
Permissions for Redistribution of the Standard Version
|
||||
|
||||
(2) You may Distribute verbatim copies of the Source form of the
|
||||
Standard Version of this Package in any medium without restriction,
|
||||
either gratis or for a Distributor Fee, provided that you duplicate
|
||||
all of the original copyright notices and associated disclaimers. At
|
||||
your discretion, such verbatim copies may or may not include a
|
||||
Compiled form of the Package.
|
||||
|
||||
(3) You may apply any bug fixes, portability changes, and other
|
||||
modifications made available from the Copyright Holder. The resulting
|
||||
Package will still be considered the Standard Version, and as such
|
||||
will be subject to the Original License.
|
||||
|
||||
|
||||
Distribution of Modified Versions of the Package as Source
|
||||
|
||||
(4) You may Distribute your Modified Version as Source (either gratis
|
||||
or for a Distributor Fee, and with or without a Compiled form of the
|
||||
Modified Version) provided that you clearly document how it differs
|
||||
from the Standard Version, including, but not limited to, documenting
|
||||
any non-standard features, executables, or modules, and provided that
|
||||
you do at least ONE of the following:
|
||||
|
||||
(a) make the Modified Version available to the Copyright Holder
|
||||
of the Standard Version, under the Original License, so that the
|
||||
Copyright Holder may include your modifications in the Standard
|
||||
Version.
|
||||
|
||||
(b) ensure that installation of your Modified Version does not
|
||||
prevent the user installing or running the Standard Version. In
|
||||
addition, the Modified Version must bear a name that is different
|
||||
from the name of the Standard Version.
|
||||
|
||||
(c) allow anyone who receives a copy of the Modified Version to
|
||||
make the Source form of the Modified Version available to others
|
||||
under
|
||||
|
||||
(i) the Original License or
|
||||
|
||||
(ii) a license that permits the licensee to freely copy,
|
||||
modify and redistribute the Modified Version using the same
|
||||
licensing terms that apply to the copy that the licensee
|
||||
received, and requires that the Source form of the Modified
|
||||
Version, and of any works derived from it, be made freely
|
||||
available in that license fees are prohibited but Distributor
|
||||
Fees are allowed.
|
||||
|
||||
|
||||
Distribution of Compiled Forms of the Standard Version
|
||||
or Modified Versions without the Source
|
||||
|
||||
(5) You may Distribute Compiled forms of the Standard Version without
|
||||
the Source, provided that you include complete instructions on how to
|
||||
get the Source of the Standard Version. Such instructions must be
|
||||
valid at the time of your distribution. If these instructions, at any
|
||||
time while you are carrying out such distribution, become invalid, you
|
||||
must provide new instructions on demand or cease further distribution.
|
||||
If you provide valid instructions or cease distribution within thirty
|
||||
days after you become aware that the instructions are invalid, then
|
||||
you do not forfeit any of your rights under this license.
|
||||
|
||||
(6) You may Distribute a Modified Version in Compiled form without
|
||||
the Source, provided that you comply with Section 4 with respect to
|
||||
the Source of the Modified Version.
|
||||
|
||||
|
||||
Aggregating or Linking the Package
|
||||
|
||||
(7) You may aggregate the Package (either the Standard Version or
|
||||
Modified Version) with other packages and Distribute the resulting
|
||||
aggregation provided that you do not charge a licensing fee for the
|
||||
Package. Distributor Fees are permitted, and licensing fees for other
|
||||
components in the aggregation are permitted. The terms of this license
|
||||
apply to the use and Distribution of the Standard or Modified Versions
|
||||
as included in the aggregation.
|
||||
|
||||
(8) You are permitted to link Modified and Standard Versions with
|
||||
other works, to embed the Package in a larger work of your own, or to
|
||||
build stand-alone binary or bytecode versions of applications that
|
||||
include the Package, and Distribute the result without restriction,
|
||||
provided the result does not expose a direct interface to the Package.
|
||||
|
||||
|
||||
Items That are Not Considered Part of a Modified Version
|
||||
|
||||
(9) Works (including, but not limited to, modules and scripts) that
|
||||
merely extend or make use of the Package, do not, by themselves, cause
|
||||
the Package to be a Modified Version. In addition, such works are not
|
||||
considered parts of the Package itself, and are not subject to the
|
||||
terms of this license.
|
||||
|
||||
|
||||
General Provisions
|
||||
|
||||
(10) 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.
|
||||
|
||||
(11) 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.
|
||||
|
||||
(12) This license does not grant you the right to use any trademark,
|
||||
service mark, tradename, or logo of the Copyright Holder.
|
||||
|
||||
(13) 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.
|
||||
|
||||
(14) 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.
|
||||
+39
@@ -0,0 +1,39 @@
|
||||
bin/gtk-pipe-viewer
|
||||
bin/pipe-viewer
|
||||
Build.PL
|
||||
Changes
|
||||
lib/WWW/PipeViewer.pm
|
||||
lib/WWW/PipeViewer/Activities.pm
|
||||
lib/WWW/PipeViewer/Authentication.pm
|
||||
lib/WWW/PipeViewer/Channels.pm
|
||||
lib/WWW/PipeViewer/CommentThreads.pm
|
||||
lib/WWW/PipeViewer/GetCaption.pm
|
||||
lib/WWW/PipeViewer/GuideCategories.pm
|
||||
lib/WWW/PipeViewer/Itags.pm
|
||||
lib/WWW/PipeViewer/ParseJSON.pm
|
||||
lib/WWW/PipeViewer/ParseXML.pm
|
||||
lib/WWW/PipeViewer/PlaylistItems.pm
|
||||
lib/WWW/PipeViewer/Playlists.pm
|
||||
lib/WWW/PipeViewer/RegularExpressions.pm
|
||||
lib/WWW/PipeViewer/Search.pm
|
||||
lib/WWW/PipeViewer/Subscriptions.pm
|
||||
lib/WWW/PipeViewer/Utils.pm
|
||||
lib/WWW/PipeViewer/VideoCategories.pm
|
||||
lib/WWW/PipeViewer/Videos.pm
|
||||
LICENSE
|
||||
Makefile.PL
|
||||
MANIFEST This list of files
|
||||
META.json
|
||||
META.yml
|
||||
README.md
|
||||
share/gtk-pipe-viewer.desktop
|
||||
share/gtk-pipe-viewer.glade
|
||||
share/icons/default_thumb.jpg
|
||||
share/icons/feed.png
|
||||
share/icons/feed_gray.png
|
||||
share/icons/gtk-pipe-viewer.png
|
||||
share/icons/spinner.gif
|
||||
share/icons/user.png
|
||||
t/00-load.t
|
||||
t/kwalitee.t
|
||||
t/pod.t
|
||||
@@ -0,0 +1,79 @@
|
||||
|
||||
#!start included /usr/share/perl5/core_perl/ExtUtils/MANIFEST.SKIP
|
||||
# Avoid version control files.
|
||||
\bRCS\b
|
||||
\bCVS\b
|
||||
\bSCCS\b
|
||||
,v$
|
||||
\B\.svn\b
|
||||
\B\.git\b
|
||||
\B\.gitignore\b
|
||||
\b_darcs\b
|
||||
\B\.cvsignore$
|
||||
|
||||
# Avoid VMS specific MakeMaker generated files
|
||||
\bDescrip.MMS$
|
||||
\bDESCRIP.MMS$
|
||||
\bdescrip.mms$
|
||||
|
||||
# Avoid Makemaker generated and utility files.
|
||||
\bMANIFEST\.bak
|
||||
\bMakefile$
|
||||
\bblib/
|
||||
\bMakeMaker-\d
|
||||
\bpm_to_blib\.ts$
|
||||
\bpm_to_blib$
|
||||
\bblibdirs\.ts$ # 6.18 through 6.25 generated this
|
||||
|
||||
# Avoid Module::Build generated and utility files.
|
||||
\bBuild$
|
||||
\b_build/
|
||||
\bBuild.bat$
|
||||
\bBuild.COM$
|
||||
\bBUILD.COM$
|
||||
\bbuild.com$
|
||||
|
||||
# Other files
|
||||
.github/FUNDING.yml
|
||||
bin/inv.json
|
||||
bin/yv.json
|
||||
|
||||
# Avoid temp and backup files.
|
||||
~$
|
||||
\.old$
|
||||
\#$
|
||||
\b\.#
|
||||
\.bak$
|
||||
\.tmp$
|
||||
\.#
|
||||
\.rej$
|
||||
|
||||
# Avoid OS-specific files/dirs
|
||||
# Mac OSX metadata
|
||||
\B\.DS_Store
|
||||
# Mac OSX SMB mount metadata files
|
||||
\B\._
|
||||
|
||||
# Avoid Devel::Cover and Devel::CoverX::Covered files.
|
||||
\bcover_db\b
|
||||
\bcovered\b
|
||||
|
||||
# Avoid MYMETA files
|
||||
^MYMETA\.
|
||||
#!end included /usr/share/perl5/core_perl/ExtUtils/MANIFEST.SKIP
|
||||
|
||||
# Avoid configuration metadata file
|
||||
^MYMETA\.
|
||||
|
||||
# Avoid Module::Build generated and utility files.
|
||||
\bBuild$
|
||||
\bBuild.bat$
|
||||
\b_build
|
||||
\bBuild.COM$
|
||||
\bBUILD.COM$
|
||||
\bbuild.com$
|
||||
^MANIFEST\.SKIP
|
||||
|
||||
# Avoid archives of this distribution
|
||||
\bWWW-PipeViewer-[\d\.\_]+
|
||||
WWW-PipeViewer-*
|
||||
@@ -0,0 +1,35 @@
|
||||
# Note: this file was auto-generated by Module::Build::Compat version 0.4231
|
||||
require 5.016;
|
||||
use ExtUtils::MakeMaker;
|
||||
WriteMakefile
|
||||
(
|
||||
'NAME' => 'WWW::PipeViewer',
|
||||
'VERSION_FROM' => 'lib/WWW/PipeViewer.pm',
|
||||
'PREREQ_PM' => {
|
||||
'Data::Dump' => 0,
|
||||
'Encode' => 0,
|
||||
'File::Path' => 0,
|
||||
'File::Spec' => 0,
|
||||
'File::Spec::Functions' => 0,
|
||||
'Getopt::Long' => 0,
|
||||
'HTTP::Request' => 0,
|
||||
'JSON' => 0,
|
||||
'LWP::Protocol::https' => 0,
|
||||
'LWP::UserAgent' => 0,
|
||||
'List::Util' => 0,
|
||||
'MIME::Base64' => 0,
|
||||
'Memoize' => 0,
|
||||
'Term::ANSIColor' => 0,
|
||||
'Term::ReadLine' => 0,
|
||||
'Test::More' => 0,
|
||||
'Text::ParseWords' => 0,
|
||||
'Text::Wrap' => 0,
|
||||
'URI::Escape' => 0
|
||||
},
|
||||
'INSTALLDIRS' => 'site',
|
||||
'EXE_FILES' => [
|
||||
'bin/pipe-viewer'
|
||||
],
|
||||
'PL_FILES' => {}
|
||||
)
|
||||
;
|
||||
+140
@@ -0,0 +1,140 @@
|
||||
## pipe-viewer
|
||||
|
||||
A lightweight application (fork of [straw-viewer](https://github.com/trizen/straw-viewer)) for searching and playing videos from YouTube, using the [API](https://github.com/iv-org/invidious/wiki/API) of [invidio.us](https://invidio.us/).
|
||||
|
||||
The goal of this fork is to parse the YouTube website directly, removing the dependency on invidious instances.
|
||||
|
||||
### pipe-viewer
|
||||
|
||||
* command-line interface to YouTube.
|
||||
|
||||
|
||||
|
||||
### gtk-pipe-viewer
|
||||
|
||||
* GTK+ interface to YouTube.
|
||||
|
||||
|
||||
|
||||
|
||||
### STATUS
|
||||
|
||||
The project is in its early stages of development and some features are not implemented yet.
|
||||
|
||||
Currently, only the searching for videos uses the YouTube website directly.
|
||||
|
||||
|
||||
### AVAILABILITY
|
||||
|
||||
* Arch Linux (AUR): https://aur.archlinux.org/packages/pipe-viewer-git/
|
||||
|
||||
|
||||
### INSTALLATION
|
||||
|
||||
To install `pipe-viewer`, run:
|
||||
|
||||
```console
|
||||
perl Build.PL
|
||||
sudo ./Build installdeps
|
||||
sudo ./Build install
|
||||
```
|
||||
|
||||
To install `gtk-pipe-viewer` along with `pipe-viewer`, run:
|
||||
|
||||
```console
|
||||
perl Build.PL --gtk
|
||||
sudo ./Build installdeps
|
||||
sudo ./Build install
|
||||
```
|
||||
|
||||
|
||||
### TRY
|
||||
|
||||
For trying the latest commit of `pipe-viewer`, without installing it, execute the following commands:
|
||||
|
||||
```console
|
||||
cd /tmp
|
||||
wget https://github.com/trizen/pipe-viewer/archive/master.zip -O pipe-viewer-master.zip
|
||||
unzip -n pipe-viewer-master.zip
|
||||
cd pipe-viewer-master/bin
|
||||
perl -pi -ne 's{DEVEL = 0}{DEVEL = 1}' {gtk-,}pipe-viewer
|
||||
./pipe-viewer
|
||||
```
|
||||
|
||||
|
||||
### DEPENDENCIES
|
||||
|
||||
#### For pipe-viewer:
|
||||
|
||||
* [libwww-perl](https://metacpan.org/release/libwww-perl)
|
||||
* [LWP::Protocol::https](https://metacpan.org/release/LWP-Protocol-https)
|
||||
* [Data::Dump](https://metacpan.org/release/Data-Dump)
|
||||
* [JSON](https://metacpan.org/release/JSON)
|
||||
|
||||
#### For gtk-pipe-viewer:
|
||||
|
||||
* [Gtk3](https://metacpan.org/release/Gtk3)
|
||||
* [File::ShareDir](https://metacpan.org/release/File-ShareDir)
|
||||
* \+ the dependencies required by pipe-viewer.
|
||||
|
||||
#### Build dependencies:
|
||||
|
||||
* [Module::Build](https://metacpan.org/pod/Module::Build)
|
||||
|
||||
#### Optional dependencies:
|
||||
|
||||
* Local cache support: [LWP::UserAgent::Cached](https://metacpan.org/release/LWP-UserAgent-Cached)
|
||||
* Better STDIN support (+ history): [Term::ReadLine::Gnu](https://metacpan.org/release/Term-ReadLine-Gnu)
|
||||
* Faster JSON deserialization: [JSON::XS](https://metacpan.org/release/JSON-XS)
|
||||
* Fixed-width formatting (--fixed-width, -W): [Unicode::LineBreak](https://metacpan.org/release/Unicode-LineBreak) or [Text::CharWidth](https://metacpan.org/release/Text-CharWidth)
|
||||
|
||||
|
||||
### PACKAGING
|
||||
|
||||
To package this application, run the following commands:
|
||||
|
||||
```console
|
||||
perl Build.PL --destdir "/my/package/path" --installdirs vendor [--gtk]
|
||||
./Build test
|
||||
./Build install --install_path script=/usr/bin
|
||||
```
|
||||
|
||||
### INVIDIOUS INSTANCES
|
||||
|
||||
Sometimes, the default instance, [invidious.snopyta.org](https://invidious.snopyta.org/), may fail to work properly. When this happens, we can change the API host to some other instance of invidious, such as [invidious.tube](https://invidious.tube/):
|
||||
|
||||
```console
|
||||
pipe-viewer --api=invidious.tube
|
||||
```
|
||||
|
||||
To make the change permanent, set in the configuration file:
|
||||
|
||||
```perl
|
||||
api_host => "invidious.tube",
|
||||
```
|
||||
|
||||
Alternatively, the following will automatically pick a random invidious instance everytime the program is started:
|
||||
|
||||
```perl
|
||||
api_host => "auto",
|
||||
```
|
||||
|
||||
The available instances are listed at: https://instances.invidio.us/
|
||||
|
||||
|
||||
### SUPPORT AND DOCUMENTATION
|
||||
|
||||
After installing, you can find documentation with the following commands:
|
||||
|
||||
man pipe-viewer
|
||||
perldoc WWW::PipeViewer
|
||||
|
||||
### LICENSE AND COPYRIGHT
|
||||
|
||||
Copyright (C) 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 http://dev.perl.org/licenses/ for more information.
|
||||
Arquivo executável
+3652
Diferenças do arquivo suprimidas por serem muito extensas
Carregar Diff
Arquivo executável
+4532
Diferenças do arquivo suprimidas por serem muito extensas
Carregar Diff
Diferenças do arquivo suprimidas por serem muito extensas
Carregar Diff
@@ -0,0 +1,93 @@
|
||||
package WWW::PipeViewer::Activities;
|
||||
|
||||
use utf8;
|
||||
use 5.014;
|
||||
use warnings;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
WWW::PipeViewer::Activities - list of channel activity events that match the request criteria.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use WWW::PipeViewer;
|
||||
my $obj = WWW::PipeViewer->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<< <echo dHJpemVuQHByb3Rvbm1haWwuY29tCg== | base64 -d> >>
|
||||
|
||||
|
||||
=head1 SUPPORT
|
||||
|
||||
You can find documentation for this module with the perldoc command.
|
||||
|
||||
perldoc WWW::PipeViewer::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<http://dev.perl.org/licenses/> for more information.
|
||||
|
||||
=cut
|
||||
|
||||
1; # End of WWW::PipeViewer::Activities
|
||||
@@ -0,0 +1,216 @@
|
||||
package WWW::PipeViewer::Authentication;
|
||||
|
||||
use utf8;
|
||||
use 5.014;
|
||||
use warnings;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
WWW::PipeViewer::Authentication - OAuth login support.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use WWW::PipeViewer;
|
||||
my $hash_ref = WWW::PipeViewer->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<get_accounts_oauth_url()> 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<authentication_file>.
|
||||
|
||||
=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<key> 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<key> 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<authentication_file>.
|
||||
|
||||
=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<< <echo dHJpemVuQHByb3Rvbm1haWwuY29tCg== | base64 -d> >>
|
||||
|
||||
|
||||
=head1 SUPPORT
|
||||
|
||||
You can find documentation for this module with the perldoc command.
|
||||
|
||||
perldoc WWW::PipeViewer::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<http://dev.perl.org/licenses/> for more information.
|
||||
|
||||
=cut
|
||||
|
||||
1; # End of WWW::PipeViewer::Authentication
|
||||
@@ -0,0 +1,214 @@
|
||||
package WWW::PipeViewer::Channels;
|
||||
|
||||
use utf8;
|
||||
use 5.014;
|
||||
use warnings;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
WWW::PipeViewer::Channels - Channels interface.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use WWW::PipeViewer;
|
||||
my $obj = WWW::PipeViewer->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 popular_videos($channel_id)
|
||||
|
||||
Get the most popular videos for a given channel ID.
|
||||
|
||||
=cut
|
||||
|
||||
sub popular_videos {
|
||||
my ($self, $channel_id) = @_;
|
||||
|
||||
if (not defined($channel_id)) { # trending popular videos
|
||||
return $self->_get_results($self->_make_feed_url('popular'));
|
||||
}
|
||||
|
||||
return $self->_get_results($self->_make_feed_url("channels/$channel_id/videos", sort_by => 'popular'));
|
||||
}
|
||||
|
||||
=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) = @_;
|
||||
|
||||
# A channel's username (if it doesn't include spaces) is also valid in place of ucid.
|
||||
if ($username =~ /\w/ and not $username =~ /\s/) {
|
||||
return $username;
|
||||
}
|
||||
|
||||
# TODO: resolve channel name to channel ID
|
||||
return $username;
|
||||
}
|
||||
|
||||
=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<< <echo dHJpemVuQHByb3Rvbm1haWwuY29tCg== | base64 -d> >>
|
||||
|
||||
|
||||
=head1 SUPPORT
|
||||
|
||||
You can find documentation for this module with the perldoc command.
|
||||
|
||||
perldoc WWW::PipeViewer::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<http://dev.perl.org/licenses/> for more information.
|
||||
|
||||
=cut
|
||||
|
||||
1; # End of WWW::PipeViewer::Channels
|
||||
@@ -0,0 +1,98 @@
|
||||
package WWW::PipeViewer::CommentThreads;
|
||||
|
||||
use utf8;
|
||||
use 5.014;
|
||||
use warnings;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
WWW::PipeViewer::CommentThreads - Retrieve comments threads.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use WWW::PipeViewer;
|
||||
my $obj = WWW::PipeViewer->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<< <echo dHJpemVuQHByb3Rvbm1haWwuY29tCg== | base64 -d> >>
|
||||
|
||||
|
||||
=head1 SUPPORT
|
||||
|
||||
You can find documentation for this module with the perldoc command.
|
||||
|
||||
perldoc WWW::PipeViewer::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<http://dev.perl.org/licenses/> for more information.
|
||||
|
||||
=cut
|
||||
|
||||
1; # End of WWW::PipeViewer::CommentThreads
|
||||
@@ -0,0 +1,252 @@
|
||||
package WWW::PipeViewer::GetCaption;
|
||||
|
||||
use utf8;
|
||||
use 5.014;
|
||||
use warnings;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
WWW::PipeViewer::GetCaption - Save the YouTube closed captions as .srt files for a videoID.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use WWW::PipeViewer::GetCaption;
|
||||
|
||||
my $yv_cap = WWW::PipeViewer::GetCaption->new(%opts);
|
||||
my $file = $yv_cap->save_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)];
|
||||
$self->{yv_obj} = undef;
|
||||
|
||||
foreach my $key (keys %{$self}) {
|
||||
$self->{$key} = delete $opts{$key}
|
||||
if exists $opts{$key};
|
||||
}
|
||||
|
||||
$self->{yv_obj} //= do {
|
||||
require WWW::PipeViewer;
|
||||
WWW::PipeViewer->new(cache_dir => $self->{captions_dir},);
|
||||
};
|
||||
|
||||
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::PipeViewer::ParseXML;
|
||||
my $hash = eval { WWW::PipeViewer::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) = @_;
|
||||
$self->{yv_obj}->lwp_get($url, simple => 1);
|
||||
}
|
||||
|
||||
=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<< <echo dHJpemVuQHByb3Rvbm1haWwuY29tCg== | base64 -d> >>
|
||||
|
||||
|
||||
=head1 SUPPORT
|
||||
|
||||
You can find documentation for this module with the perldoc command.
|
||||
|
||||
perldoc WWW::PipeViewer::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<http://dev.perl.org/licenses/> for more information.
|
||||
|
||||
=cut
|
||||
|
||||
1; # End of WWW::PipeViewer::GetCaption
|
||||
@@ -0,0 +1,85 @@
|
||||
package WWW::PipeViewer::GuideCategories;
|
||||
|
||||
use utf8;
|
||||
use 5.014;
|
||||
use warnings;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
WWW::PipeViewer::GuideCategories - Categories interface.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use WWW::PipeViewer;
|
||||
my $obj = WWW::PipeViewer->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{region} //= $self->get_region;
|
||||
}
|
||||
|
||||
$self->_make_feed_url('guideCategories', %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 => 'region',
|
||||
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<< <echo dHJpemVuQHByb3Rvbm1haWwuY29tCg== | base64 -d> >>
|
||||
|
||||
|
||||
=head1 SUPPORT
|
||||
|
||||
You can find documentation for this module with the perldoc command.
|
||||
|
||||
perldoc WWW::PipeViewer::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<http://dev.perl.org/licenses/> for more information.
|
||||
|
||||
=cut
|
||||
|
||||
1; # End of WWW::PipeViewer::GuideCategories
|
||||
@@ -0,0 +1,299 @@
|
||||
package WWW::PipeViewer::Itags;
|
||||
|
||||
use utf8;
|
||||
use 5.014;
|
||||
use warnings;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
WWW::PipeViewer::Itags - Get the YouTube itags.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use WWW::PipeViewer::Itags;
|
||||
|
||||
my $yv_itags = WWW::PipeViewer::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' => [{value => 38, format => 'mp4'}, # mp4 (3072p) (v-a)
|
||||
{value => 138, format => 'mp4', dash => 1}, # mp4 (2160p-4320p) (v)
|
||||
{value => 266, format => 'mp4', dash => 1}, # mp4 (2160p-2304p) (v)
|
||||
],
|
||||
|
||||
'2160' => [{value => 315, format => 'webm', dash => 1, hfr => 1}, # webm HFR (v)
|
||||
{value => 272, format => 'webm', dash => 1}, # webm (v)
|
||||
{value => 313, format => 'webm', dash => 1}, # webm (v)
|
||||
{value => 401, format => 'av1', dash => 1}, # av1 (v)
|
||||
],
|
||||
|
||||
'1440' => [{value => 308, format => 'webm', dash => 1, hfr => 1}, # webm HFR (v)
|
||||
{value => 271, format => 'webm', dash => 1}, # webm (v)
|
||||
{value => 264, format => 'mp4', dash => 1}, # mp4 (v)
|
||||
{value => 400, format => 'av1', dash => 1}, # av1 (v)
|
||||
],
|
||||
|
||||
'1080' => [{value => 303, format => 'webm', dash => 1, hfr => 1}, # webm HFR (v)
|
||||
{value => 299, format => 'mp4', dash => 1, hfr => 1}, # mp4 HFR (v)
|
||||
{value => 248, format => 'webm', dash => 1}, # webm (v)
|
||||
{value => 137, format => 'mp4', dash => 1}, # mp4 (v)
|
||||
{value => 399, format => 'av1', dash => 1, hfr => 1}, # av1 (v)
|
||||
{value => 46, format => 'webm'}, # webm (v-a)
|
||||
{value => 37, format => 'mp4'}, # mp4 (v-a)
|
||||
{value => 301, format => 'mp4', live => 1}, # mp4 (live) (v-a)
|
||||
{value => 96, format => 'ts', live => 1}, # ts (live) (v-a)
|
||||
],
|
||||
|
||||
'720' => [{value => 302, format => 'webm', dash => 1, hfr => 1}, # webm HFR (v)
|
||||
{value => 298, format => 'mp4', dash => 1, hfr => 1}, # mp4 HFR (v)
|
||||
{value => 247, format => 'webm', dash => 1}, # webm (v)
|
||||
{value => 136, format => 'mp4', dash => 1}, # mp4 (v)
|
||||
{value => 398, format => 'av1', dash => 1, hfr => 1}, # av1 (v)
|
||||
{value => 45, format => 'webm'}, # webm (v-a)
|
||||
{value => 22, format => 'mp4'}, # mp4 (v-a)
|
||||
{value => 300, format => 'mp4', live => 1}, # mp4 (live) (v-a)
|
||||
{value => 120, format => 'flv', live => 1}, # flv (live) (v-a)
|
||||
{value => 95, format => 'ts', live => 1}, # ts (live) (v-a)
|
||||
],
|
||||
|
||||
'480' => [{value => 244, format => 'webm', dash => 1}, # webm (v)
|
||||
{value => 135, format => 'mp4', dash => 1}, # mp4 (v)
|
||||
{value => 397, format => 'av1', dash => 1}, # av1 (v)
|
||||
{value => 44, format => 'webm'}, # webm (v-a)
|
||||
{value => 35, format => 'flv'}, # flv (v-a)
|
||||
{value => 94, format => 'mp4', live => 1}, # mp4 (live) (v-a)
|
||||
],
|
||||
|
||||
'360' => [{value => 243, format => 'webm', dash => 1}, # webm (v)
|
||||
{value => 134, format => 'mp4', dash => 1}, # mp4 (v)
|
||||
{value => 396, format => 'av1', dash => 1}, # av1 (v)
|
||||
{value => 43, format => 'webm'}, # webm (v-a)
|
||||
{value => 34, format => 'flv'}, # flv (v-a)
|
||||
{value => 93, format => 'mp4', live => 1}, # mp4 (live) (v-a)
|
||||
{value => 18, format => 'mp4'}, # mp4 (v-a)
|
||||
],
|
||||
|
||||
'240' => [{value => 242, format => 'webm', dash => 1}, # webm (v)
|
||||
{value => 133, format => 'mp4', dash => 1}, # mp4 (v)
|
||||
{value => 395, format => 'av1', dash => 1}, # av1 (v)
|
||||
{value => 6, format => 'flv'}, # flv (270p) (v-a)
|
||||
{value => 5, format => 'flv'}, # flv (v-a)
|
||||
{value => 36, format => '3gp'}, # 3gp (v-a)
|
||||
{value => 13, format => '3gp'}, # 3gp (v-a)
|
||||
{value => 92, format => 'mp4', live => 1}, # mp4 (live) (v-a)
|
||||
{value => 132, format => 'ts', live => 1}, # ts (live) (v-a)
|
||||
],
|
||||
|
||||
'144' => [{value => 278, format => 'webm', dash => 1}, # webm (v)
|
||||
{value => 160, format => 'mp4', dash => 1}, # mp4 (v)
|
||||
{value => 394, format => 'av1', dash => 1}, # av1 (v)
|
||||
{value => 17, format => '3gp'}, # 3gp (v-a)
|
||||
{value => 91, format => 'mp4'}, # mp4 (live) (v-a)
|
||||
{value => 151, format => 'ts'}, # ts (live) (v-a)
|
||||
],
|
||||
|
||||
'audio' => [{value => 172, format => 'webm', kbps => 192}, # webm (192 kbps)
|
||||
{value => 251, format => 'opus', kbps => 160}, # webm opus (128-160 kbps)
|
||||
{value => 171, format => 'webm', kbps => 128}, # webm vorbis (92-128 kbps)
|
||||
{value => 140, format => 'm4a', kbps => 128}, # mp4a (128 kbps)
|
||||
{value => 141, format => 'm4a', kbps => 256}, # mp4a (256 kbps)
|
||||
{value => 250, format => 'opus', kbps => 64}, # webm opus (64 kbps)
|
||||
{value => 249, format => 'opus', kbps => 48}, # webm opus (48 kbps)
|
||||
{value => 139, format => 'm4a', kbps => 48}, # 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}}) {
|
||||
|
||||
next if not exists $stream->{$itag->{value}};
|
||||
|
||||
my $entry = $stream->{$itag->{value}};
|
||||
|
||||
if (defined($entry->{fps}) and $entry->{fps} >= 50) {
|
||||
$args{hfr} || next; # skip high frame rate (HFR) videos
|
||||
}
|
||||
|
||||
if ($itag->{format} eq 'av1') {
|
||||
$args{ignore_av1} && next; # ignore videos in AV1 format
|
||||
}
|
||||
|
||||
if ($itag->{dash}) {
|
||||
|
||||
$args{dash} || next;
|
||||
|
||||
my $video_info = $stream->{$itag->{value}};
|
||||
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 ($resolution eq 'audio' and not $args{dash_mp4_audio}) {
|
||||
if ($itag->{format} eq 'm4a') {
|
||||
next; # skip m4a audio URLs
|
||||
}
|
||||
}
|
||||
|
||||
# Ignore segmented DASH URLs (they load pretty slow in mpv)
|
||||
if (not $args{dash_segmented}) {
|
||||
next if ($entry->{url} =~ m{/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<< <echo dHJpemVuQHByb3Rvbm1haWwuY29tCg== | base64 -d> >>
|
||||
|
||||
|
||||
=head1 SUPPORT
|
||||
|
||||
You can find documentation for this module with the perldoc command.
|
||||
|
||||
perldoc WWW::PipeViewer::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<http://dev.perl.org/licenses/> for more information.
|
||||
|
||||
=cut
|
||||
|
||||
1; # End of WWW::PipeViewer::Itags
|
||||
@@ -0,0 +1,88 @@
|
||||
package WWW::PipeViewer::ParseJSON;
|
||||
|
||||
use utf8;
|
||||
use 5.014;
|
||||
use warnings;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
WWW::PipeViewer::ParseJSON - Parse JSON content.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use WWW::PipeViewer::ParseJSON;
|
||||
my $obj = WWW::PipeViewer::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_utf8_json_string {
|
||||
my ($self, $json) = @_;
|
||||
|
||||
if (not defined($json) or $json eq '') {
|
||||
return {};
|
||||
}
|
||||
|
||||
require JSON;
|
||||
my $hash = eval { JSON::from_json($json) };
|
||||
return $@ ? do { warn "[JSON]: $@\n"; {} } : $hash;
|
||||
}
|
||||
|
||||
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<< <echo dHJpemVuQHByb3Rvbm1haWwuY29tCg== | base64 -d> >>
|
||||
|
||||
|
||||
=head1 SUPPORT
|
||||
|
||||
You can find documentation for this module with the perldoc command.
|
||||
|
||||
perldoc WWW::PipeViewer::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<http://dev.perl.org/licenses/> for more information.
|
||||
|
||||
=cut
|
||||
|
||||
1; # End of WWW::PipeViewer::ParseJSON
|
||||
@@ -0,0 +1,311 @@
|
||||
package WWW::PipeViewer::ParseXML;
|
||||
|
||||
use utf8;
|
||||
use 5.014;
|
||||
use warnings;
|
||||
|
||||
=encoding utf8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
WWW::PipeViewer::ParseXML - Convert XML to a HASH ref structure.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
Parse XML content and return an HASH ref structure.
|
||||
|
||||
Usage:
|
||||
|
||||
use WWW::PipeViewer::ParseXML;
|
||||
my $hash_ref = WWW::PipeViewer::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<!\[CDATA\[(.*?)\]\]>\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<!\[CDATA\[(.*?)\]\]>\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<!--/gc) {
|
||||
$xml =~ /\G.*?-->\s*/gcs or die "Comment not closed!";
|
||||
redo;
|
||||
}
|
||||
elsif ($xml =~ /\G<!DOCTYPE\s+/gc) {
|
||||
$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<< <echo dHJpemVuQHByb3Rvbm1haWwuY29tCg== | base64 -d> >>
|
||||
|
||||
=head1 SUPPORT
|
||||
|
||||
You can find documentation for this module with the perldoc command.
|
||||
|
||||
perldoc WWW::PipeViewer::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<http://dev.perl.org/licenses/> for more information.
|
||||
|
||||
=cut
|
||||
|
||||
1; # End of WWW::PipeViewer::ParseXML
|
||||
@@ -0,0 +1,146 @@
|
||||
package WWW::PipeViewer::PlaylistItems;
|
||||
|
||||
use utf8;
|
||||
use 5.014;
|
||||
use warnings;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
WWW::PipeViewer::PlaylistItems - Manage playlist entries.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use WWW::PipeViewer;
|
||||
my $obj = WWW::PipeViewer->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<< <echo dHJpemVuQHByb3Rvbm1haWwuY29tCg== | base64 -d> >>
|
||||
|
||||
|
||||
=head1 SUPPORT
|
||||
|
||||
You can find documentation for this module with the perldoc command.
|
||||
|
||||
perldoc WWW::PipeViewer::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<http://dev.perl.org/licenses/> for more information.
|
||||
|
||||
=cut
|
||||
|
||||
1; # End of WWW::PipeViewer::PlaylistItems
|
||||
@@ -0,0 +1,116 @@
|
||||
package WWW::PipeViewer::Playlists;
|
||||
|
||||
use utf8;
|
||||
use 5.014;
|
||||
use warnings;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
WWW::PipeViewer::Playlists - YouTube playlists related mehods.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use WWW::PipeViewer;
|
||||
my $obj = WWW::PipeViewer->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',
|
||||
%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_feed_url("channels/playlists/$channel_id"));
|
||||
}
|
||||
|
||||
=head2 playlists_from_username($username)
|
||||
|
||||
Get and return the playlists created for a given username.
|
||||
|
||||
=cut
|
||||
|
||||
sub playlists_from_username {
|
||||
my ($self, $username) = @_;
|
||||
$self->playlists($username);
|
||||
}
|
||||
|
||||
=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<< <echo dHJpemVuQHByb3Rvbm1haWwuY29tCg== | base64 -d> >>
|
||||
|
||||
|
||||
=head1 SUPPORT
|
||||
|
||||
You can find documentation for this module with the perldoc command.
|
||||
|
||||
perldoc WWW::PipeViewer::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<http://dev.perl.org/licenses/> for more information.
|
||||
|
||||
=cut
|
||||
|
||||
1; # End of WWW::PipeViewer::Playlists
|
||||
@@ -0,0 +1,89 @@
|
||||
package WWW::PipeViewer::RegularExpressions;
|
||||
|
||||
use utf8;
|
||||
use 5.014;
|
||||
use warnings;
|
||||
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
|
||||
=head1 NAME
|
||||
|
||||
WWW::PipeViewer::RegularExpressions - Various utils.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use WWW::PipeViewer::RegularExpressions;
|
||||
use WWW::PipeViewer::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,3}+)(?>-|\.\.)([0-9]{1,3}+)?\z};
|
||||
our $digit_or_equal_re = qr/(?(?=[1-9])|=)/;
|
||||
our $non_digit_or_opt_re = qr{^(?!$range_num_re)(?>[0-9]{1,3}[^0-9]|[0-9]{4}|[^0-9$opt_begin_chars])};
|
||||
|
||||
# Generic name
|
||||
my $generic_name_re = qr/[a-zA-Z0-9_.\-]{11,64}/;
|
||||
our $valid_channel_id_re = qr{^(?:.*/channel/)?(?<channel_id>(?:\w+(?:[-.]++\w++)*|$generic_name_re))(?:/.*)?\z};
|
||||
|
||||
our $get_channel_videos_id_re = qr{^.*/channel/(?<channel_id>(?:\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/(?<username>[-.\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>$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/)(?<playlist_id>$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<< <echo dHJpemVuQHByb3Rvbm1haWwuY29tCg== | base64 -d> >>
|
||||
|
||||
|
||||
=head1 SUPPORT
|
||||
|
||||
You can find documentation for this module with the perldoc command.
|
||||
|
||||
perldoc WWW::PipeViewer::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<http://dev.perl.org/licenses/> for more information.
|
||||
|
||||
=cut
|
||||
|
||||
1; # End of WWW::PipeViewer::RegularExpressions
|
||||
@@ -0,0 +1,498 @@
|
||||
package WWW::PipeViewer::Search;
|
||||
|
||||
use utf8;
|
||||
use 5.014;
|
||||
use warnings;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
WWW::PipeViewer::Search - Search for stuff on YouTube
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use WWW::PipeViewer;
|
||||
my $obj = WWW::PipeViewer->new(%opts);
|
||||
$obj->search_videos(@keywords);
|
||||
|
||||
=head1 SUBROUTINES/METHODS
|
||||
|
||||
=cut
|
||||
|
||||
sub _time_to_seconds {
|
||||
my ($time) = @_;
|
||||
|
||||
my ($hours, $minutes, $seconds) = (0, 0, 0);
|
||||
|
||||
if ($time =~ /(\d+):(\d+):(\d+)/) {
|
||||
($hours, $minutes, $seconds) = ($1, $2, $3);
|
||||
}
|
||||
elsif ($time =~ /(\d+):(\d+)/) {
|
||||
($minutes, $seconds) = ($1, $2);
|
||||
}
|
||||
elsif ($time =~ /(\d+)/) {
|
||||
$seconds = $1;
|
||||
}
|
||||
|
||||
$hours * 3600 + $minutes * 60 + $seconds;
|
||||
}
|
||||
|
||||
sub _view_count_text_to_int {
|
||||
my ($text) = @_;
|
||||
|
||||
if ($text =~ /([\d,.]+)/) {
|
||||
my $v = $1;
|
||||
$v =~ tr/.,//d;
|
||||
return $v;
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub _thumbnail_quality {
|
||||
my ($width, $height) = @_;
|
||||
|
||||
$width // return 'medium';
|
||||
$height // return 'medium';
|
||||
|
||||
if ($width == 1280 and $height == 720) {
|
||||
return "maxres";
|
||||
}
|
||||
|
||||
if ($width == 640 and $height == 480) {
|
||||
return "sddefault";
|
||||
}
|
||||
|
||||
if ($width == 480 and $height == 360) {
|
||||
return 'high';
|
||||
}
|
||||
|
||||
if ($width == 320 and $height == 180) {
|
||||
return 'medium';
|
||||
}
|
||||
|
||||
if ($width == 120 and $height == 90) {
|
||||
return 'default';
|
||||
}
|
||||
|
||||
return 'medium';
|
||||
}
|
||||
|
||||
sub _extract_youtube_mix {
|
||||
my ($self, $data) = @_;
|
||||
|
||||
my $info = eval { $data->{callToAction}{watchCardHeroVideoRenderer} } || return;
|
||||
my $header = eval { $data->{header}{watchCardRichHeaderRenderer} };
|
||||
|
||||
my %mix;
|
||||
|
||||
$mix{type} = 'playlist';
|
||||
|
||||
$mix{title} =
|
||||
eval { $header->{title}{runs}[0]{text} }
|
||||
// eval { $info->{accessibility}{accessibilityData}{label} }
|
||||
// eval { $info->{callToActionButton}{callToActionButtonRenderer}{label}{runs}[0]{text} } // 'Youtube Mix';
|
||||
|
||||
$mix{playlistId} = eval { $info->{navigationEndpoint}{watchEndpoint}{playlistId} } || return;
|
||||
|
||||
$mix{playlistThumbnail} = eval { $header->{avatar}{thumbnails}[0]{url} }
|
||||
// eval { $info->{heroImage}{collageHeroImageRenderer}{leftThumbnail}{thumbnails}[0]{url} };
|
||||
|
||||
$mix{author} = eval { $header->{title}{runs}[0]{text} } // "YouTube";
|
||||
$mix{authorId} = eval { $header->{titleNavigationEndpoint}{browseEndpoint}{browseId} } // "youtube";
|
||||
|
||||
return \%mix;
|
||||
}
|
||||
|
||||
sub _extract_search_entry {
|
||||
my ($self, $data, %args) = @_;
|
||||
|
||||
# Album
|
||||
if ($args{type} eq 'all' and exists $data->{horizontalCardListRenderer}) { # TODO
|
||||
return;
|
||||
}
|
||||
|
||||
# Video
|
||||
if (exists $data->{compactVideoRenderer}) {
|
||||
|
||||
my %video;
|
||||
|
||||
my $info = $data->{compactVideoRenderer};
|
||||
|
||||
$video{title} =
|
||||
eval { $info->{title}{runs}[0]{text} } // eval { $info->{title}{accessibility}{accessibilityData}{label} } // return;
|
||||
$video{videoId} = eval { $info->{navigationEndpoint}{watchEndpoint}{videoId} } // $info->{videoId} // return;
|
||||
$video{author} = eval { $info->{longBylineText}{runs}[0]{text} } // eval { $info->{shortBylineText}{runs}[0]{text} };
|
||||
$video{authorId} = $info->{channelId};
|
||||
$video{publishedText} = eval { $info->{publishedTimeText}{runs}[0]{text} };
|
||||
$video{viewCountText} = eval { $info->{shortViewCountText}{runs}[0]{text} };
|
||||
$video{videoThumbnails} = eval {
|
||||
[
|
||||
map {
|
||||
my %thumb = %$_;
|
||||
$thumb{quality} = _thumbnail_quality($thumb{width}, $thumb{height});
|
||||
\%thumb;
|
||||
} @{$info->{thumbnail}{thumbnails}}
|
||||
]
|
||||
};
|
||||
|
||||
# FIXME: this is not the video description
|
||||
$video{description} = eval { $info->{title}{accessibility}{accessibilityData}{label} };
|
||||
|
||||
my $time = eval { $info->{thumbnailOverlays}[0]{thumbnailOverlayTimeStatusRenderer}{text}{runs}[0]{text} };
|
||||
|
||||
if (defined($time)) {
|
||||
$video{lengthSeconds} = eval { _time_to_seconds($time) };
|
||||
}
|
||||
|
||||
$video{title} = eval { $info->{title}{runs}[0]{text} };
|
||||
|
||||
my $viewCountText = eval { $info->{viewCountText}{runs}[0]{text} };
|
||||
|
||||
if (defined($viewCountText)) {
|
||||
$video{viewCount} = _view_count_text_to_int($viewCountText);
|
||||
}
|
||||
|
||||
return \%video;
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub _extract_search_results {
|
||||
my ($self, $data, %args) = @_;
|
||||
|
||||
eval { ref($data->{contents}{sectionListRenderer}{contents}) eq 'ARRAY' } or return;
|
||||
|
||||
my @results;
|
||||
|
||||
foreach my $entry (@{$data->{contents}{sectionListRenderer}{contents}}) {
|
||||
|
||||
# YouTube Mix
|
||||
if ($args{type} eq 'all' and exists $entry->{universalWatchCardRenderer}) {
|
||||
|
||||
my $mix = $self->_extract_youtube_mix($entry->{universalWatchCardRenderer});
|
||||
|
||||
if (defined($mix)) {
|
||||
push(@results, $mix);
|
||||
}
|
||||
}
|
||||
|
||||
# Search results
|
||||
if (exists $entry->{itemSectionRenderer}) {
|
||||
|
||||
eval { ref($entry->{itemSectionRenderer}{contents}) eq 'ARRAY' } || next;
|
||||
|
||||
foreach my $entry (@{$entry->{itemSectionRenderer}{contents}}) {
|
||||
|
||||
my $search_entry = $self->_extract_search_entry($entry, %args);
|
||||
|
||||
if (defined($search_entry)) {
|
||||
|
||||
#use Data::Dump qw(pp);
|
||||
#pp $search_entry;
|
||||
push @results, $search_entry;
|
||||
}
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
# Continuation page
|
||||
if (exists $entry->{continuationItemRenderer}) { # TODO
|
||||
## ...
|
||||
}
|
||||
}
|
||||
|
||||
return @results;
|
||||
}
|
||||
|
||||
sub _youtube_search {
|
||||
my ($self, %args) = @_;
|
||||
|
||||
my $content = $self->lwp_get($self->get_m_youtube_url . "/results?search_query=$args{q}");
|
||||
|
||||
if ($content =~ m{<div id="initial-data"><!--(.*?)--></div>}is) {
|
||||
my $json = $1;
|
||||
my $hash = $self->parse_utf8_json_string($json);
|
||||
return $self->_extract_search_results($hash, %args);
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub _make_search_url {
|
||||
my ($self, %opts) = @_;
|
||||
|
||||
my @features;
|
||||
|
||||
if (defined(my $vd = $self->get_videoDefinition)) {
|
||||
if ($vd eq 'high') {
|
||||
push @features, 'hd';
|
||||
}
|
||||
}
|
||||
|
||||
if (defined(my $vc = $self->get_videoCaption)) {
|
||||
if ($vc eq 'true' or $vc eq '1') {
|
||||
push @features, 'subtitles';
|
||||
}
|
||||
}
|
||||
|
||||
if (defined(my $vd = $self->get_videoDimension)) {
|
||||
if ($vd eq '3d') {
|
||||
push @features, '3d';
|
||||
}
|
||||
}
|
||||
|
||||
if (defined(my $license = $self->get_videoLicense)) {
|
||||
if ($license eq 'creative_commons') {
|
||||
push @features, 'creative_commons';
|
||||
}
|
||||
}
|
||||
|
||||
return $self->_make_feed_url(
|
||||
'search',
|
||||
|
||||
region => $self->get_region,
|
||||
sort_by => $self->get_order,
|
||||
date => $self->get_date,
|
||||
page => $self->page_token,
|
||||
duration => $self->get_videoDuration,
|
||||
|
||||
(@features ? (features => join(',', @features)) : ()),
|
||||
|
||||
%opts,
|
||||
);
|
||||
}
|
||||
|
||||
=head2 search_for($types,$keywords;\%args)
|
||||
|
||||
Search for a list of types (comma-separated).
|
||||
|
||||
=cut
|
||||
|
||||
sub search_for {
|
||||
my ($self, $type, $keywords, $args) = @_;
|
||||
|
||||
if (ref($args) ne 'HASH') {
|
||||
$args = {};
|
||||
}
|
||||
|
||||
$keywords //= [];
|
||||
|
||||
if (ref($keywords) ne 'ARRAY') {
|
||||
$keywords = [split ' ', $keywords];
|
||||
}
|
||||
|
||||
$keywords = $self->escape_string(join(' ', @{$keywords}));
|
||||
|
||||
# Search in a channel's videos
|
||||
if (defined(my $channel_id = $self->get_channelId)) {
|
||||
my $url = $self->_make_feed_url("channels/search/$channel_id", q => $keywords,);
|
||||
return $self->_get_results($url);
|
||||
}
|
||||
|
||||
my $url = $self->_make_search_url(
|
||||
type => $type,
|
||||
q => $keywords,
|
||||
%$args,
|
||||
);
|
||||
|
||||
return
|
||||
scalar {
|
||||
url => $url,
|
||||
results => [$self->_youtube_search(q => $keywords, type => $type, %$args)],
|
||||
};
|
||||
|
||||
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 => 'all',
|
||||
}
|
||||
) {
|
||||
*{__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, $videoID) = @_;
|
||||
|
||||
my %info = $self->_get_video_info($videoID);
|
||||
my $watch_next_response = $self->parse_json_string($info{watch_next_response});
|
||||
my $related =
|
||||
eval { $watch_next_response->{contents}{twoColumnWatchNextResults}{secondaryResults}{secondaryResults}{results} }
|
||||
// return {results => []};
|
||||
|
||||
#use Data::Dump qw(pp);
|
||||
#pp $related;
|
||||
|
||||
my @results;
|
||||
|
||||
foreach my $entry (@$related) {
|
||||
|
||||
my $info = $entry->{compactVideoRenderer} // next;
|
||||
my $title = $info->{title}{simpleText} // next;
|
||||
|
||||
my $viewCount = 0;
|
||||
|
||||
if (($info->{viewCountText}{simpleText} // '') =~ /^([\d,]+) views/) {
|
||||
$viewCount = ($1 =~ tr/,//dr);
|
||||
}
|
||||
elsif (($info->{viewCountText}{simpleText} // '') =~ /Recommended for you/i) {
|
||||
next; # filter out recommended videos from related videos
|
||||
}
|
||||
|
||||
my $lengthSeconds = 0;
|
||||
|
||||
if (($info->{lengthText}{simpleText} // '') =~ /([\d:]+)/) {
|
||||
my $time = $1;
|
||||
my @fields = split(/:/, $time);
|
||||
|
||||
my $seconds = pop(@fields) // 0;
|
||||
my $minutes = pop(@fields) // 0;
|
||||
my $hours = pop(@fields) // 0;
|
||||
|
||||
$lengthSeconds = 3600 * $hours + 60 * $minutes + $seconds;
|
||||
}
|
||||
|
||||
my $published = 0;
|
||||
if (exists $info->{publishedTimeText} and $info->{publishedTimeText}{simpleText} =~ /(\d+)\s+(\w+)\s+ago/) {
|
||||
|
||||
my $quantity = $1;
|
||||
my $period = $2;
|
||||
|
||||
$period =~ s/s\z//; # make it singural
|
||||
|
||||
my %table = (
|
||||
year => 31556952, # seconds in a year
|
||||
month => 2629743.83, # seconds in a month
|
||||
week => 604800, # seconds in a week
|
||||
day => 86400, # seconds in a day
|
||||
hour => 3600, # seconds in a hour
|
||||
minute => 60, # seconds in a minute
|
||||
second => 1, # seconds in a second
|
||||
);
|
||||
|
||||
if (exists $table{$period}) {
|
||||
$published = int(time - $quantity * $table{$period});
|
||||
}
|
||||
else {
|
||||
warn "BUG: cannot parse: <<$quantity $period>>";
|
||||
}
|
||||
}
|
||||
|
||||
push @results, {
|
||||
type => "video",
|
||||
title => $title,
|
||||
videoId => $info->{videoId},
|
||||
author => $info->{longBylineText}{runs}[0]{text},
|
||||
authorId => $info->{longBylineText}{runs}[0]{navigationEndpoint}{browseEndpoint}{browseId},
|
||||
|
||||
#authorUrl => $info->{longBylineText}{runs}[0]{navigationEndpoint}{browseEndpoint}{browseId},
|
||||
|
||||
description => $info->{accessibility}{accessibilityData}{label},
|
||||
descriptionHtml => undef,
|
||||
viewCount => $viewCount,
|
||||
published => $published,
|
||||
publishedText => $info->{publishedTimeText}{simpleText},
|
||||
lengthSeconds => $lengthSeconds,
|
||||
liveNow => ($lengthSeconds == 0), # maybe it's live if lengthSeconds == 0?
|
||||
paid => 0,
|
||||
premium => 0,
|
||||
|
||||
videoThumbnails => [
|
||||
map {
|
||||
scalar {
|
||||
quality => 'medium',
|
||||
url => $_->{url},
|
||||
width => $_->{width},
|
||||
height => $_->{height},
|
||||
}
|
||||
} @{$info->{thumbnail}{thumbnails}}
|
||||
],
|
||||
};
|
||||
}
|
||||
|
||||
return
|
||||
scalar {
|
||||
url => undef,
|
||||
results => \@results,
|
||||
};
|
||||
}
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Trizen, C<< <echo dHJpemVuQHByb3Rvbm1haWwuY29tCg== | base64 -d> >>
|
||||
|
||||
|
||||
=head1 SUPPORT
|
||||
|
||||
You can find documentation for this module with the perldoc command.
|
||||
|
||||
perldoc WWW::PipeViewer::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<http://dev.perl.org/licenses/> for more information.
|
||||
|
||||
=cut
|
||||
|
||||
1; # End of WWW::PipeViewer::Search
|
||||
@@ -0,0 +1,272 @@
|
||||
package WWW::PipeViewer::Subscriptions;
|
||||
|
||||
use utf8;
|
||||
use 5.014;
|
||||
use warnings;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
WWW::PipeViewer::Subscriptions - Subscriptions handler.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use WWW::PipeViewer;
|
||||
my $obj = WWW::PipeViewer->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<< <echo dHJpemVuQHByb3Rvbm1haWwuY29tCg== | base64 -d> >>
|
||||
|
||||
|
||||
=head1 SUPPORT
|
||||
|
||||
You can find documentation for this module with the perldoc command.
|
||||
|
||||
perldoc WWW::PipeViewer::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<http://dev.perl.org/licenses/> for more information.
|
||||
|
||||
=cut
|
||||
|
||||
1; # End of WWW::PipeViewer::Subscriptions
|
||||
@@ -0,0 +1,863 @@
|
||||
package WWW::PipeViewer::Utils;
|
||||
|
||||
use utf8;
|
||||
use 5.014;
|
||||
use warnings;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
WWW::PipeViewer::Utils - Various utils.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use WWW::PipeViewer::Utils;
|
||||
|
||||
my $yv_utils = WWW::PipeViewer::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<format_date()>
|
||||
|
||||
=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 =~ /\bopus\b/i ? q{opus}
|
||||
: $type =~ /\b3gpp?\b/i ? q{3gp}
|
||||
: $type =~ m{^video/(\w+)} ? $1
|
||||
: $type =~ m{^audio/(\w+)} ? $1
|
||||
: $type =~ /\bwebm\b/i ? q{webm}
|
||||
: 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{^
|
||||
(?<year>\d{4})
|
||||
-
|
||||
(?<month>\d{2})
|
||||
-
|
||||
(?<day>\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{^
|
||||
(?<year>\d{4})
|
||||
-
|
||||
(?<month>\d{2})
|
||||
-
|
||||
(?<day>\d{2})
|
||||
[a-zA-Z]
|
||||
(?<hour>\d{2})
|
||||
:
|
||||
(?<min>\d{2})
|
||||
:
|
||||
(?<sec>\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') {
|
||||
|
||||
foreach my $type(qw(comments videos playlists)) {
|
||||
if (exists $result->{results}{$type}) {
|
||||
return scalar @{$result->{results}{$type}} > 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;
|
||||
}
|
||||
|
||||
if (ref($result->{results}) eq 'HASH' and not keys %{$result->{results}}) {
|
||||
return 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->{descriptionHtml} // $info->{description} // '';
|
||||
|
||||
require URI::Escape;
|
||||
require HTML::Entities;
|
||||
|
||||
# Decode external links
|
||||
$desc =~ s{<a href="/redirect\?(.*?)".*?>.*?</a>}{
|
||||
my $url = $1;
|
||||
if ($url =~ /(?:^|;)q=([^&]+)/) {
|
||||
URI::Escape::uri_unescape($1);
|
||||
}
|
||||
else {
|
||||
$url;
|
||||
}
|
||||
}segi;
|
||||
|
||||
# Decode hashtags
|
||||
$desc =~ s{<a href="/results\?search_query=.*?".*?>(.*?)</a>}{$1}sgi;
|
||||
|
||||
# Decode internal links to videos / playlists
|
||||
$desc =~ s{<a href="/(watch\?.*?)".*?>(https://www\.youtube\.com)/watch\?.*?</a>}{
|
||||
my $url = $2;
|
||||
my $params = URI::Escape::uri_unescape($1);
|
||||
"$url/$params";
|
||||
}segi;
|
||||
|
||||
# Decode internal youtu.be links
|
||||
$desc =~ s{<a href="/watch\?v=(.*?)".*?>(https://youtu\.be)/.*?</a>}{
|
||||
my $url = $2;
|
||||
my $params = URI::Escape::uri_unescape($1);
|
||||
"$url/$params";
|
||||
}segi;
|
||||
|
||||
# Decode other internal links
|
||||
$desc =~ s{<a href="/(.*?)".*?>.*?</a>}{https://youtube.com/$1}sgi;
|
||||
|
||||
$desc =~ s{<br/?>}{\n}gi;
|
||||
$desc =~ s{<a href="(.*?)".*?>.*?</a>}{$1}sgi;
|
||||
$desc =~ s/<.*?>//gs;
|
||||
|
||||
$desc = HTML::Entities::decode_entities($desc);
|
||||
$desc =~ s/^\s+//;
|
||||
|
||||
if (not $desc =~ /\S/) {
|
||||
$desc = $info->{description} // '';
|
||||
}
|
||||
|
||||
($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;
|
||||
|
||||
my $url;
|
||||
|
||||
if (@wanted) {
|
||||
$url = $wanted[0]{url};
|
||||
}
|
||||
else {
|
||||
warn "[!] Couldn't find thumbnail of type <<$type>>...";
|
||||
$url = $thumbs[0]{url};
|
||||
}
|
||||
|
||||
# Clean URL of trackers and other junk
|
||||
$url =~ s/\.(?:jpg|png|webp)\K\?.*//;
|
||||
|
||||
return $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<< <echo dHJpemVuQHByb3Rvbm1haWwuY29tCg== | base64 -d> >>
|
||||
|
||||
|
||||
=head1 SUPPORT
|
||||
|
||||
You can find documentation for this module with the perldoc command.
|
||||
|
||||
perldoc WWW::PipeViewer::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<http://dev.perl.org/licenses/> for more information.
|
||||
|
||||
=cut
|
||||
|
||||
1; # End of WWW::PipeViewer::Utils
|
||||
@@ -0,0 +1,63 @@
|
||||
package WWW::PipeViewer::VideoCategories;
|
||||
|
||||
use utf8;
|
||||
use 5.014;
|
||||
use warnings;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
WWW::PipeViewer::VideoCategories - videoCategory resource handler.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use WWW::PipeViewer;
|
||||
my $obj = WWW::PipeViewer->new(%opts);
|
||||
my $cats = $obj->video_categories();
|
||||
|
||||
=head1 SUBROUTINES/METHODS
|
||||
|
||||
=cut
|
||||
|
||||
=head2 video_categories()
|
||||
|
||||
Return video categories for a specific region ID.
|
||||
|
||||
=cut
|
||||
|
||||
sub video_categories {
|
||||
my ($self) = @_;
|
||||
|
||||
return [{id => "music", title => "Music"},
|
||||
{id => "gaming", title => "Gaming"},
|
||||
{id => "news", title => "News"},
|
||||
{id => "movies", title => "Movies"},
|
||||
{id => "trending", title => "Trending"},
|
||||
{id => "popular", title => "Popular"},
|
||||
];
|
||||
}
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Trizen, C<< <echo dHJpemVuQHByb3Rvbm1haWwuY29tCg== | base64 -d> >>
|
||||
|
||||
|
||||
=head1 SUPPORT
|
||||
|
||||
You can find documentation for this module with the perldoc command.
|
||||
|
||||
perldoc WWW::PipeViewer::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<http://dev.perl.org/licenses/> for more information.
|
||||
|
||||
=cut
|
||||
|
||||
1; # End of WWW::PipeViewer::VideoCategories
|
||||
@@ -0,0 +1,243 @@
|
||||
package WWW::PipeViewer::Videos;
|
||||
|
||||
use utf8;
|
||||
use 5.014;
|
||||
use warnings;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
WWW::PipeViewer::Videos - videos handler.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use WWW::PipeViewer;
|
||||
my $obj = WWW::PipeViewer->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 trending_videos_from_category($category_id)
|
||||
|
||||
Get popular videos from a category ID.
|
||||
|
||||
=cut
|
||||
|
||||
sub trending_videos_from_category {
|
||||
my ($self, $category) = @_;
|
||||
|
||||
if (defined($category) and $category eq 'popular') {
|
||||
return $self->popular_videos;
|
||||
}
|
||||
|
||||
if (defined($category) and $category eq 'trending') {
|
||||
$category = undef;
|
||||
}
|
||||
|
||||
return $self->_get_results($self->_make_feed_url('trending', (defined($category) ? (type => $category) : ())));
|
||||
}
|
||||
|
||||
=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<part> are: I<id>, I<snippet>, I<contentDetails>
|
||||
I<player>, I<statistics>, I<status> and I<topicDetails>.
|
||||
|
||||
C<$part> string can contain more values, comma-separated.
|
||||
|
||||
Example:
|
||||
|
||||
part => 'snippet,contentDetails,statistics'
|
||||
|
||||
When C<$part> is C<undef>, it defaults to I<snippet>.
|
||||
|
||||
=cut
|
||||
|
||||
sub video_details {
|
||||
my ($self, $id, $fields) = @_;
|
||||
|
||||
$fields //= $self->basic_video_info_fields;
|
||||
my $info = $self->_get_results($self->_make_feed_url("videos/$id", fields => $fields))->{results};
|
||||
|
||||
if (ref($info) eq 'HASH' and exists $info->{videoId} and exists $info->{title}) {
|
||||
return $info;
|
||||
}
|
||||
|
||||
if ($self->get_debug) {
|
||||
say STDERR ":: Extracting video info using the fallback method...";
|
||||
}
|
||||
|
||||
# Fallback using the `get_video_info` URL
|
||||
my %video_info = $self->_get_video_info($id);
|
||||
my $video = $self->parse_json_string($video_info{player_response} // return);
|
||||
|
||||
if (exists $video->{videoDetails}) {
|
||||
$video = $video->{videoDetails};
|
||||
}
|
||||
else {
|
||||
return;
|
||||
}
|
||||
|
||||
my %details = (
|
||||
title => $video->{title},
|
||||
videoId => $video->{videoId},
|
||||
|
||||
videoThumbnails => [
|
||||
map {
|
||||
scalar {
|
||||
quality => 'medium',
|
||||
url => $_->{url},
|
||||
width => $_->{width},
|
||||
height => $_->{height},
|
||||
}
|
||||
} @{$video->{thumbnail}{thumbnails}}
|
||||
],
|
||||
|
||||
liveNow => $video->{isLiveContent},
|
||||
description => $video->{shortDescription},
|
||||
lengthSeconds => $video->{lengthSeconds},
|
||||
|
||||
keywords => $video->{keywords},
|
||||
viewCount => $video->{viewCount},
|
||||
|
||||
author => $video->{author},
|
||||
authorId => $video->{channelId},
|
||||
rating => $video->{averageRating},
|
||||
);
|
||||
|
||||
return \%details;
|
||||
}
|
||||
|
||||
=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<< <echo dHJpemVuQHByb3Rvbm1haWwuY29tCg== | base64 -d> >>
|
||||
|
||||
|
||||
=head1 SUPPORT
|
||||
|
||||
You can find documentation for this module with the perldoc command.
|
||||
|
||||
perldoc WWW::PipeViewer::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<http://dev.perl.org/licenses/> for more information.
|
||||
|
||||
=cut
|
||||
|
||||
1; # End of WWW::PipeViewer::Videos
|
||||
@@ -0,0 +1,10 @@
|
||||
[Desktop Entry]
|
||||
Name=GTK Pipe Viewer
|
||||
Version=1.0
|
||||
Comment=Search and play YouTube videos.
|
||||
Exec=gtk-pipe-viewer
|
||||
Icon=gtk-pipe-viewer
|
||||
StartupNotify=false
|
||||
Terminal=false
|
||||
Type=Application
|
||||
Categories=AudioVideo;GTK;
|
||||
Diferenças do arquivo suprimidas por serem muito extensas
Carregar Diff
Arquivo binário não exibido.
|
Depois Largura: | Altura: | Tamanho: 2.3 KiB |
Arquivo binário não exibido.
|
Depois Largura: | Altura: | Tamanho: 901 B |
Arquivo binário não exibido.
|
Depois Largura: | Altura: | Tamanho: 2.1 KiB |
Arquivo binário não exibido.
|
Depois Largura: | Altura: | Tamanho: 119 KiB |
Arquivo binário não exibido.
|
Depois Largura: | Altura: | Tamanho: 1.5 KiB |
Arquivo binário não exibido.
|
Depois Largura: | Altura: | Tamanho: 4.0 KiB |
@@ -0,0 +1,10 @@
|
||||
#!perl -T
|
||||
|
||||
use 5.014;
|
||||
use Test::More tests => 1;
|
||||
|
||||
BEGIN {
|
||||
use_ok( 'WWW::PipeViewer' ) || print "Bail out!\n";
|
||||
}
|
||||
|
||||
diag( "Testing WWW::PipeViewer $WWW::PipeViewer::VERSION, Perl $], $^X" );
|
||||
@@ -0,0 +1,20 @@
|
||||
#!perl
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings FATAL => 'all';
|
||||
use Test::More;
|
||||
|
||||
BEGIN {
|
||||
plan( skip_all => 'these tests are for release candidate testing' )
|
||||
unless $ENV{RELEASE_TESTING};
|
||||
}
|
||||
|
||||
eval {
|
||||
require Test::Kwalitee;
|
||||
Test::Kwalitee->import('kwalitee_ok');
|
||||
kwalitee_ok();
|
||||
done_testing();
|
||||
};
|
||||
|
||||
plan( skip_all => 'Test::Kwalitee not installed; skipping' ) if $@;
|
||||
+12
@@ -0,0 +1,12 @@
|
||||
#!perl -T
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More;
|
||||
|
||||
# Ensure a recent version of Test::Pod
|
||||
my $min_tp = 1.22;
|
||||
eval "use Test::Pod $min_tp";
|
||||
plan skip_all => "Test::Pod $min_tp required for testing POD" if $@;
|
||||
|
||||
all_pod_files_ok();
|
||||
Referência em uma Nova Issue
Bloquear um usuário