├── .github └── FUNDING.yml ├── .gitignore ├── Build.PL ├── Changes ├── LICENSE ├── MANIFEST ├── MANIFEST.SKIP ├── Makefile.PL ├── README.md ├── bin ├── gtk-lbry-viewer └── lbry-viewer ├── lib └── WWW │ ├── LbryViewer.pm │ └── LbryViewer │ ├── Channels.pm │ ├── CommentThreads.pm │ ├── GetCaption.pm │ ├── Itags.pm │ ├── Librarian.pm │ ├── ParseJSON.pm │ ├── ParseXML.pm │ ├── PlaylistItems.pm │ ├── Playlists.pm │ ├── RegularExpressions.pm │ ├── Search.pm │ ├── Utils.pm │ ├── VideoCategories.pm │ └── Videos.pm ├── share ├── gtk-lbry-viewer.desktop ├── gtk-lbry-viewer.glade └── icons │ ├── default_thumb.jpg │ ├── feed.png │ ├── feed_gray.png │ ├── gtk-lbry-viewer.png │ ├── left_arrow.png │ ├── right_arrow.png │ ├── spinner.gif │ └── user.png ├── t ├── 00-load.t ├── kwalitee.t └── pod.t └── utils ├── auto_perltidy.sh └── bak_cleaner.sh /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | # These are supported funding model platforms 2 | 3 | github: # Replace with up to 4 GitHub Sponsors-enabled usernames e.g., [user1, user2] 4 | patreon: # Replace with a single Patreon username 5 | open_collective: # Replace with a single Open Collective username 6 | ko_fi: # Replace with a single Ko-fi username 7 | tidelift: # Replace with a single Tidelift platform-name/package-name e.g., npm/babel 8 | community_bridge: # Replace with a single Community Bridge project-name e.g., cloud-foundry 9 | liberapay: # Replace with a single Liberapay username 10 | issuehunt: # Replace with a single IssueHunt username 11 | otechie: # Replace with a single Otechie username 12 | custom: https://www.paypal.me/trizen 13 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | !Build/ 2 | .last_cover_stats 3 | /META.yml 4 | /META.json 5 | /MYMETA.* 6 | *.o 7 | *.pm.tdy 8 | *.bs 9 | 10 | # Devel::Cover 11 | cover_db/ 12 | 13 | # Devel::NYTProf 14 | nytprof.out 15 | 16 | # Dizt::Zilla 17 | /.build/ 18 | 19 | # Module::Build 20 | _build/ 21 | Build 22 | Build.bat 23 | 24 | # Module::Install 25 | inc/ 26 | 27 | # ExtUtils::MakeMaker 28 | /blib/ 29 | /_eumm/ 30 | /*.gz 31 | /Makefile 32 | /Makefile.old 33 | /MANIFEST.bak 34 | /pm_to_blib 35 | /*.zip 36 | -------------------------------------------------------------------------------- /Build.PL: -------------------------------------------------------------------------------- 1 | 2 | use utf8; 3 | use 5.010; 4 | use strict; 5 | use warnings; 6 | use Module::Build; 7 | 8 | my $gtk = grep { /^--?gtk3?\z/ } @ARGV; 9 | 10 | my $builder = Module::Build->new( 11 | 12 | module_name => 'WWW::LbryViewer', 13 | license => 'perl', 14 | dist_author => q{Trizen }, 15 | dist_version_from => 'lib/WWW/LbryViewer.pm', 16 | release_status => 'stable', 17 | 18 | build_requires => { 19 | 'Test::More' => 0, 20 | }, 21 | 22 | extra_manify_args => {utf8 => 1}, 23 | 24 | configure_requires => { 25 | 'Module::Build' => 0, 26 | }, 27 | 28 | get_options => { 29 | 'gtk3' => { 30 | type => '!', 31 | store => \$gtk, 32 | }, 33 | }, 34 | 35 | requires => { 36 | 'perl' => 5.016, 37 | 'Data::Dump' => 0, 38 | 'File::Spec' => 0, 39 | 'File::Spec::Functions' => 0, 40 | 'File::Path' => 0, 41 | 'Getopt::Long' => 0, 42 | 'HTTP::Request' => 0, 43 | 'JSON' => 0, 44 | 'Encode' => 0, 45 | 'Memoize' => 0, 46 | 'MIME::Base64' => 0, 47 | 'List::Util' => 0, 48 | 'LWP::UserAgent' => 0, 49 | 'LWP::Protocol::https' => 0, 50 | 'Term::ANSIColor' => 0, 51 | 'Term::ReadLine' => 0, 52 | 'Text::ParseWords' => 0, 53 | 'Text::Wrap' => 0, 54 | 'URI::Escape' => 0, 55 | 'HTML::Tree' => 0, 56 | 'HTML::Entities' => 0, 57 | 58 | $gtk 59 | ? ( 60 | 'Gtk3' => 0, 61 | 'File::ShareDir' => 0, 62 | 'Storable' => 0, 63 | 'Digest::MD5' => 0, 64 | ) 65 | : (), 66 | }, 67 | 68 | recommends => { 69 | 'LWP::UserAgent::Cached' => 0, # local cache support 70 | 'Term::ReadLine::Gnu' => 0, # for better STDIN support (+history) 71 | 'JSON::XS' => 0, # faster JSON to HASH conversion 72 | 'Unicode::GCString' => 0, # fixed-width formatting 73 | 'Parallel::ForkManager' => '2.02', # for the `*_parallel` options 74 | 'Text::Unidecode' => 0, # for the `fat32safe` option 75 | }, 76 | 77 | add_to_cleanup => ['WWW-LbryViewer-*'], 78 | create_makefile_pl => 'traditional', 79 | ); 80 | 81 | $builder->script_files(['bin/lbry-viewer', ($gtk ? ('bin/gtk-lbry-viewer') : ()),]); 82 | 83 | $builder->share_dir('share') if $gtk; 84 | $builder->create_build_script(); 85 | -------------------------------------------------------------------------------- /Changes: -------------------------------------------------------------------------------- 1 | # Revision history for lbry-viewer. 2 | 3 | # For all changes, check out the release notes at: 4 | # https://github.com/trizen/lbry-viewer/releases 5 | 6 | [CHANGELOG] 7 | 8 | Version 0.1.0 9 | 10 | - GUI: added "Backward" and "Forward" buttons for navigating the history. 11 | - Fixed the downloading of videos with very long titles. 12 | - Other minor fixes. 13 | 14 | Version 0.0.9 15 | 16 | - CLI: added basic support for Android, for playing videos with the VLC player. 17 | - Updated the list of fallback Librarian instances. 18 | - Fixed the list of fallback Librarian instances, when the `instances.json` file cannot be retrieved. 19 | 20 | Version 0.0.8 21 | 22 | - CLI: allow the `--novideo` option to be negated. 23 | - CLI: added the `get_subscriptions_in_parallel` config-option (disabled by default) 24 | - GUI: added the `get_streaming_urls_in_parallel` config-option (disabled by default) 25 | - GUI: added the `get_subscriptions_in_parallel` config-option (disabled by default) 26 | - GUI: added the `get_thumbnails_in_parallel` config-option (disabled by default) 27 | - GUI: added the right-click "Copy LBRY URL" menu entry. 28 | - GUI: no longer remove the "NEXT PAGE" entry after clicking it. 29 | - GUI: added the `DEL` keybind in the "Saved channels" window to remove the selected channel. 30 | - GUI: display featured videos when no search keywords are specified. 31 | - GUI: better performance for GIF thumbnails and very large thumbnails. 32 | - Fixed the NSFW flag for results past the first page. 33 | - Sort the videos from a channel by published date. 34 | 35 | Version 0.0.7 36 | 37 | - GUI: keep aspect ratio of thumbnails. 38 | - GUI: fixed the loading of thumbnails on older versions of `gtk3`. 39 | - Fixed an internal cache bug with `nsfw` disabled, then enabled (or viceversa). 40 | 41 | Version 0.0.6 42 | 43 | - Added support for categories. 44 | - Added support for related videos. 45 | - Added basic GET cache in `lwp_get()`. 46 | - Added support for listing channel uploads from channel URL. 47 | - Support for extracting video information from the Librarian instances. 48 | - Remember a working Librarian instance and reuse it for 1 hour. 49 | 50 | Version 0.0.5 51 | 52 | - Added support for `api_host => "auto"` to use a random Librarian instance. 53 | - Support for UTF-8 characters inside the config files. 54 | - Fixed the support for next pages. 55 | - GUI: tweak the interface to be less cramped. 56 | 57 | Version 0.0.4 58 | 59 | - Recognize several more video formats. 60 | - Added support for searching for NSFW videos. 61 | - Several bug-fixes and improvements. 62 | 63 | Version 0.0.3 64 | 65 | - GUI: added support for highlighting watched videos. 66 | - GUI: added support for caching thumbnails. 67 | - Added support for downloading videos at the specified resolution. 68 | 69 | Version 0.0.2 70 | 71 | - Added support for changing resolution. 72 | - Added support for changing the Librarian instance. 73 | - Better parsing of LBRY/Odysee URLs. 74 | - Several bug-fixes and improvements. 75 | 76 | Version 0.0.1 77 | 78 | - First release. 79 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The Artistic License 2.0 2 | 3 | Copyright (c) 2000-2006, The Perl Foundation. 4 | 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | Preamble 9 | 10 | This license establishes the terms under which a given free software 11 | Package may be copied, modified, distributed, and/or redistributed. 12 | The intent is that the Copyright Holder maintains some artistic 13 | control over the development of that Package while still keeping the 14 | Package available as open source and free software. 15 | 16 | You are always permitted to make arrangements wholly outside of this 17 | license directly with the Copyright Holder of a given Package. If the 18 | terms of this license do not permit the full use that you propose to 19 | make of the Package, you should contact the Copyright Holder and seek 20 | a different licensing arrangement. 21 | 22 | Definitions 23 | 24 | "Copyright Holder" means the individual(s) or organization(s) 25 | named in the copyright notice for the entire Package. 26 | 27 | "Contributor" means any party that has contributed code or other 28 | material to the Package, in accordance with the Copyright Holder's 29 | procedures. 30 | 31 | "You" and "your" means any person who would like to copy, 32 | distribute, or modify the Package. 33 | 34 | "Package" means the collection of files distributed by the 35 | Copyright Holder, and derivatives of that collection and/or of 36 | those files. A given Package may consist of either the Standard 37 | Version, or a Modified Version. 38 | 39 | "Distribute" means providing a copy of the Package or making it 40 | accessible to anyone else, or in the case of a company or 41 | organization, to others outside of your company or organization. 42 | 43 | "Distributor Fee" means any fee that you charge for Distributing 44 | this Package or providing support for this Package to another 45 | party. It does not mean licensing fees. 46 | 47 | "Standard Version" refers to the Package if it has not been 48 | modified, or has been modified only in ways explicitly requested 49 | by the Copyright Holder. 50 | 51 | "Modified Version" means the Package, if it has been changed, and 52 | such changes were not explicitly requested by the Copyright 53 | Holder. 54 | 55 | "Original License" means this Artistic License as Distributed with 56 | the Standard Version of the Package, in its current version or as 57 | it may be modified by The Perl Foundation in the future. 58 | 59 | "Source" form means the source code, documentation source, and 60 | configuration files for the Package. 61 | 62 | "Compiled" form means the compiled bytecode, object code, binary, 63 | or any other form resulting from mechanical transformation or 64 | translation of the Source form. 65 | 66 | 67 | Permission for Use and Modification Without Distribution 68 | 69 | (1) You are permitted to use the Standard Version and create and use 70 | Modified Versions for any purpose without restriction, provided that 71 | you do not Distribute the Modified Version. 72 | 73 | 74 | Permissions for Redistribution of the Standard Version 75 | 76 | (2) You may Distribute verbatim copies of the Source form of the 77 | Standard Version of this Package in any medium without restriction, 78 | either gratis or for a Distributor Fee, provided that you duplicate 79 | all of the original copyright notices and associated disclaimers. At 80 | your discretion, such verbatim copies may or may not include a 81 | Compiled form of the Package. 82 | 83 | (3) You may apply any bug fixes, portability changes, and other 84 | modifications made available from the Copyright Holder. The resulting 85 | Package will still be considered the Standard Version, and as such 86 | will be subject to the Original License. 87 | 88 | 89 | Distribution of Modified Versions of the Package as Source 90 | 91 | (4) You may Distribute your Modified Version as Source (either gratis 92 | or for a Distributor Fee, and with or without a Compiled form of the 93 | Modified Version) provided that you clearly document how it differs 94 | from the Standard Version, including, but not limited to, documenting 95 | any non-standard features, executables, or modules, and provided that 96 | you do at least ONE of the following: 97 | 98 | (a) make the Modified Version available to the Copyright Holder 99 | of the Standard Version, under the Original License, so that the 100 | Copyright Holder may include your modifications in the Standard 101 | Version. 102 | 103 | (b) ensure that installation of your Modified Version does not 104 | prevent the user installing or running the Standard Version. In 105 | addition, the Modified Version must bear a name that is different 106 | from the name of the Standard Version. 107 | 108 | (c) allow anyone who receives a copy of the Modified Version to 109 | make the Source form of the Modified Version available to others 110 | under 111 | 112 | (i) the Original License or 113 | 114 | (ii) a license that permits the licensee to freely copy, 115 | modify and redistribute the Modified Version using the same 116 | licensing terms that apply to the copy that the licensee 117 | received, and requires that the Source form of the Modified 118 | Version, and of any works derived from it, be made freely 119 | available in that license fees are prohibited but Distributor 120 | Fees are allowed. 121 | 122 | 123 | Distribution of Compiled Forms of the Standard Version 124 | or Modified Versions without the Source 125 | 126 | (5) You may Distribute Compiled forms of the Standard Version without 127 | the Source, provided that you include complete instructions on how to 128 | get the Source of the Standard Version. Such instructions must be 129 | valid at the time of your distribution. If these instructions, at any 130 | time while you are carrying out such distribution, become invalid, you 131 | must provide new instructions on demand or cease further distribution. 132 | If you provide valid instructions or cease distribution within thirty 133 | days after you become aware that the instructions are invalid, then 134 | you do not forfeit any of your rights under this license. 135 | 136 | (6) You may Distribute a Modified Version in Compiled form without 137 | the Source, provided that you comply with Section 4 with respect to 138 | the Source of the Modified Version. 139 | 140 | 141 | Aggregating or Linking the Package 142 | 143 | (7) You may aggregate the Package (either the Standard Version or 144 | Modified Version) with other packages and Distribute the resulting 145 | aggregation provided that you do not charge a licensing fee for the 146 | Package. Distributor Fees are permitted, and licensing fees for other 147 | components in the aggregation are permitted. The terms of this license 148 | apply to the use and Distribution of the Standard or Modified Versions 149 | as included in the aggregation. 150 | 151 | (8) You are permitted to link Modified and Standard Versions with 152 | other works, to embed the Package in a larger work of your own, or to 153 | build stand-alone binary or bytecode versions of applications that 154 | include the Package, and Distribute the result without restriction, 155 | provided the result does not expose a direct interface to the Package. 156 | 157 | 158 | Items That are Not Considered Part of a Modified Version 159 | 160 | (9) Works (including, but not limited to, modules and scripts) that 161 | merely extend or make use of the Package, do not, by themselves, cause 162 | the Package to be a Modified Version. In addition, such works are not 163 | considered parts of the Package itself, and are not subject to the 164 | terms of this license. 165 | 166 | 167 | General Provisions 168 | 169 | (10) Any use, modification, and distribution of the Standard or 170 | Modified Versions is governed by this Artistic License. By using, 171 | modifying or distributing the Package, you accept this license. Do not 172 | use, modify, or distribute the Package, if you do not accept this 173 | license. 174 | 175 | (11) If your Modified Version has been derived from a Modified 176 | Version made by someone other than you, you are nevertheless required 177 | to ensure that your Modified Version complies with the requirements of 178 | this license. 179 | 180 | (12) This license does not grant you the right to use any trademark, 181 | service mark, tradename, or logo of the Copyright Holder. 182 | 183 | (13) This license includes the non-exclusive, worldwide, 184 | free-of-charge patent license to make, have made, use, offer to sell, 185 | sell, import and otherwise transfer the Package with respect to any 186 | patent claims licensable by the Copyright Holder that are necessarily 187 | infringed by the Package. If you institute patent litigation 188 | (including a cross-claim or counterclaim) against any party alleging 189 | that the Package constitutes direct or contributory patent 190 | infringement, then this Artistic License to you shall terminate on the 191 | date that such litigation is filed. 192 | 193 | (14) Disclaimer of Warranty: 194 | THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS 195 | IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED 196 | WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR 197 | NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL 198 | LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL 199 | BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL 200 | DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF 201 | ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 202 | -------------------------------------------------------------------------------- /MANIFEST: -------------------------------------------------------------------------------- 1 | bin/gtk-lbry-viewer 2 | bin/lbry-viewer 3 | Build.PL 4 | Changes 5 | lib/WWW/LbryViewer.pm 6 | lib/WWW/LbryViewer/Channels.pm 7 | lib/WWW/LbryViewer/CommentThreads.pm 8 | lib/WWW/LbryViewer/GetCaption.pm 9 | lib/WWW/LbryViewer/Itags.pm 10 | lib/WWW/LbryViewer/Librarian.pm 11 | lib/WWW/LbryViewer/ParseJSON.pm 12 | lib/WWW/LbryViewer/ParseXML.pm 13 | lib/WWW/LbryViewer/PlaylistItems.pm 14 | lib/WWW/LbryViewer/Playlists.pm 15 | lib/WWW/LbryViewer/RegularExpressions.pm 16 | lib/WWW/LbryViewer/Search.pm 17 | lib/WWW/LbryViewer/Utils.pm 18 | lib/WWW/LbryViewer/VideoCategories.pm 19 | lib/WWW/LbryViewer/Videos.pm 20 | LICENSE 21 | Makefile.PL 22 | MANIFEST This list of files 23 | META.json 24 | META.yml 25 | README.md 26 | share/gtk-lbry-viewer.desktop 27 | share/gtk-lbry-viewer.glade 28 | share/icons/default_thumb.jpg 29 | share/icons/feed.png 30 | share/icons/feed_gray.png 31 | share/icons/gtk-lbry-viewer.png 32 | share/icons/left_arrow.png 33 | share/icons/right_arrow.png 34 | share/icons/spinner.gif 35 | share/icons/user.png 36 | t/00-load.t 37 | t/kwalitee.t 38 | t/pod.t 39 | utils/auto_perltidy.sh 40 | utils/bak_cleaner.sh 41 | -------------------------------------------------------------------------------- /MANIFEST.SKIP: -------------------------------------------------------------------------------- 1 | 2 | #!start included /usr/share/perl5/core_perl/ExtUtils/MANIFEST.SKIP 3 | # Avoid version control files. 4 | \bRCS\b 5 | \bCVS\b 6 | \bSCCS\b 7 | ,v$ 8 | \B\.svn\b 9 | \B\.git\b 10 | \B\.gitignore\b 11 | \b_darcs\b 12 | \B\.cvsignore$ 13 | 14 | # Avoid VMS specific MakeMaker generated files 15 | \bDescrip.MMS$ 16 | \bDESCRIP.MMS$ 17 | \bdescrip.mms$ 18 | 19 | # Avoid Makemaker generated and utility files. 20 | \bMANIFEST\.bak 21 | \bMakefile$ 22 | \bblib/ 23 | \bMakeMaker-\d 24 | \bpm_to_blib\.ts$ 25 | \bpm_to_blib$ 26 | \bblibdirs\.ts$ # 6.18 through 6.25 generated this 27 | 28 | # Avoid Module::Build generated and utility files. 29 | \bBuild$ 30 | \b_build/ 31 | \bBuild.bat$ 32 | \bBuild.COM$ 33 | \bBUILD.COM$ 34 | \bbuild.com$ 35 | 36 | # Other files 37 | .github/FUNDING.yml 38 | bin/inv.json 39 | bin/yv.json 40 | 41 | # Avoid temp and backup files. 42 | ~$ 43 | \.old$ 44 | \#$ 45 | \b\.# 46 | \.bak$ 47 | \.tmp$ 48 | \.# 49 | \.rej$ 50 | 51 | # Avoid OS-specific files/dirs 52 | # Mac OSX metadata 53 | \B\.DS_Store 54 | # Mac OSX SMB mount metadata files 55 | \B\._ 56 | 57 | # Avoid Devel::Cover and Devel::CoverX::Covered files. 58 | \bcover_db\b 59 | \bcovered\b 60 | 61 | # Avoid MYMETA files 62 | ^MYMETA\. 63 | #!end included /usr/share/perl5/core_perl/ExtUtils/MANIFEST.SKIP 64 | 65 | # Avoid configuration metadata file 66 | ^MYMETA\. 67 | 68 | # Avoid Module::Build generated and utility files. 69 | \bBuild$ 70 | \bBuild.bat$ 71 | \b_build 72 | \bBuild.COM$ 73 | \bBUILD.COM$ 74 | \bbuild.com$ 75 | ^MANIFEST\.SKIP 76 | 77 | # Avoid archives of this distribution 78 | \bWWW-LbryViewer-[\d\.\_]+ 79 | WWW-LbryViewer-* 80 | -------------------------------------------------------------------------------- /Makefile.PL: -------------------------------------------------------------------------------- 1 | # Note: this file was auto-generated by Module::Build::Compat version 0.4234 2 | require 5.016; 3 | use ExtUtils::MakeMaker; 4 | WriteMakefile 5 | ( 6 | 'NAME' => 'WWW::LbryViewer', 7 | 'VERSION_FROM' => 'lib/WWW/LbryViewer.pm', 8 | 'PREREQ_PM' => { 9 | 'Data::Dump' => 0, 10 | 'Encode' => 0, 11 | 'File::Path' => 0, 12 | 'File::Spec' => 0, 13 | 'File::Spec::Functions' => 0, 14 | 'Getopt::Long' => 0, 15 | 'HTML::Entities' => 0, 16 | 'HTML::Tree' => 0, 17 | 'HTTP::Request' => 0, 18 | 'JSON' => 0, 19 | 'LWP::Protocol::https' => 0, 20 | 'LWP::UserAgent' => 0, 21 | 'List::Util' => 0, 22 | 'MIME::Base64' => 0, 23 | 'Memoize' => 0, 24 | 'Term::ANSIColor' => 0, 25 | 'Term::ReadLine' => 0, 26 | 'Test::More' => 0, 27 | 'Text::ParseWords' => 0, 28 | 'Text::Wrap' => 0, 29 | 'URI::Escape' => 0 30 | }, 31 | 'INSTALLDIRS' => 'site', 32 | 'EXE_FILES' => [ 33 | 'bin/lbry-viewer' 34 | ], 35 | 'PL_FILES' => {} 36 | ) 37 | ; 38 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ## lbry-viewer 2 | 3 | A lightweight application (fork of [pipe-viewer](https://github.com/trizen/pipe-viewer)) for searching and playing videos from [LBRY](https://lbry.com/), using the [Librarian](https://codeberg.org/librarian/librarian) frontend. 4 | 5 | ### STATUS 6 | 7 | The application is in the early stages of development. Some functionality is not implemented yet. 8 | 9 | ### lbry-viewer 10 | 11 | * command-line interface to LBRY. 12 | 13 | ![lbry-viewer](https://user-images.githubusercontent.com/614513/170727055-edaaf1a2-b23a-4986-b293-62939378e1c8.png) 14 | 15 | ### gtk-lbry-viewer 16 | 17 | * GTK+ interface to LBRY. 18 | 19 | ![gtk-lbry-viewer](https://user-images.githubusercontent.com/614513/170727069-9273ef40-d407-40a6-8183-c26e73a7807f.png) 20 | 21 | 22 | ### AVAILABILITY 23 | 24 | * Arch Linux (AUR): https://aur.archlinux.org/packages/lbry-viewer-git/ 25 | * Debian/Ubuntu (MPR): Latest stable version https://mpr.makedeb.org/packages/lbry-viewer .Latest dev version https://mpr.makedeb.org/packages/lbry-viewer-git . MPR is like the AUR, but for Debian/Ubuntu. You need to install makedeb first https://www.makedeb.org/ . 26 | 27 | ### TRY 28 | 29 | For trying the latest commit of `lbry-viewer`, without installing it, execute the following commands: 30 | 31 | ```console 32 | cd /tmp 33 | wget https://github.com/trizen/lbry-viewer/archive/main.zip -O lbry-viewer-main.zip 34 | unzip -n lbry-viewer-main.zip 35 | cd lbry-viewer-main/bin 36 | ./lbry-viewer 37 | ``` 38 | 39 | ### INSTALLATION 40 | 41 | To install `lbry-viewer`, run: 42 | 43 | ```console 44 | perl Build.PL 45 | sudo ./Build installdeps 46 | sudo ./Build install 47 | ``` 48 | 49 | To install `gtk-lbry-viewer` along with `lbry-viewer`, run: 50 | 51 | ```console 52 | perl Build.PL --gtk 53 | sudo ./Build installdeps 54 | sudo ./Build install 55 | ``` 56 | 57 | ### DEPENDENCIES 58 | 59 | #### For lbry-viewer: 60 | 61 | * [libwww-perl](https://metacpan.org/release/libwww-perl) 62 | * [LWP::Protocol::https](https://metacpan.org/release/LWP-Protocol-https) 63 | * [Data::Dump](https://metacpan.org/release/Data-Dump) 64 | * [JSON](https://metacpan.org/release/JSON) 65 | * [HTML::Tree](https://metacpan.org/release/HTML-Tree) 66 | 67 | #### For gtk-lbry-viewer: 68 | 69 | * [Gtk3](https://metacpan.org/release/Gtk3) 70 | * [File::ShareDir](https://metacpan.org/release/File-ShareDir) 71 | * [webp-pixbuf-loader](https://github.com/aruiz/webp-pixbuf-loader) 72 | * \+ the dependencies required by lbry-viewer. 73 | 74 | #### Build dependencies: 75 | 76 | * [Module::Build](https://metacpan.org/pod/Module::Build) 77 | 78 | #### Optional dependencies: 79 | 80 | * Local cache support: [LWP::UserAgent::Cached](https://metacpan.org/release/LWP-UserAgent-Cached) 81 | * Better STDIN support (+history): [Term::ReadLine::Gnu](https://metacpan.org/release/Term-ReadLine-Gnu) 82 | * Faster JSON deserialization: [JSON::XS](https://metacpan.org/release/JSON-XS) 83 | * Fixed-width formatting: [Unicode::LineBreak](https://metacpan.org/release/Unicode-LineBreak) or [Text::CharWidth](https://metacpan.org/release/Text-CharWidth) 84 | * For the `*_parallel` config-options: [Parallel::ForkManager](https://metacpan.org/release/Parallel-ForkManager) 85 | * Fallback extraction method: [yt-dlp](https://github.com/yt-dlp/yt-dlp) or [youtube-dl](https://github.com/ytdl-org/youtube-dl). 86 | 87 | ### PACKAGING 88 | 89 | To package this application, run the following commands: 90 | 91 | ```console 92 | perl Build.PL --destdir "/my/package/path" --installdirs vendor [--gtk] 93 | ./Build test 94 | ./Build install --install_path script=/usr/bin 95 | ``` 96 | 97 | ### LIBRARIAN INSTANCES 98 | 99 | To use a specific Librarian instance, like [lbry.vern.cc](https://lbry.vern.cc/), pass the `--api=HOST` option: 100 | 101 | ```console 102 | lbry-viewer --api=lbry.vern.cc 103 | ``` 104 | 105 | To make the change permanent, set in the configuration file: 106 | 107 | ```perl 108 | api_host => "lbry.vern.cc", 109 | ``` 110 | 111 | When `api_host` is set to `"auto"`, `lbry-viewer` picks a random instance from [codeberg.org/librarian/librarian](https://codeberg.org/librarian/librarian#clearnet). 112 | 113 | ### SUPPORT AND DOCUMENTATION 114 | 115 | After installing, you can find documentation with the following commands: 116 | 117 | man lbry-viewer 118 | perldoc WWW::LbryViewer 119 | 120 | ### LICENSE AND COPYRIGHT 121 | 122 | Copyright (C) 2012-2024 Trizen 123 | 124 | This program is free software; you can redistribute it and/or modify it 125 | under the terms of either: the GNU General Public License as published 126 | by the Free Software Foundation; or the Artistic License. 127 | 128 | See https://dev.perl.org/licenses/ for more information. 129 | -------------------------------------------------------------------------------- /lib/WWW/LbryViewer.pm: -------------------------------------------------------------------------------- 1 | package WWW::LbryViewer; 2 | 3 | use utf8; 4 | use 5.016; 5 | use warnings; 6 | 7 | use Memoize; 8 | use Memoize::Expire; 9 | 10 | tie my %youtubei_cache => 'Memoize::Expire', 11 | LIFETIME => 600, # in seconds 12 | NUM_USES => 10; 13 | 14 | memoize('_ytdl_is_available'); 15 | memoize('_info_from_ytdl'); 16 | memoize('_extract_from_ytdl'); 17 | 18 | use parent qw( 19 | WWW::LbryViewer::Librarian 20 | WWW::LbryViewer::Search 21 | WWW::LbryViewer::Videos 22 | WWW::LbryViewer::Channels 23 | WWW::LbryViewer::Playlists 24 | WWW::LbryViewer::ParseJSON 25 | WWW::LbryViewer::PlaylistItems 26 | WWW::LbryViewer::CommentThreads 27 | WWW::LbryViewer::VideoCategories 28 | ); 29 | 30 | use WWW::LbryViewer::Utils; 31 | 32 | =head1 NAME 33 | 34 | WWW::LbryViewer - A simple interface to YouTube. 35 | 36 | =cut 37 | 38 | our $VERSION = '0.1.0'; 39 | 40 | =head1 SYNOPSIS 41 | 42 | use WWW::LbryViewer; 43 | 44 | my $yv_obj = WWW::LbryViewer->new(); 45 | ... 46 | 47 | =head1 SUBROUTINES/METHODS 48 | 49 | =cut 50 | 51 | my %valid_options = ( 52 | 53 | # Main options 54 | v => {valid => q[], default => 3}, 55 | page => {valid => qr/^(?!0+\z)\d+\z/, default => 1}, 56 | http_proxy => {valid => qr/./, default => undef}, 57 | maxResults => {valid => [1 .. 50], default => 10}, 58 | order => {valid => [qw(relevance rating upload_date view_count)], default => undef}, 59 | date => {valid => [qw(hour today week month year)], default => undef}, 60 | 61 | channelId => {valid => qr/^[-\w]{2,}\z/, default => undef}, 62 | 63 | # Video only options 64 | videoCaption => {valid => [qw(1 true)], default => undef}, 65 | videoDefinition => {valid => [qw(high standard)], default => undef}, 66 | videoDimension => {valid => [qw(2d 3d)], default => undef}, 67 | videoDuration => {valid => [qw(short long)], default => undef}, 68 | videoLicense => {valid => [qw(creative_commons)], default => undef}, 69 | region => {valid => qr/^[A-Z]{2}\z/i, default => undef}, 70 | 71 | comments_order => {valid => [qw(top new)], default => 'top'}, 72 | subscriptions_order => {valid => [qw(alphabetical relevance unread)], default => undef}, 73 | 74 | # Misc 75 | debug => {valid => [0 .. 3], default => 0}, 76 | timeout => {valid => qr/^\d+\z/, default => 10}, 77 | config_dir => {valid => qr/^./, default => q{.}}, 78 | cache_dir => {valid => qr/^./, default => q{.}}, 79 | cookie_file => {valid => qr/^./, default => undef}, 80 | 81 | # Support for yt-dlp / youtube-dl 82 | ytdl => {valid => [1, 0], default => 1}, 83 | ytdl_cmd => {valid => qr/\w/, default => "yt-dlp"}, 84 | 85 | # yt-dlp comment options 86 | ytdlp_comments => {valid => [1, 0], default => 0}, 87 | ytdlp_max_comments => {valid => qr/^\d+\z/, default => 50}, 88 | ytdlp_max_replies => {valid => qr/^(?:\d+|all)\z/, default => 0}, 89 | 90 | # Booleans 91 | nsfw => {valid => [1, 0], default => 0}, 92 | env_proxy => {valid => [1, 0], default => 1}, 93 | escape_utf8 => {valid => [1, 0], default => 0}, 94 | prefer_mp4 => {valid => [1, 0], default => 0}, 95 | prefer_av1 => {valid => [1, 0], default => 0}, 96 | force_fallback => {valid => [1, 0], default => 0}, 97 | 98 | api_host => {valid => qr/\w/, default => "auto"}, 99 | 100 | #librarian_url => {valid => qr/\w/, default => 'https://lbry.bcow.xyz'}, 101 | #librarian_url => {valid => qr/\w/, default => 'https://lbry.vern.cc'}, 102 | 103 | #<<< 104 | # No input value allowed 105 | api_path => {valid => q[], default => '/api/v1/'}, 106 | www_content_type => {valid => q[], default => 'application/x-www-form-urlencoded'}, 107 | #>>> 108 | 109 | #<<< 110 | # LWP user agent 111 | #user_agent => {valid => qr/^.{5}/, default => 'Mozilla/5.0 (iPad; CPU OS 7_1_1 like Mac OS X) AppleWebKit/537.51.2 (KHTML, like Gecko) Version/7.0 Mobile/11D201 Safari/9537.53'}, 112 | user_agent => {valid => qr/^.{5}/, default => 'Mozilla/5.0 (Android 11; Tablet; rv:83.0) Gecko/83.0 Firefox/83.0,gzip(gfe)'}, 113 | #user_agent => {valid => qr/^.{5}/, default => 'Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:91.0) Gecko/20100101 Firefox/91.0'}, 114 | #>>> 115 | ); 116 | 117 | sub _our_smartmatch { 118 | my ($value, $arg) = @_; 119 | 120 | $value // return 0; 121 | 122 | if (not ref($arg)) { 123 | return ($value eq $arg); 124 | } 125 | 126 | if (ref($arg) eq ref(qr//)) { 127 | return scalar($value =~ $arg); 128 | } 129 | 130 | if (ref($arg) eq 'ARRAY') { 131 | foreach my $item (@$arg) { 132 | return 1 if __SUB__->($value, $item); 133 | } 134 | } 135 | 136 | return 0; 137 | } 138 | 139 | sub basic_video_info_fields { 140 | join( 141 | ',', 142 | qw( 143 | title 144 | videoId 145 | description 146 | descriptionHtml 147 | published 148 | publishedText 149 | viewCount 150 | likeCount 151 | dislikeCount 152 | genre 153 | author 154 | authorId 155 | lengthSeconds 156 | rating 157 | liveNow 158 | ) 159 | ); 160 | } 161 | 162 | sub extra_video_info_fields { 163 | my ($self) = @_; 164 | join( 165 | ',', 166 | $self->basic_video_info_fields, 167 | qw( 168 | subCountText 169 | captions 170 | isFamilyFriendly 171 | ) 172 | ); 173 | } 174 | 175 | { 176 | no strict 'refs'; 177 | 178 | foreach my $key (keys %valid_options) { 179 | 180 | if (ref($valid_options{$key}{valid})) { 181 | 182 | # Create the 'set_*' subroutines 183 | *{__PACKAGE__ . '::set_' . $key} = sub { 184 | my ($self, $value) = @_; 185 | $self->{$key} = 186 | _our_smartmatch($value, $valid_options{$key}{valid}) 187 | ? $value 188 | : $valid_options{$key}{default}; 189 | }; 190 | } 191 | 192 | # Create the 'get_*' subroutines 193 | *{__PACKAGE__ . '::get_' . $key} = sub { 194 | my ($self) = @_; 195 | 196 | if (not exists $self->{$key}) { 197 | return ($self->{$key} = $valid_options{$key}{default}); 198 | } 199 | 200 | $self->{$key}; 201 | }; 202 | } 203 | } 204 | 205 | =head2 new(%opts) 206 | 207 | Returns a blessed object. 208 | 209 | =cut 210 | 211 | sub new { 212 | my ($class, %opts) = @_; 213 | 214 | my $self = bless {}, $class; 215 | 216 | foreach my $key (keys %valid_options) { 217 | if (exists $opts{$key}) { 218 | my $method = "set_$key"; 219 | $self->$method(delete $opts{$key}); 220 | } 221 | } 222 | 223 | foreach my $invalid_key (keys %opts) { 224 | warn "Invalid key: '${invalid_key}'"; 225 | } 226 | 227 | return $self; 228 | } 229 | 230 | sub page_token { 231 | my ($self) = @_; 232 | my $page = $self->get_page; 233 | return undef if ($page == 1); 234 | return $page; 235 | } 236 | 237 | =head2 escape_string($string) 238 | 239 | Escapes a string with URI::Escape and returns it. 240 | 241 | =cut 242 | 243 | sub escape_string { 244 | my ($self, $string) = @_; 245 | 246 | require URI::Escape; 247 | 248 | $self->get_escape_utf8 249 | ? URI::Escape::uri_escape_utf8($string) 250 | : URI::Escape::uri_escape($string); 251 | } 252 | 253 | =head2 set_lwp_useragent() 254 | 255 | Initializes the LWP::UserAgent module and returns it. 256 | 257 | =cut 258 | 259 | sub set_lwp_useragent { 260 | my ($self) = @_; 261 | 262 | my $lwp = ( 263 | eval { require LWP::UserAgent::Cached; 'LWP::UserAgent::Cached' } 264 | // do { require LWP::UserAgent; 'LWP::UserAgent' } 265 | ); 266 | 267 | my $agent = $lwp->new( 268 | 269 | cookie_jar => {}, # temporary cookies 270 | timeout => $self->get_timeout, 271 | show_progress => $self->get_debug, 272 | agent => $self->get_user_agent, 273 | 274 | ssl_opts => {verify_hostname => 1}, 275 | 276 | $lwp eq 'LWP::UserAgent::Cached' 277 | ? ( 278 | cache_dir => $self->get_cache_dir, 279 | nocache_if => sub { 280 | my ($response) = @_; 281 | my $code = $response->code; 282 | 283 | $code >= 300 # do not cache any bad response 284 | or $response->request->method ne 'GET' # cache only GET requests 285 | 286 | # don't cache if "cache-control" specifies "max-age=0", "no-store" or "no-cache" 287 | or (($response->header('cache-control') // '') =~ /\b(?:max-age=0|no-store|no-cache)\b/) 288 | 289 | # don't cache media content 290 | or (($response->header('content-type') // '') =~ /\b(?:audio|image|video)\b/); 291 | }, 292 | 293 | recache_if => sub { 294 | my ($response, $path) = @_; 295 | not($response->is_fresh) # recache if the response expired 296 | or ($response->code == 404 && -M $path > 1); # recache any 404 response older than 1 day 297 | } 298 | ) 299 | : (), 300 | 301 | env_proxy => (defined($self->get_http_proxy) ? 0 : $self->get_env_proxy), 302 | ); 303 | 304 | #~ require LWP::ConnCache; 305 | #~ state $cache = LWP::ConnCache->new; 306 | #~ $cache->total_capacity(undef); # no limit 307 | #~ $agent->conn_cache($cache); 308 | 309 | state $accepted_encodings = do { 310 | require HTTP::Message; 311 | HTTP::Message::decodable(); 312 | }; 313 | 314 | $agent->ssl_opts(Timeout => $self->get_timeout); 315 | $agent->default_header('Accept-Encoding' => $accepted_encodings); 316 | $agent->default_header('Accept' => 'text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,*/*;q=0.8'); 317 | $agent->default_header('Accept-Language' => 'en-US,en;q=0.5'); 318 | $agent->default_header('Connection' => 'keep-alive'); 319 | $agent->default_header('Upgrade-Insecure-Requests' => '1'); 320 | 321 | $agent->proxy(['http', 'https'], $self->get_http_proxy) if defined($self->get_http_proxy); 322 | 323 | my $cookie_file = $self->get_cookie_file; 324 | 325 | if (defined($cookie_file) and -f $cookie_file) { 326 | 327 | if ($self->get_debug) { 328 | say STDERR ":: Using cookies from: $cookie_file"; 329 | } 330 | 331 | ## Netscape HTTP Cookies 332 | 333 | # Firefox extension: 334 | # https://addons.mozilla.org/en-US/firefox/addon/cookies-txt/ 335 | 336 | # See also: 337 | # https://github.com/ytdl-org/youtube-dl#how-do-i-pass-cookies-to-youtube-dl 338 | 339 | require HTTP::Cookies::Netscape; 340 | 341 | my $cookies = HTTP::Cookies::Netscape->new( 342 | hide_cookie2 => 1, 343 | autosave => 1, 344 | file => $cookie_file, 345 | ); 346 | 347 | $cookies->load; 348 | $agent->cookie_jar($cookies); 349 | } 350 | else { 351 | require HTTP::Cookies; 352 | my $cookies = HTTP::Cookies->new(); 353 | $agent->cookie_jar($cookies); 354 | } 355 | 356 | push @{$agent->requests_redirectable}, 'POST'; 357 | $self->{lwp} = $agent; 358 | return $agent; 359 | } 360 | 361 | sub _warn_reponse_error { 362 | my ($resp, $url) = @_; 363 | warn sprintf("[%s] Error occurred on URL: %s\n", $resp->status_line, $url); 364 | } 365 | 366 | =head2 lwp_get($url, %opt) 367 | 368 | Get and return the content for $url. 369 | 370 | =cut 371 | 372 | sub lwp_get { 373 | my ($self, $url, %opt) = @_; 374 | 375 | $url || return; 376 | $self->{lwp} // $self->set_lwp_useragent(); 377 | 378 | state @LWP_CACHE; 379 | 380 | if ($url =~ m{^//}) { 381 | $url = 'https:' . $url; 382 | } 383 | 384 | if ($url !~ /^https?:/) { # maybe it's base64 encoded? 385 | 386 | if ($self->get_debug) { 387 | say STDERR ":: URL without protocol: $url"; 388 | } 389 | 390 | require MIME::Base64; 391 | $url = MIME::Base64::decode_base64($url); 392 | } 393 | 394 | if ($url !~ m{^\w+://}) { # no protocol 395 | return; 396 | } 397 | 398 | # Redirect early spee.ch to player.odycdn.com 399 | # Example: https://spee.ch/0/9e11969ec347a6f9.png 400 | if ($url =~ m{^https://spee\.ch/(\w+)/(\w+)\.(\w+)\z}) { 401 | if ($3 ne 'gif') { 402 | $url = "https://player.odycdn.com/speech/$2:$1.$3"; 403 | } 404 | } 405 | 406 | # Check the cache 407 | foreach my $entry (@LWP_CACHE) { 408 | if ( $entry->{url} eq $url 409 | and $entry->{nsfw} eq ($self->get_nsfw ? 'true' : 'false') 410 | and time - $entry->{timestamp} <= 600) { 411 | return $entry->{content}; 412 | } 413 | } 414 | 415 | my $cookie_jar = $self->{lwp}->cookie_jar; 416 | my $domain = $url; 417 | 418 | if ($domain =~ m{^https?://(.*?)/}) { 419 | $domain = $1; 420 | } 421 | 422 | # Set the NSFW cookie 423 | $cookie_jar->set_cookie(0, "nsfw", ($self->get_nsfw ? "true" : "false"), "/", $domain, undef, 0, "", 3806952123, 0, {}); 424 | 425 | my $response = do { 426 | my $r; 427 | 428 | if ($url =~ m{^https?://[^/]+\.onion/}) { # onion URL 429 | 430 | if (not defined($self->get_http_proxy)) { # no proxy defined 431 | if ($self->get_env_proxy and (defined($ENV{HTTP_PROXY}) or defined($ENV{HTTPS_PROXY}))) { 432 | ## ok -- LWP::UserAgent will use proxy defined in ENV 433 | } 434 | else { 435 | say ":: Setting proxy for onion websites..." if $self->get_debug; 436 | $self->{lwp}->proxy(['http', 'https'], 'socks://localhost:9050'); 437 | $r = $self->{lwp}->get($url); 438 | $self->{lwp}->proxy(['http', 'https'], undef); 439 | } 440 | } 441 | } 442 | 443 | $r // $self->{lwp}->get($url); 444 | }; 445 | 446 | if ($response->is_success) { 447 | my $content = $response->decoded_content; 448 | unshift( 449 | @LWP_CACHE, 450 | scalar { 451 | url => $url, 452 | content => $content, 453 | timestamp => time, 454 | nsfw => ($self->get_nsfw ? 'true' : 'false') 455 | } 456 | ); 457 | pop(@LWP_CACHE) if (scalar(@LWP_CACHE) >= 50); 458 | return $content; 459 | } 460 | 461 | $opt{depth} ||= 0; 462 | 463 | # Try again on 500+ HTTP errors 464 | if ( $opt{depth} < 1 465 | and $response->code() >= 500 466 | and $response->status_line() =~ /(?:Temporary|Server) Error|Timeout|Service Unavailable/i) { 467 | return $self->lwp_get($url, %opt, depth => $opt{depth} + 1); 468 | } 469 | 470 | # Too many errors. Pick another Librarian instance. 471 | # $self->pick_and_set_random_instance(); 472 | 473 | _warn_reponse_error($response, $url); 474 | return; 475 | } 476 | 477 | =head2 lwp_post($url, [@args]) 478 | 479 | Post and return the content for $url. 480 | 481 | =cut 482 | 483 | sub lwp_post { 484 | my ($self, $url, @args) = @_; 485 | 486 | $self->{lwp} // $self->set_lwp_useragent(); 487 | 488 | my $response = $self->{lwp}->post($url, @args); 489 | 490 | if ($response->is_success) { 491 | return $response->decoded_content; 492 | } 493 | else { 494 | _warn_reponse_error($response, $url); 495 | } 496 | 497 | return; 498 | } 499 | 500 | =head2 lwp_mirror($url, $output_file) 501 | 502 | Downloads the $url into $output_file. Returns true on success. 503 | 504 | =cut 505 | 506 | sub lwp_mirror { 507 | my ($self, $url, $output_file) = @_; 508 | $self->{lwp} // $self->set_lwp_useragent(); 509 | $self->{lwp}->mirror($url, $output_file); 510 | } 511 | 512 | sub _get_results { 513 | my ($self, $url, %opt) = @_; 514 | 515 | return 516 | scalar { 517 | url => $url, 518 | results => $self->parse_json_string($self->lwp_get($url, %opt)), 519 | }; 520 | } 521 | 522 | =head2 list_to_url_arguments(\%options) 523 | 524 | Returns a valid string of arguments, with defined values. 525 | 526 | =cut 527 | 528 | sub list_to_url_arguments { 529 | my ($self, %args) = @_; 530 | join(q{&}, map { "$_=$args{$_}" } grep { defined $args{$_} } sort keys %args); 531 | } 532 | 533 | sub _append_url_args { 534 | my ($self, $url, %args) = @_; 535 | %args 536 | ? ($url . ($url =~ /\?/ ? '&' : '?') . $self->list_to_url_arguments(%args)) 537 | : $url; 538 | } 539 | 540 | sub _static_librarian_instances { 541 | my ($self) = @_; 542 | 543 | return [ 544 | { 545 | cloudflare => 0, 546 | country => "\x{1F1EF}\x{1F1F5} JP", 547 | live => 1, 548 | name => "odysee.076.ne.jp", 549 | url => "https://odysee.076.ne.jp", 550 | }, 551 | { 552 | cloudflare => 0, 553 | country => "\x{1F1E9}\x{1F1EA} DE", 554 | live => 1, 555 | name => "librarian.pussthecat.org", 556 | url => "https://librarian.pussthecat.org", 557 | }, 558 | { 559 | cloudflare => 0, 560 | country => "\x{1F1EB}\x{1F1F7} FR", 561 | live => 1, 562 | name => "lbry.projectsegfau.lt", 563 | url => "https://lbry.projectsegfau.lt", 564 | }, 565 | { 566 | cloudflare => 0, 567 | country => "\x{1F1E8}\x{1F1E6} CA", 568 | live => 0, 569 | name => "librarian.esmailelbob.xyz", 570 | url => "https://librarian.esmailelbob.xyz", 571 | }, 572 | { 573 | cloudflare => 0, 574 | country => "\x{1F1E8}\x{1F1E6} CA", 575 | live => 0, 576 | name => "lbry.vern.cc", 577 | url => "https://lbry.vern.cc", 578 | }, 579 | { 580 | cloudflare => 0, 581 | country => "\x{1F1FA}\x{1F1F8} US", 582 | live => 0, 583 | name => "lbry.slipfox.xyz", 584 | url => "https://lbry.slipfox.xyz", 585 | }, 586 | { 587 | cloudflare => 0, 588 | country => "\x{1F1F7}\x{1F1FA} RU", 589 | live => 0, 590 | name => "lbry.mywire.org", 591 | url => "https://lbry.mywire.org", 592 | }, 593 | { 594 | cloudflare => 0, 595 | country => "\x{1F1F8}\x{1F1F0} SK", 596 | live => 0, 597 | name => "lbry.ooguy.com", 598 | url => "https://lbry.ooguy.com", 599 | }, 600 | { 601 | cloudflare => 0, 602 | country => "\x{1F1E7}\x{1F1F7} BR", 603 | live => 1, 604 | name => "lbn.frail.duckdns.org", 605 | url => "https://lbn.frail.duckdns.org", 606 | }, 607 | ]; 608 | } 609 | 610 | sub get_librarian_instances { 611 | my ($self) = @_; 612 | 613 | require File::Spec; 614 | my $instances_file = File::Spec->catfile($self->get_config_dir, 'instances.json'); 615 | 616 | # Get the "instances.json" file when the local copy is too old or non-existent 617 | if ((not -e $instances_file) or (-M _) > 1 / 24) { 618 | 619 | $self->{lwp} // $self->set_lwp_useragent(); 620 | 621 | my $resp = $self->{lwp}->get("https://codeberg.org/librarian/librarian/raw/branch/main/instances.json"); 622 | 623 | $resp->is_success() or return; 624 | 625 | my $json = $resp->decoded_content() || return; 626 | open(my $fh, '>:utf8', $instances_file) or return; 627 | print $fh $json; 628 | close $fh; 629 | } 630 | 631 | open(my $fh, '<:utf8', $instances_file) or return; 632 | 633 | my $json_string = do { 634 | local $/; 635 | <$fh>; 636 | }; 637 | 638 | my $result = $self->parse_utf8_json_string($json_string); 639 | 640 | if (ref($result) ne 'HASH' or ref($result->{instances}) ne 'ARRAY' or not @{$result->{instances}}) { 641 | 642 | if ($self->get_debug) { 643 | say STDERR "[!] Could not fetch the list of Librarian instances...\n"; 644 | } 645 | 646 | return $self->_static_librarian_instances(); 647 | } 648 | 649 | return $result->{instances}; 650 | } 651 | 652 | sub select_good_librarian_instances { 653 | my ($self, %args) = @_; 654 | 655 | state $instances = $self->get_librarian_instances() // $self->_static_librarian_instances; 656 | 657 | ref($instances) eq 'ARRAY' or return; 658 | 659 | my %ignored = ( 660 | 'lbry.bcow.xyz' => 1, # Data collected 661 | 'librarian.pussthecat.org' => 1, # Data collected 662 | 'lbry.webhop.me' => 1, # search doesn't work 663 | 'odysee.076.ne.jp' => 1, # website not in English (also too slow) 664 | ); 665 | 666 | #<<< 667 | my @candidates = 668 | grep { not $ignored{$_->{name}} } 669 | grep { $_->{name} !~ /\.onion\z/ } 670 | grep { $args{lax} ? 1 : (not $_->{cloudflare}) } 671 | #grep { $args{lax} ? 1 : ($_->{live}) } 672 | grep { $_->{url} =~ m{^https://} } 673 | @$instances; 674 | #>>> 675 | 676 | if ($self->get_debug) { 677 | 678 | my @hosts = map { $_->{name} } @candidates; 679 | my $count = scalar(@candidates); 680 | 681 | print STDERR ":: Found $count librarian instances: @hosts\n"; 682 | } 683 | 684 | return @candidates; 685 | } 686 | 687 | sub _find_working_instance { 688 | my ($self, $candidates, $extra_candidates) = @_; 689 | 690 | require File::Spec; 691 | my $current_instance_file = File::Spec->catfile($self->get_config_dir, 'current_instance.json'); 692 | 693 | # Return the most recent working instance 694 | if (open(my $fh, '<:raw', $current_instance_file)) { 695 | my $instance = $self->parse_json_string( 696 | do { 697 | local $/; 698 | scalar <$fh>; 699 | } 700 | ); 701 | close $fh; 702 | if (ref($instance) eq 'HASH' and time - $instance->{_time} <= 3600) { 703 | return $instance; 704 | } 705 | } 706 | 707 | require List::Util; 708 | state $yv_utils = WWW::LbryViewer::Utils->new(); 709 | 710 | my %seen; 711 | 712 | foreach my $instance (List::Util::shuffle(@$candidates), List::Util::shuffle(@$extra_candidates)) { 713 | 714 | ref($instance) eq 'HASH' or next; 715 | 716 | my $uri = $instance->{url} // next; 717 | next if $seen{$uri}++; 718 | 719 | local $self->{api_host} = $uri; 720 | 721 | my $results = $self->search_videos('test'); 722 | 723 | if ($yv_utils->has_entries($results)) { 724 | 725 | # Save the current working instance 726 | if (open(my $fh, '>:raw', $current_instance_file)) { 727 | $instance->{_time} = time; 728 | say $fh $self->make_json_string($instance); 729 | close $fh; 730 | } 731 | 732 | return $instance; 733 | } 734 | } 735 | 736 | return; 737 | } 738 | 739 | sub pick_random_instance { 740 | my ($self) = @_; 741 | 742 | my @candidates = $self->select_good_librarian_instances(); 743 | my @extra_candidates = $self->select_good_librarian_instances(lax => 1); 744 | 745 | if (defined(my $instance = $self->_find_working_instance(\@candidates, \@extra_candidates))) { 746 | return $instance; 747 | } 748 | 749 | if (not @candidates) { 750 | @candidates = @extra_candidates; 751 | } 752 | 753 | $candidates[rand @candidates]; 754 | } 755 | 756 | sub pick_and_set_random_instance { 757 | my ($self) = @_; 758 | 759 | my $instance = $self->pick_random_instance() // return; 760 | 761 | ref($instance) eq 'HASH' or return; 762 | my $uri = $instance->{url} // return; 763 | $self->set_api_host($uri); 764 | } 765 | 766 | sub get_librarian_url { 767 | my ($self) = @_; 768 | 769 | my $host = $self->get_api_host; 770 | 771 | # Remove whitespace (if any) 772 | $host =~ s/^\s+//; 773 | $host =~ s/\s+\z//; 774 | 775 | $host =~ s{/+\z}{}; # remove trailing '/' 776 | 777 | if ($host =~ /\w\.\w/ and $host !~ m{^\w+://}) { # no protocol specified 778 | 779 | my $protocol = 'https://'; # default to HTTPS 780 | 781 | if ($host =~ m{^[^/]+\.onion\z}) { # onion URL 782 | $protocol = 'http://'; # default to HTTP 783 | } 784 | 785 | $host = $protocol . $host; 786 | } 787 | 788 | # Pick a random instance when `--instance=auto` 789 | if ($host eq 'auto') { 790 | 791 | if (defined($self->pick_and_set_random_instance())) { 792 | $host = $self->get_api_host(); 793 | print STDERR ":: Changed the instance to: $host\n" if $self->get_debug; 794 | } 795 | else { 796 | 797 | my @fallback_instances = qw( 798 | librarian.esmailelbob.xyz 799 | lbry.projectsegfau.lt 800 | lbry.vern.cc 801 | lbry.slipfox.xyz 802 | lbry.mywire.org 803 | lbry.ooguy.com 804 | lbn.frail.duckdns.org 805 | ); 806 | 807 | $host = "https://" . $fallback_instances[int rand scalar @fallback_instances]; 808 | $self->set_api_host($host); 809 | print STDERR ":: Failed to change the instance. Using: $host\n" if $self->get_debug; 810 | } 811 | } 812 | 813 | return $host; 814 | } 815 | 816 | sub _simple_feeds_url { 817 | my ($self, $path, %args) = @_; 818 | $self->get_librarian_url() . $path . '?' . $self->list_to_url_arguments(%args); 819 | } 820 | 821 | =head2 default_arguments(%args) 822 | 823 | Merge the default arguments with %args and concatenate them together. 824 | 825 | =cut 826 | 827 | sub default_arguments { 828 | my ($self, %args) = @_; 829 | 830 | my %defaults = ( 831 | 832 | #part => 'snippet', 833 | #prettyPrint => 'false', 834 | #maxResults => $self->get_maxResults, 835 | %args, 836 | ); 837 | 838 | $self->list_to_url_arguments(%defaults); 839 | } 840 | 841 | sub _make_feed_url { 842 | my ($self, $path, %args) = @_; 843 | 844 | my $extra_args = $self->default_arguments(%args); 845 | my $url = $self->get_librarian_url() . ($path // ''); 846 | 847 | if ($extra_args) { 848 | $url .= '?' . $extra_args; 849 | } 850 | 851 | return $url; 852 | } 853 | 854 | sub _ytdl_is_available { 855 | my ($self) = @_; 856 | ($self->proxy_stdout($self->get_ytdl_cmd(), '--version') // '') =~ /\d/; 857 | } 858 | 859 | sub _info_from_ytdl { 860 | my ($self, $videoID) = @_; 861 | 862 | $self->_ytdl_is_available() || return; 863 | 864 | my @ytdl_cmd = ($self->get_ytdl_cmd(), '--all-formats', '--dump-single-json'); 865 | 866 | my $cookie_file = $self->get_cookie_file; 867 | 868 | if (defined($cookie_file) and -f $cookie_file) { 869 | push @ytdl_cmd, '--cookies', quotemeta($cookie_file); 870 | } 871 | 872 | my $json = $self->proxy_stdout(@ytdl_cmd, quotemeta("https://odysee.com/" . $videoID)); 873 | my $ref = $self->parse_json_string($json // return); 874 | 875 | if ($self->get_debug >= 3) { 876 | require Data::Dump; 877 | Data::Dump::pp($ref); 878 | } 879 | 880 | return $ref; 881 | } 882 | 883 | sub _extract_from_ytdl { 884 | my ($self, $videoID) = @_; 885 | 886 | my $ref = $self->_info_from_ytdl($videoID) // return; 887 | 888 | my @formats; 889 | 890 | if (ref($ref) eq 'HASH' and exists($ref->{formats}) and ref($ref->{formats}) eq 'ARRAY') { 891 | foreach my $format (@{$ref->{formats}}) { 892 | if (exists($format->{format_id}) and exists($format->{url})) { 893 | 894 | my $entry = { 895 | itag => $format->{format_id}, 896 | url => $format->{url}, 897 | type => ((($format->{format} // '') =~ /audio only/i) ? 'audio/' : 'video/') . $format->{ext}, 898 | }; 899 | 900 | push @formats, $entry; 901 | } 902 | } 903 | } 904 | 905 | if (!@formats and defined($ref->{url})) { 906 | push @formats, 907 | scalar { 908 | itag => 'b', 909 | type => 'video/mp4', 910 | url => $ref->{url}, 911 | }; 912 | } 913 | 914 | return @formats; 915 | } 916 | 917 | sub _fallback_extract_urls { 918 | my ($self, $videoID) = @_; 919 | 920 | my @formats; 921 | 922 | # Use youtube-dl 923 | if ($self->get_ytdl and $self->_ytdl_is_available) { 924 | 925 | if ($self->get_debug) { 926 | my $cmd = $self->get_ytdl_cmd; 927 | say STDERR ":: Using $cmd to extract the streaming URLs..."; 928 | } 929 | 930 | push @formats, $self->_extract_from_ytdl($videoID); 931 | 932 | if ($self->get_debug) { 933 | my $count = scalar(@formats); 934 | my $cmd = $self->get_ytdl_cmd; 935 | say STDERR ":: $cmd: found $count streaming URLs..."; 936 | } 937 | 938 | @formats && return @formats; 939 | } 940 | 941 | return @formats; 942 | } 943 | 944 | =head2 parse_query_string($string, multi => [0,1]) 945 | 946 | Parse a query string and return a data structure back. 947 | 948 | When the B option is set to a true value, the function will store multiple values for a given key. 949 | 950 | Returns back a list of key-value pairs. 951 | 952 | =cut 953 | 954 | sub parse_query_string { 955 | my ($self, $str, %opt) = @_; 956 | 957 | if (not defined($str)) { 958 | return; 959 | } 960 | 961 | require URI::Escape; 962 | 963 | my @pairs; 964 | foreach my $statement (split(/,/, $str)) { 965 | foreach my $pair (split(/&/, $statement)) { 966 | push @pairs, $pair; 967 | } 968 | } 969 | 970 | my %result; 971 | 972 | foreach my $pair (@pairs) { 973 | my ($key, $value) = split(/=/, $pair, 2); 974 | 975 | if (not defined($value) or $value eq '') { 976 | next; 977 | } 978 | 979 | $value = URI::Escape::uri_unescape($value =~ tr/+/ /r); 980 | 981 | if ($opt{multi}) { 982 | push @{$result{$key}}, $value; 983 | } 984 | else { 985 | $result{$key} = $value; 986 | } 987 | } 988 | 989 | return %result; 990 | } 991 | 992 | sub _make_translated_captions { 993 | my ($self, $caption_urls) = @_; 994 | 995 | my @languages = qw( 996 | af am ar az be bg bn bs ca ceb co cs cy da de el en eo es et eu fa fi fil 997 | fr fy ga gd gl gu ha haw hi hmn hr ht hu hy id ig is it iw ja jv ka kk km 998 | kn ko ku ky la lb lo lt lv mg mi mk ml mn mr ms mt my ne nl no ny or pa pl 999 | ps pt ro ru rw sd si sk sl sm sn so sq sr st su sv sw ta te tg th tk tr tt 1000 | ug uk ur uz vi xh yi yo zh-Hans zh-Hant zu 1001 | ); 1002 | 1003 | my %trans_languages = map { $_->{languageCode} => 1 } @$caption_urls; 1004 | @languages = grep { not exists $trans_languages{$_} } @languages; 1005 | 1006 | my @asr; 1007 | foreach my $caption (@$caption_urls) { 1008 | foreach my $lang_code (@languages) { 1009 | my %caption_copy = %$caption; 1010 | $caption_copy{languageCode} = $lang_code; 1011 | $caption_copy{baseUrl} = $caption_copy{baseUrl} . "&tlang=$lang_code"; 1012 | push @asr, \%caption_copy; 1013 | } 1014 | } 1015 | 1016 | return @asr; 1017 | } 1018 | 1019 | sub _fallback_extract_captions { 1020 | my ($self, $videoID) = @_; 1021 | 1022 | return; # TODO: implement it (do LBRY videos have CC?) 1023 | 1024 | if ($self->get_debug) { 1025 | my $cmd = $self->get_ytdl_cmd; 1026 | say STDERR ":: Extracting closed-caption URLs with $cmd"; 1027 | } 1028 | 1029 | my $ytdl_info = $self->_info_from_ytdl($videoID); 1030 | 1031 | my @caption_urls; 1032 | 1033 | if (defined($ytdl_info) and ref($ytdl_info) eq 'HASH') { 1034 | 1035 | my $has_subtitles = 0; 1036 | 1037 | foreach my $key (qw(subtitles automatic_captions)) { 1038 | 1039 | my $ccaps = $ytdl_info->{$key} // next; 1040 | 1041 | ref($ccaps) eq 'HASH' or next; 1042 | 1043 | foreach my $lang_code (sort keys %$ccaps) { 1044 | 1045 | my ($caption_info) = grep { $_->{ext} eq 'srv1' } @{$ccaps->{$lang_code}}; 1046 | 1047 | if (defined($caption_info) and ref($caption_info) eq 'HASH' and defined($caption_info->{url})) { 1048 | 1049 | push @caption_urls, 1050 | scalar { 1051 | kind => ($key eq 'automatic_captions' ? 'asr' : ''), 1052 | languageCode => $lang_code, 1053 | baseUrl => $caption_info->{url}, 1054 | }; 1055 | 1056 | if ($key eq 'subtitles') { 1057 | $has_subtitles = 1; 1058 | } 1059 | } 1060 | } 1061 | 1062 | last if $has_subtitles; 1063 | } 1064 | 1065 | # Auto-translated captions 1066 | if ($has_subtitles) { 1067 | 1068 | if ($self->get_debug) { 1069 | say STDERR ":: Generating translated closed-caption URLs..."; 1070 | } 1071 | 1072 | push @caption_urls, $self->_make_translated_captions(\@caption_urls); 1073 | } 1074 | } 1075 | 1076 | return @caption_urls; 1077 | } 1078 | 1079 | =head2 get_streaming_urls($videoID) 1080 | 1081 | Returns a list of streaming URLs for a videoID. 1082 | ({itag=>..., url=>...}, {itag=>..., url=>....}, ...) 1083 | 1084 | =cut 1085 | 1086 | sub get_streaming_urls { 1087 | my ($self, $videoID) = @_; 1088 | 1089 | my @caption_urls; 1090 | my @streaming_urls; 1091 | 1092 | my $html = $self->get_force_fallback ? undef : $self->lbry_video_page_html(id => $videoID); 1093 | 1094 | if (defined($html) and $html =~ m{}) { 1095 | 1096 | my $m3u8_url = $1; 1097 | 1098 | if ($m3u8_url =~ m{^/}) { 1099 | $m3u8_url = $self->get_librarian_url . $m3u8_url; 1100 | } 1101 | 1102 | require HTML::Entities; 1103 | $m3u8_url = HTML::Entities::decode_entities($m3u8_url); 1104 | 1105 | my $base_url = substr($m3u8_url, 0, rindex($m3u8_url, '/') + 1); 1106 | my $content = ($m3u8_url =~ m{^https?://} ? $self->lwp_get($m3u8_url) : '') // ''; 1107 | my @paragraphs = split(/\R\s*\R/, $content); 1108 | 1109 | foreach my $para (@paragraphs) { 1110 | my %info; 1111 | 1112 | if ($para =~ m{\bRESOLUTION=(\d+)x(\d+)\b}) { 1113 | my ($x, $y) = ($1, $2); 1114 | 1115 | if ($y > $x) { 1116 | ($x, $y) = ($y, $x); 1117 | } 1118 | 1119 | my $res = $y; 1120 | 1121 | if ($res - 100 >= 1080 or $res + 100 >= 1080) { 1122 | $res = 1080; 1123 | } 1124 | elsif ($res - 100 >= 720 or $res + 100 >= 720) { 1125 | $res = 720; 1126 | } 1127 | elsif ($res - 100 >= 480 or $res + 100 >= 480) { 1128 | $res = 480; 1129 | } 1130 | elsif ($res - 100 >= 360 or $res + 100 >= 360) { 1131 | $res = 360; 1132 | } 1133 | elsif ($res - 100 >= 144 or $res + 100 >= 144) { 1134 | $res = 144; 1135 | } 1136 | 1137 | $info{resolution} = $res . 'p'; 1138 | } 1139 | 1140 | if ($para =~ m{^(\S+\.m3u8$)}m) { 1141 | my $filename = $1; 1142 | $info{url} = $base_url . $filename; 1143 | $info{type} = 'video/mp4'; 1144 | ## push @streaming_urls, \%info; 1145 | } 1146 | 1147 | if (defined($info{url}) and $para =~ m{\bBANDWIDTH=(\d+)\b}) { 1148 | my $bytes = int($1 / 1000); 1149 | my %new_info = %info; 1150 | $new_info{itag} = "hls-$bytes"; 1151 | push @streaming_urls, \%new_info; 1152 | } 1153 | } 1154 | 1155 | if ($self->get_debug) { 1156 | my $count = scalar(@streaming_urls); 1157 | say STDERR ":: Found $count streaming URLs..."; 1158 | } 1159 | 1160 | if ($self->get_debug >= 2) { 1161 | require Data::Dump; 1162 | Data::Dump::pp(\@streaming_urls); 1163 | } 1164 | 1165 | if (@streaming_urls) { 1166 | return (\@streaming_urls, \@caption_urls); 1167 | } 1168 | } 1169 | 1170 | if (defined($html) and $html =~ m{}) { 1171 | 1172 | my $url = $1; 1173 | 1174 | if ($url =~ m{^/}) { 1175 | $url = $self->get_librarian_url . $url; 1176 | } 1177 | 1178 | require HTML::Entities; 1179 | $url = HTML::Entities::decode_entities($url); 1180 | 1181 | my %info = ( 1182 | url => $url, 1183 | itag => 'b', 1184 | type => 'video/mp4', 1185 | ); 1186 | 1187 | if ($url =~ m{^https?://}) { 1188 | push @streaming_urls, \%info; 1189 | return (\@streaming_urls, \@caption_urls); 1190 | } 1191 | } 1192 | 1193 | @streaming_urls = $self->_fallback_extract_urls($videoID); 1194 | 1195 | if (!@caption_urls) { 1196 | push @caption_urls, $self->_fallback_extract_captions($videoID); 1197 | } 1198 | 1199 | if ($self->get_debug) { 1200 | my $count = scalar(@streaming_urls); 1201 | say STDERR ":: Found $count streaming URLs..."; 1202 | } 1203 | 1204 | # Return the LBRY URL when there are no streaming URLs 1205 | if (!@streaming_urls) { 1206 | push @streaming_urls, 1207 | { 1208 | itag => 'b', 1209 | type => "video/mp4", 1210 | url => "https://odysee.com/$videoID", 1211 | }; 1212 | } 1213 | 1214 | if ($self->get_debug >= 2) { 1215 | require Data::Dump; 1216 | Data::Dump::pp(\@streaming_urls); 1217 | Data::Dump::pp(\@caption_urls); 1218 | } 1219 | 1220 | return (\@streaming_urls, \@caption_urls); 1221 | } 1222 | 1223 | sub _request { 1224 | my ($self, $req) = @_; 1225 | 1226 | $self->{lwp} // $self->set_lwp_useragent(); 1227 | 1228 | my $res = $self->{lwp}->request($req); 1229 | 1230 | if ($res->is_success) { 1231 | return $res->decoded_content; 1232 | } 1233 | else { 1234 | warn 'Request error: ' . $res->status_line(); 1235 | } 1236 | 1237 | return; 1238 | } 1239 | 1240 | sub _prepare_request { 1241 | my ($self, $req, $length) = @_; 1242 | $req->header('Content-Length' => $length) if ($length); 1243 | return 1; 1244 | } 1245 | 1246 | sub _save { 1247 | my ($self, $method, $uri, $content) = @_; 1248 | 1249 | require HTTP::Request; 1250 | my $req = HTTP::Request->new($method => $uri); 1251 | $req->content_type('application/json; charset=UTF-8'); 1252 | $self->_prepare_request($req, length($content)); 1253 | $req->content($content); 1254 | 1255 | $self->_request($req); 1256 | } 1257 | 1258 | sub post_as_json { 1259 | my ($self, $url, $ref) = @_; 1260 | my $json_str = $self->make_json_string($ref); 1261 | $self->_save('POST', $url, $json_str); 1262 | } 1263 | 1264 | sub next_page_with_token { 1265 | my ($self, $url, $token) = @_; 1266 | 1267 | if (ref($token) eq 'CODE') { 1268 | return $token->(); 1269 | } 1270 | 1271 | if ($token =~ /^ytdlp:comments:(.*?):(\d+):(.*?):(.*)/) { 1272 | my ($video_id, $page, $prev_root_comment_id, $prev_comment_id) = ($1, $2, $3, $4); 1273 | return $self->comments_from_ytdlp($video_id, $page, $prev_root_comment_id, $prev_comment_id); 1274 | } 1275 | 1276 | if ($token =~ /^yt(search|browse):(\w+):(.*)/) { 1277 | if ($1 eq 'browse') { 1278 | return $self->yt_browse_next_page($url, $3, type => $2, url => $url); 1279 | } 1280 | else { 1281 | return $self->yt_search_next_page($url, $3, type => $2, url => $url); 1282 | } 1283 | } 1284 | 1285 | if ($token =~ m{^lbry:search:(\w+):(.+)}) { 1286 | my $type = $1; 1287 | my $url = $2; 1288 | return $self->lbry_search_from_url($url, type => $type); 1289 | } 1290 | 1291 | if ($token =~ /^ytplaylist:(\w+):(.*)/) { 1292 | return $self->yt_playlist_next_page($url, $2, type => $1, url => $url); 1293 | } 1294 | 1295 | if ($url =~ m{^https://m\.youtube\.com}) { 1296 | return 1297 | scalar { 1298 | url => $url, 1299 | results => [], 1300 | }; 1301 | } 1302 | 1303 | if (not $url =~ s{[?&]continuation=\K([^&]+)}{$token}) { 1304 | $url = $self->_append_url_args($url, continuation => $token); 1305 | } 1306 | 1307 | my $res = $self->_get_results($url); 1308 | $res->{url} = $url; 1309 | return $res; 1310 | } 1311 | 1312 | sub next_page { 1313 | my ($self, $url, $token) = @_; 1314 | 1315 | if ($token) { 1316 | return $self->next_page_with_token($url, $token); 1317 | } 1318 | 1319 | if ($url =~ m{^https://m\.youtube\.com}) { 1320 | return 1321 | scalar { 1322 | url => $url, 1323 | results => [], 1324 | }; 1325 | } 1326 | 1327 | if (not $url =~ s{[?&]page=\K(\d+)}{$1+1}e) { 1328 | $url = $self->_append_url_args($url, page => 2); 1329 | } 1330 | 1331 | return $self->lbry_search_from_url($url, type => 'video'); 1332 | 1333 | #~ my $res = $self->_get_results($url); 1334 | #~ $res->{url} = $url; 1335 | #~ return $res; 1336 | } 1337 | 1338 | # SUBROUTINE FACTORY 1339 | { 1340 | no strict 'refs'; 1341 | 1342 | # Create proxy_{exec,system} subroutines 1343 | foreach my $name ('exec', 'system', 'stdout') { 1344 | *{__PACKAGE__ . '::proxy_' . $name} = sub { 1345 | my ($self, @args) = @_; 1346 | 1347 | $self->{lwp} // $self->set_lwp_useragent(); 1348 | 1349 | local $ENV{http_proxy} = $self->{lwp}->proxy('http'); 1350 | local $ENV{https_proxy} = $self->{lwp}->proxy('https'); 1351 | 1352 | local $ENV{HTTP_PROXY} = $self->{lwp}->proxy('http'); 1353 | local $ENV{HTTPS_PROXY} = $self->{lwp}->proxy('https'); 1354 | 1355 | local $" = " "; 1356 | 1357 | $name eq 'exec' ? exec(@args) 1358 | : $name eq 'system' ? system(@args) 1359 | : $name eq 'stdout' ? qx(@args) 1360 | : (); 1361 | }; 1362 | } 1363 | } 1364 | 1365 | =head1 AUTHOR 1366 | 1367 | Trizen, C<< >> 1368 | 1369 | =head1 SEE ALSO 1370 | 1371 | https://developers.google.com/youtube/v3/docs/ 1372 | 1373 | =head1 LICENSE AND COPYRIGHT 1374 | 1375 | Copyright 2012-2015 Trizen. 1376 | 1377 | This program is free software; you can redistribute it and/or modify it 1378 | under the terms of the the Artistic License (2.0). You may obtain a 1379 | copy of the full license at: 1380 | 1381 | L 1382 | 1383 | Any use, modification, and distribution of the Standard or Modified 1384 | Versions is governed by this Artistic License. By using, modifying or 1385 | distributing the Package, you accept this license. Do not use, modify, 1386 | or distribute the Package, if you do not accept this license. 1387 | 1388 | If your Modified Version has been derived from a Modified Version made 1389 | by someone other than you, you are nevertheless required to ensure that 1390 | your Modified Version complies with the requirements of this license. 1391 | 1392 | This license does not grant you the right to use any trademark, service 1393 | mark, tradename, or logo of the Copyright Holder. 1394 | 1395 | This license includes the non-exclusive, worldwide, free-of-charge 1396 | patent license to make, have made, use, offer to sell, sell, import and 1397 | otherwise transfer the Package with respect to any patent claims 1398 | licensable by the Copyright Holder that are necessarily infringed by the 1399 | Package. If you institute patent litigation (including a cross-claim or 1400 | counterclaim) against any party alleging that the Package constitutes 1401 | direct or contributory patent infringement, then this Artistic License 1402 | to you shall terminate on the date that such litigation is filed. 1403 | 1404 | Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER 1405 | AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. 1406 | THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR 1407 | PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY 1408 | YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR 1409 | CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR 1410 | CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, 1411 | EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 1412 | 1413 | 1414 | =cut 1415 | 1416 | 1; # End of WWW::LbryViewer 1417 | 1418 | __END__ 1419 | -------------------------------------------------------------------------------- /lib/WWW/LbryViewer/Channels.pm: -------------------------------------------------------------------------------- 1 | package WWW::LbryViewer::Channels; 2 | 3 | use utf8; 4 | use 5.014; 5 | use warnings; 6 | 7 | =head1 NAME 8 | 9 | WWW::LbryViewer::Channels - Channels interface. 10 | 11 | =head1 SYNOPSIS 12 | 13 | use WWW::LbryViewer; 14 | my $obj = WWW::LbryViewer->new(%opts); 15 | my $videos = $obj->channels_from_categoryID($category_id); 16 | 17 | =head1 SUBROUTINES/METHODS 18 | 19 | =cut 20 | 21 | sub _make_channels_url { 22 | my ($self, %opts) = @_; 23 | return $self->_make_feed_url('channels', %opts); 24 | } 25 | 26 | sub videos_from_channel_id { 27 | my ($self, $channel_id) = @_; 28 | 29 | if (my $results = $self->lbry_channel_uploads($channel_id)) { 30 | return $results; 31 | } 32 | 33 | return; 34 | } 35 | 36 | sub videos_from_username { 37 | my ($self, $channel_id) = @_; 38 | $self->videos_from_channel_id($channel_id); 39 | } 40 | 41 | =head2 popular_videos($channel_id) 42 | 43 | Get the most popular videos for a given channel ID. 44 | 45 | =cut 46 | 47 | sub popular_videos { 48 | my ($self, $channel_id) = @_; 49 | 50 | if (not defined($channel_id)) { # trending popular/featured videos 51 | return $self->lbry_category_videos; 52 | } 53 | 54 | # TODO: implement support for popular LBRY videos for a channel 55 | if (my $results = $self->lbry_channel_uploads($channel_id, sort_by => 'popular')) { 56 | return $results; 57 | } 58 | 59 | my $url = $self->_make_feed_url("channels/$channel_id/videos", sort_by => 'popular'); 60 | return $self->_get_results($url); 61 | } 62 | 63 | =head2 channels_from_categoryID($category_id) 64 | 65 | Return the YouTube channels associated with the specified category. 66 | 67 | =head2 channels_info($channel_id) 68 | 69 | Return information for the comma-separated list of the YouTube channel ID(s). 70 | 71 | =head1 Channel details 72 | 73 | For all functions, C<$channels->{results}{items}> contains: 74 | 75 | =cut 76 | 77 | { 78 | no strict 'refs'; 79 | 80 | foreach my $method ( 81 | { 82 | key => 'categoryId', 83 | name => 'channels_from_guide_category', 84 | }, 85 | { 86 | key => 'id', 87 | name => 'channels_info', 88 | }, 89 | { 90 | key => 'forUsername', 91 | name => 'channels_from_username', 92 | }, 93 | ) { 94 | *{__PACKAGE__ . '::' . $method->{name}} = sub { 95 | my ($self, $channel_id) = @_; 96 | return $self->_get_results($self->_make_channels_url($method->{key} => $channel_id)); 97 | }; 98 | } 99 | 100 | foreach my $part (qw(id contentDetails statistics topicDetails)) { 101 | *{__PACKAGE__ . '::' . 'channels_' . $part} = sub { 102 | my ($self, $id) = @_; 103 | return $self->_get_results($self->_make_channels_url(id => $id, part => $part)); 104 | }; 105 | } 106 | } 107 | 108 | =head2 channel_id_from_username($username) 109 | 110 | Return the channel ID for an username. 111 | 112 | =cut 113 | 114 | sub channel_id_from_username { 115 | my ($self, $username) = @_; 116 | 117 | state $cache = {}; 118 | 119 | if (exists $cache->{username}) { 120 | return $cache->{username}; 121 | } 122 | 123 | if (defined(my $id = $self->yt_channel_id($username))) { 124 | if (ref($id) eq '' and $id =~ /\S/) { 125 | $cache->{$username} = $id; 126 | return $id; 127 | } 128 | } 129 | 130 | # A channel's username (if it doesn't include spaces) is also valid in place of ucid. 131 | if ($username =~ /\w/ and not $username =~ /\s/) { 132 | return $username; 133 | } 134 | 135 | # Unable to resolve channel name to channel ID (return as it is) 136 | return $username; 137 | } 138 | 139 | =head2 channel_title_from_id($channel_id) 140 | 141 | Return the channel title for a given channel ID. 142 | 143 | =cut 144 | 145 | sub channel_title_from_id { 146 | my ($self, $channel_id) = @_; 147 | 148 | $channel_id // return; 149 | 150 | state $cache = {}; 151 | 152 | if (exists $cache->{channel_id}) { 153 | return $cache->{channel_id}; 154 | } 155 | 156 | if (defined(my $title = $self->yt_channel_title($channel_id))) { 157 | if (ref($title) eq '' and $title =~ /\S/) { 158 | $cache->{$channel_id} = $title; 159 | return $title; 160 | } 161 | } 162 | 163 | my $info = $self->channels_info($channel_id) // return; 164 | 165 | (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') 166 | ? $info->{results}{items}[0]{snippet}{title} 167 | : (); 168 | } 169 | 170 | =head2 channels_contentDetails($channelID) 171 | 172 | =head2 channels_statistics($channelID); 173 | 174 | =head2 channels_topicDetails($channelID) 175 | 176 | =cut 177 | 178 | =head1 AUTHOR 179 | 180 | Trizen, C<< >> 181 | 182 | 183 | =head1 SUPPORT 184 | 185 | You can find documentation for this module with the perldoc command. 186 | 187 | perldoc WWW::LbryViewer::Channels 188 | 189 | 190 | =head1 LICENSE AND COPYRIGHT 191 | 192 | Copyright 2013-2015 Trizen. 193 | 194 | This program is free software; you can redistribute it and/or modify it 195 | under the terms of either: the GNU General Public License as published 196 | by the Free Software Foundation; or the Artistic License. 197 | 198 | See L for more information. 199 | 200 | =cut 201 | 202 | 1; # End of WWW::LbryViewer::Channels 203 | -------------------------------------------------------------------------------- /lib/WWW/LbryViewer/CommentThreads.pm: -------------------------------------------------------------------------------- 1 | package WWW::LbryViewer::CommentThreads; 2 | 3 | use utf8; 4 | use 5.014; 5 | use warnings; 6 | 7 | =head1 NAME 8 | 9 | WWW::LbryViewer::CommentThreads - Retrieve comments threads. 10 | 11 | =head1 SYNOPSIS 12 | 13 | use WWW::LbryViewer; 14 | my $obj = WWW::LbryViewer->new(%opts); 15 | my $videos = $obj->comments_from_video_id($video_id); 16 | 17 | =head1 SUBROUTINES/METHODS 18 | 19 | =cut 20 | 21 | sub _make_commentThreads_url { 22 | my ($self, %opts) = @_; 23 | return 24 | $self->_make_feed_url( 25 | 'commentThreads', 26 | pageToken => $self->page_token, 27 | %opts 28 | ); 29 | } 30 | 31 | sub comments_from_ytdlp { 32 | my ($self, $video_id, $page, $prev_root_comment_id, $prev_comment_id) = @_; 33 | 34 | $page //= 1; 35 | 36 | my $max_comments = $self->get_ytdlp_max_comments; 37 | my $max_replies = $self->get_ytdlp_max_replies; 38 | my $comments_order = $self->get_comments_order; 39 | my $ytdl_cmd = $self->get_ytdl_cmd; 40 | 41 | my $max_comments_per_page = $max_comments; 42 | $max_comments = $page * $max_comments; 43 | 44 | my @cmd = ( 45 | $ytdl_cmd, 46 | '--write-comments', 47 | '--extractor-args', 48 | #<<< 49 | quotemeta("youtube:comment_sort=$comments_order;skip=hls,dash,translated_subs;player_skip=js;max_comments=$max_comments,all,all,$max_replies"), 50 | #>>> 51 | '--no-check-formats', 52 | '--ignore-no-formats-error', 53 | '--dump-single-json', 54 | quotemeta("https://www.youtube.com/watch?v=$video_id"), 55 | ); 56 | 57 | if ($self->get_debug) { 58 | say STDERR ":: Extracting comments with `yt-dlp`..."; 59 | } 60 | 61 | my $info = $self->parse_json_string($self->proxy_stdout(@cmd) // return); 62 | 63 | (ref($info) eq 'HASH' and exists($info->{comments}) and ref($info->{comments}) eq 'ARRAY') 64 | || return; 65 | 66 | my @comments = @{$info->{comments}}; 67 | my $comment_count = $info->{comment_count} // scalar(@comments); 68 | 69 | my $last_comment_id = undef; 70 | my $last_root_comment_id = undef; 71 | 72 | if (@comments) { 73 | $last_comment_id = $comments[-1]{id}; 74 | } 75 | 76 | for (my $i = $#comments ; $i >= 0 ; --$i) { 77 | my $comment = $comments[$i]; 78 | if ($comment->{parent} eq 'root') { 79 | $last_root_comment_id = $comment->{id}; 80 | last; 81 | } 82 | } 83 | 84 | $last_comment_id //= $prev_comment_id // ''; 85 | $last_root_comment_id //= $prev_root_comment_id // ''; 86 | 87 | if ($page > 1) { 88 | my $prev_root_comment; 89 | 90 | foreach my $i (0 .. $#comments) { 91 | my $comment = $comments[$i]; 92 | 93 | if ($prev_root_comment_id and $comment->{id} eq $prev_root_comment_id) { 94 | $prev_root_comment = $comment; 95 | } 96 | 97 | if ($prev_comment_id and $comment->{id} eq $prev_comment_id) { 98 | @comments = splice(@comments, $i + 1); 99 | last; 100 | } 101 | } 102 | 103 | if (defined($prev_root_comment)) { 104 | $prev_root_comment->{_hidden} = 1; 105 | unshift @comments, $prev_root_comment; 106 | } 107 | } 108 | 109 | my %table; 110 | foreach my $comment (@comments) { 111 | my $id = $comment->{id} // "root"; 112 | $table{$id} = $comment; 113 | } 114 | 115 | my @formatted_comments; 116 | foreach my $comment (@comments) { 117 | my $parent = $comment->{parent} // "root"; 118 | 119 | if ($parent ne "root" and exists($table{$parent})) { 120 | push @{$table{$parent}{replies}}, $comment; 121 | } 122 | else { 123 | push @formatted_comments, $comment; 124 | } 125 | } 126 | 127 | my $url = undef; 128 | my $continuation = undef; 129 | 130 | if ($comment_count >= $max_comments) { 131 | $url = 'https://yt-dlp'; 132 | $continuation = join(':', 'ytdlp:comments', $video_id, $page + 1, $last_root_comment_id, $last_comment_id); 133 | } 134 | 135 | scalar { 136 | results => { 137 | comments => \@formatted_comments, 138 | videoId => $video_id, 139 | continuation => $continuation, 140 | }, 141 | url => $url, 142 | }; 143 | } 144 | 145 | =head2 comments_from_videoID($videoID) 146 | 147 | Retrieve comments from a video ID. 148 | 149 | =cut 150 | 151 | sub comments_from_video_id { 152 | my ($self, $video_id) = @_; 153 | 154 | return; # TODO: implement 155 | 156 | if ($self->get_ytdlp_comments) { 157 | my $comments = $self->comments_from_ytdlp($video_id); 158 | defined($comments) and return $comments; 159 | } 160 | 161 | $self->_get_results($self->_make_feed_url("comments/$video_id", sort_by => $self->get_comments_order)); 162 | } 163 | 164 | =head2 comment_to_video_id($comment, $videoID) 165 | 166 | Send a comment to a video ID. 167 | 168 | =cut 169 | 170 | sub comment_to_video_id { 171 | my ($self, $comment, $video_id) = @_; 172 | 173 | my $url = $self->_simple_feeds_url('commentThreads', part => 'snippet'); 174 | 175 | my $hash = { 176 | "snippet" => { 177 | 178 | "topLevelComment" => { 179 | "snippet" => { 180 | "textOriginal" => $comment, 181 | } 182 | }, 183 | "videoId" => $video_id, 184 | 185 | #"channelId" => $channel_id, 186 | }, 187 | }; 188 | 189 | $self->post_as_json($url, $hash); 190 | } 191 | 192 | =head1 AUTHOR 193 | 194 | Trizen, C<< >> 195 | 196 | 197 | =head1 SUPPORT 198 | 199 | You can find documentation for this module with the perldoc command. 200 | 201 | perldoc WWW::LbryViewer::CommentThreads 202 | 203 | 204 | =head1 LICENSE AND COPYRIGHT 205 | 206 | Copyright 2015-2016 Trizen. 207 | 208 | This program is free software; you can redistribute it and/or modify it 209 | under the terms of either: the GNU General Public License as published 210 | by the Free Software Foundation; or the Artistic License. 211 | 212 | See L for more information. 213 | 214 | =cut 215 | 216 | 1; # End of WWW::LbryViewer::CommentThreads 217 | -------------------------------------------------------------------------------- /lib/WWW/LbryViewer/GetCaption.pm: -------------------------------------------------------------------------------- 1 | package WWW::LbryViewer::GetCaption; 2 | 3 | use utf8; 4 | use 5.014; 5 | use warnings; 6 | 7 | =head1 NAME 8 | 9 | WWW::LbryViewer::GetCaption - Save the YouTube closed captions as .srt files for a videoID. 10 | 11 | =head1 SYNOPSIS 12 | 13 | use WWW::LbryViewer::GetCaption; 14 | 15 | my $yv_cap = WWW::LbryViewer::GetCaption->new(%opts); 16 | my $file = $yv_cap->save_caption($videoID); 17 | 18 | =head1 SUBROUTINES/METHODS 19 | 20 | =head2 new(%opts) 21 | 22 | Options: 23 | 24 | =over 4 25 | 26 | =item captions => [] 27 | 28 | The captions data. 29 | 30 | =item captions_dir => "." 31 | 32 | Where to save the closed captions. 33 | 34 | =item languages => [qw(en es ro jp)] 35 | 36 | Preferred languages. First found is saved and returned. 37 | 38 | =back 39 | 40 | =cut 41 | 42 | sub new { 43 | my ($class, %opts) = @_; 44 | 45 | my $self = bless {}, $class; 46 | 47 | $self->{captions_dir} = undef; 48 | $self->{captions} = []; 49 | $self->{auto_captions} = 0; 50 | $self->{languages} = [qw(en es)]; 51 | $self->{yv_obj} = undef; 52 | 53 | foreach my $key (keys %{$self}) { 54 | $self->{$key} = delete $opts{$key} 55 | if exists $opts{$key}; 56 | } 57 | 58 | $self->{yv_obj} //= do { 59 | require WWW::LbryViewer; 60 | WWW::LbryViewer->new(cache_dir => $self->{captions_dir},); 61 | }; 62 | 63 | foreach my $invalid_key (keys %opts) { 64 | warn "Invalid key: '${invalid_key}'"; 65 | } 66 | 67 | return $self; 68 | } 69 | 70 | =head2 find_caption_data() 71 | 72 | Find a caption data, based on the preferred languages. 73 | 74 | =cut 75 | 76 | sub find_caption_data { 77 | my ($self) = @_; 78 | 79 | my @found; 80 | foreach my $caption (@{$self->{captions}}) { 81 | if (defined $caption->{languageCode}) { 82 | foreach my $i (0 .. $#{$self->{languages}}) { 83 | my $lang = $self->{languages}[$i]; 84 | if ($caption->{languageCode} =~ /^\Q$lang\E(?:\z|[_-])/i) { 85 | 86 | # Automatic Speech Recognition 87 | my $auto = defined($caption->{kind}) && lc($caption->{kind}) eq 'asr'; 88 | 89 | # Check against auto-generated captions 90 | if ($auto and not $self->{auto_captions}) { 91 | next; 92 | } 93 | 94 | # Fuzzy match or auto-generated caption 95 | if (lc($caption->{languageCode}) ne lc($lang) or $auto) { 96 | $found[$i + (($auto ? 2 : 1) * scalar(@{$self->{languages}}))] = $caption; 97 | } 98 | 99 | # Perfect match 100 | else { 101 | $i == 0 and return $caption; 102 | $found[$i] = $caption; 103 | } 104 | } 105 | } 106 | } 107 | } 108 | 109 | foreach my $caption (@found) { 110 | return $caption if defined($caption); 111 | } 112 | 113 | return; 114 | } 115 | 116 | =head2 sec2time(@seconds) 117 | 118 | Convert a list of seconds to .srt times. 119 | 120 | =cut 121 | 122 | sub sec2time { 123 | my $self = shift; 124 | 125 | my @out; 126 | foreach my $sec (map { sprintf '%.3f', $_ } @_) { 127 | push @out, sprintf('%02d:%02d:%02d,%03d', ($sec / 3600 % 24, $sec / 60 % 60, $sec % 60, substr($sec, index($sec, '.') + 1))); 128 | } 129 | 130 | return @out; 131 | } 132 | 133 | =head2 xml2srt($xml_string) 134 | 135 | Convert the XML data to SubRip format. 136 | 137 | =cut 138 | 139 | sub xml2srt { 140 | my ($self, $xml) = @_; 141 | 142 | require WWW::LbryViewer::ParseXML; 143 | my $hash = eval { WWW::LbryViewer::ParseXML::xml2hash($xml) } // return; 144 | 145 | my $sections; 146 | if ( exists $hash->{transcript} 147 | and ref($hash->{transcript}) eq 'ARRAY' 148 | and ref($hash->{transcript}[0]) eq 'HASH' 149 | and exists $hash->{transcript}[0]{text}) { 150 | $sections = $hash->{transcript}[0]{text}; 151 | } 152 | else { 153 | return; 154 | } 155 | 156 | require HTML::Entities; 157 | 158 | my @text; 159 | foreach my $i (0 .. $#{$sections}) { 160 | my $line = $sections->[$i]; 161 | 162 | # Determine display duration, when no duration is specified 163 | if (not defined($line->{'-dur'})) { 164 | if (exists $sections->[$i + 1]) { 165 | $line->{'-dur'} = $sections->[$i + 1]{'-start'} - $line->{'-start'}; 166 | } 167 | else { 168 | $line->{'-dur'} = 10; 169 | } 170 | } 171 | 172 | my $start = $line->{'-start'}; 173 | my $end = $start + $line->{'-dur'}; 174 | 175 | # Fix overlapping display time 176 | if (exists $sections->[$i + 1]) { 177 | my $next_start = $sections->[$i + 1]{'-start'}; 178 | if ($end > $next_start) { 179 | $end = $next_start - 0.001; 180 | } 181 | } 182 | 183 | push @text, join("\n", $i + 1, join(' --> ', $self->sec2time($start, $end)), HTML::Entities::decode_entities($line->{'#text'} // '')); 184 | } 185 | 186 | return join("\n\n", @text); 187 | } 188 | 189 | =head2 save_caption($video_ID) 190 | 191 | Save the caption in a .srt file and return its file path. 192 | 193 | =cut 194 | 195 | sub save_caption { 196 | my ($self, $video_id) = @_; 197 | 198 | # Find one of the preferred languages 199 | my $info = $self->find_caption_data() // return; 200 | 201 | require File::Spec; 202 | my $filename = "${video_id}_$info->{languageCode}.srt"; 203 | my $srt_file = File::Spec->catfile($self->{captions_dir} // File::Spec->tmpdir, $filename); 204 | 205 | # Return the srt file if it already exists 206 | return $srt_file if (-e $srt_file); 207 | 208 | # Get XML data, then transform it to SubRip data 209 | my $url = $info->{baseUrl} // return; 210 | my $xml = $self->{yv_obj}->lwp_get($url) // return; 211 | my $srt = $self->xml2srt($xml) // return; 212 | 213 | # Write the SubRib data to the $srt_file 214 | open(my $fh, '>:utf8', $srt_file) or return; 215 | print {$fh} $srt, "\n"; 216 | close $fh; 217 | 218 | # Return the .srt file path 219 | return $srt_file; 220 | } 221 | 222 | =head1 AUTHOR 223 | 224 | Trizen, C<< >> 225 | 226 | 227 | =head1 SUPPORT 228 | 229 | You can find documentation for this module with the perldoc command. 230 | 231 | perldoc WWW::LbryViewer::GetCaption 232 | 233 | 234 | =head1 LICENSE AND COPYRIGHT 235 | 236 | Copyright 2012-2015 Trizen. 237 | 238 | This program is free software; you can redistribute it and/or modify it 239 | under the terms of either: the GNU General Public License as published 240 | by the Free Software Foundation; or the Artistic License. 241 | 242 | See L for more information. 243 | 244 | =cut 245 | 246 | 1; # End of WWW::LbryViewer::GetCaption 247 | -------------------------------------------------------------------------------- /lib/WWW/LbryViewer/Itags.pm: -------------------------------------------------------------------------------- 1 | package WWW::LbryViewer::Itags; 2 | 3 | use utf8; 4 | use 5.014; 5 | use warnings; 6 | 7 | =head1 NAME 8 | 9 | WWW::LbryViewer::Itags - Get the YouTube itags. 10 | 11 | =head1 SYNOPSIS 12 | 13 | use WWW::LbryViewer::Itags; 14 | 15 | my $yv_itags = WWW::LbryViewer::Itags->new(); 16 | 17 | my $itags = $yv_itags->get_itags(); 18 | my $res = $yv_itags->get_resolutions(); 19 | 20 | =head1 SUBROUTINES/METHODS 21 | 22 | =head2 new() 23 | 24 | Return the blessed object. 25 | 26 | =cut 27 | 28 | sub new { 29 | my ($class) = @_; 30 | bless {}, $class; 31 | } 32 | 33 | =head2 get_itags() 34 | 35 | Get a HASH ref with the YouTube itags. {resolution => [itags]}. 36 | 37 | Reference: https://en.wikipedia.org/wiki/YouTube#Quality_and_formats 38 | 39 | =cut 40 | 41 | sub get_itags { 42 | scalar { 43 | 44 | 'best' => [{value => 'b', format => 'mp4'}, {value => 'original', format => 'mp4'},], 45 | 46 | '1080' => [{value => '1080p', format => 'mp4'}, 47 | {value => 'hls-4026', format => 'mp4'}, 48 | {value => 'hls-3660', format => 'mp4'}, 49 | {value => 'hls-316', format => 'mp4'}, 50 | {value => 'hls-4432', format => 'mp4'}, 51 | {value => 'hls-0', format => 'mp4'}, # may not be 1080p 52 | ], 53 | 54 | '720' => [{value => "720p", format => 'mp4'}, 55 | {value => "hls-176", format => 'mp4'}, 56 | {value => "hls-756", format => 'mp4'}, 57 | {value => "hls-246", format => 'mp4'}, 58 | {value => "hls-660", format => 'mp4'}, 59 | {value => "hls-2890", format => 'mp4'}, 60 | {value => "hls-3300", format => 'mp4'}, 61 | {value => "hls-1460", format => 'mp4'}, 62 | {value => "hls-1", format => 'mp4'}, # may not be 720p 63 | ], 64 | 65 | '480' => [{value => "480p", format => 'mp4'}, {value => "hls-1567", format => 'mp4'},], 66 | 67 | '360' => [{value => "360p", format => 'mp4'}, 68 | {value => "hls-140-1", format => 'mp4'}, 69 | {value => "hls-211", format => 'mp4'}, 70 | {value => "hls-105", format => 'mp4'}, 71 | {value => "hls-655", format => 'mp4'}, 72 | {value => "hls-215", format => 'mp4'}, 73 | {value => "hls-525", format => 'mp4'}, 74 | {value => "hls-2", format => 'mp4'}, # may not be 360p 75 | ], 76 | 77 | '240' => [{value => "240p", format => 'mp4'},], 78 | 79 | '144' => [{value => "144p", format => 'mp4'}, 80 | {value => "hls-140-0", format => 'mp4'}, 81 | {value => "hls-140", format => 'mp4'}, 82 | {value => "hls-70", format => 'mp4'}, 83 | {value => "hls-180", format => 'mp4'}, 84 | {value => "hls-250", format => 'mp4'}, 85 | ], 86 | 87 | 'audio' => [], 88 | }; 89 | } 90 | 91 | =head2 get_resolutions() 92 | 93 | Get an ARRAY ref with the supported resolutions ordered from highest to lowest. 94 | 95 | =cut 96 | 97 | sub get_resolutions { 98 | my ($self) = @_; 99 | 100 | state $itags = $self->get_itags(); 101 | return [ 102 | grep { exists $itags->{$_} } 103 | qw( 104 | best 105 | 2160 106 | 1440 107 | 1080 108 | 720 109 | 480 110 | 360 111 | 240 112 | 144 113 | audio 114 | ) 115 | ]; 116 | } 117 | 118 | sub _find_streaming_url { 119 | my ($self, %args) = @_; 120 | 121 | my $stream = $args{stream} // return; 122 | my $resolution = $args{resolution} // return; 123 | 124 | foreach my $itag (@{$args{itags}->{$resolution}}) { 125 | 126 | next if not exists $stream->{$itag->{value}}; 127 | 128 | my $entry = $stream->{$itag->{value}}; 129 | 130 | if (defined($entry->{fps}) and $entry->{fps} >= 50) { 131 | $args{hfr} || next; # skip high frame rate (HFR) videos 132 | } 133 | 134 | if ($itag->{format} eq 'av1') { 135 | $args{ignore_av1} && next; # ignore videos in AV1 format 136 | } 137 | 138 | # Ignored video projections 139 | if (ref($args{ignored_projections}) eq 'ARRAY') { 140 | if (grep { lc($entry->{projectionType} // '') eq lc($_) } @{$args{ignored_projections}}) { 141 | next; 142 | } 143 | } 144 | 145 | if ($itag->{split}) { 146 | 147 | $args{split} || next; 148 | 149 | my $video_info = $stream->{$itag->{value}}; 150 | my $audio_info = $self->_find_streaming_url(%args, resolution => 'audio', split => 0); 151 | 152 | if (defined($audio_info)) { 153 | $video_info->{__AUDIO__} = $audio_info; 154 | return $video_info; 155 | } 156 | 157 | next; 158 | } 159 | 160 | if ($resolution eq 'audio' and $args{prefer_m4a}) { 161 | if ($itag->{format} ne 'm4a') { 162 | next; # skip non-M4A audio URLs 163 | } 164 | } 165 | 166 | # Ignore segmented DASH URLs (they load pretty slow in mpv) 167 | #~ if (not $args{dash}) { 168 | #~ next if ($entry->{url} =~ m{/api/manifest/dash/}); 169 | #~ } 170 | 171 | return $entry; 172 | } 173 | 174 | return; 175 | } 176 | 177 | =head2 find_streaming_url(%options) 178 | 179 | Return the streaming URL which corresponds with the specified resolution. 180 | 181 | ( 182 | urls => \@streaming_urls, 183 | resolution => 'resolution_name', # from $obj->get_resolutions(), 184 | 185 | hfr => 1/0, # include or exclude High Frame Rate videos 186 | ignore_av1 => 1/0, # true to ignore videos in AV1 format 187 | split => 1/0, # include or exclude split videos 188 | m4a_audio => 1/0, # incldue or exclude M4A audio files 189 | ) 190 | 191 | =cut 192 | 193 | sub find_streaming_url { 194 | my ($self, %args) = @_; 195 | 196 | my $urls_array = $args{urls}; 197 | my $resolution = $args{resolution}; 198 | 199 | state $itags = $self->get_itags(); 200 | 201 | if (defined($resolution) and $resolution =~ /^([0-9]+)/) { 202 | $resolution = $1; 203 | } 204 | 205 | my %stream; 206 | foreach my $info_ref (@{$urls_array}) { 207 | if (exists $info_ref->{itag} and exists $info_ref->{url}) { 208 | $stream{$info_ref->{itag}} = $info_ref; 209 | } 210 | 211 | if (exists $info_ref->{resolution} and exists $info_ref->{url}) { 212 | $stream{$info_ref->{resolution}} = $info_ref; 213 | } 214 | } 215 | 216 | # Check if we do recognize all the audio/video formats 217 | foreach my $stream_itag (keys %stream) { 218 | my $found_itag = 0; 219 | foreach my $resolution_itags (values %$itags) { 220 | foreach my $format (@$resolution_itags) { 221 | if ($format->{value} eq $stream_itag) { 222 | $found_itag = 1; 223 | last; 224 | } 225 | } 226 | last if $found_itag; 227 | } 228 | if (not $found_itag) { 229 | say STDERR "[BUG] Itag: $stream_itag is not recognized!"; 230 | require Data::Dump; 231 | Data::Dump::pp($stream{$stream_itag}); 232 | } 233 | } 234 | 235 | $args{stream} = \%stream; 236 | $args{itags} = $itags; 237 | $args{resolution} = $resolution; 238 | 239 | my ($streaming, $found_resolution); 240 | 241 | # Try to find the wanted resolution 242 | if (defined($resolution) and exists $itags->{$resolution}) { 243 | $streaming = $self->_find_streaming_url(%args); 244 | $found_resolution = $resolution; 245 | } 246 | 247 | state $resolutions = $self->get_resolutions(); 248 | 249 | # Find the nearest available resolution 250 | if (defined($resolution) and not defined($streaming)) { 251 | 252 | my $end = $#{$resolutions} - 1; # -1 to ignore 'audio' 253 | 254 | foreach my $i (0 .. $end) { 255 | if ($resolutions->[$i] eq $resolution) { 256 | for (my $k = 1 ; ; ++$k) { 257 | 258 | if ($i + $k > $end and $i - $k < 0) { 259 | last; 260 | } 261 | 262 | if ($i + $k <= $end) { # nearest below 263 | 264 | my $res = $resolutions->[$i + $k]; 265 | $streaming = $self->_find_streaming_url(%args, resolution => $res); 266 | 267 | if (defined($streaming)) { 268 | $found_resolution = $res; 269 | last; 270 | } 271 | } 272 | 273 | if ($i - $k >= 0) { # nearest above 274 | 275 | my $res = $resolutions->[$i - $k]; 276 | $streaming = $self->_find_streaming_url(%args, resolution => $res); 277 | 278 | if (defined($streaming)) { 279 | $found_resolution = $res; 280 | last; 281 | } 282 | } 283 | } 284 | last; 285 | } 286 | } 287 | } 288 | 289 | # Otherwise, find the best resolution available 290 | if (not defined $streaming) { 291 | foreach my $res (@{$resolutions}) { 292 | 293 | $streaming = $self->_find_streaming_url(%args, resolution => $res); 294 | 295 | if (defined($streaming)) { 296 | $found_resolution = $res; 297 | last; 298 | } 299 | } 300 | } 301 | 302 | if (!defined($streaming) and @{$urls_array}) { 303 | say STDERR "[BUG] Unknown video formats:"; 304 | 305 | require Data::Dump; 306 | Data::Dump::pp($urls_array); 307 | 308 | $streaming = $urls_array->[-1]; 309 | $found_resolution = '720'; 310 | } 311 | 312 | wantarray ? ($streaming, $found_resolution) : $streaming; 313 | } 314 | 315 | =head1 AUTHOR 316 | 317 | Trizen, C<< >> 318 | 319 | 320 | =head1 SUPPORT 321 | 322 | You can find documentation for this module with the perldoc command. 323 | 324 | perldoc WWW::LbryViewer::Itags 325 | 326 | 327 | =head1 LICENSE AND COPYRIGHT 328 | 329 | Copyright 2012-2015 Trizen. 330 | 331 | This program is free software; you can redistribute it and/or modify it 332 | under the terms of either: the GNU General Public License as published 333 | by the Free Software Foundation; or the Artistic License. 334 | 335 | See L for more information. 336 | 337 | =cut 338 | 339 | 1; # End of WWW::LbryViewer::Itags 340 | -------------------------------------------------------------------------------- /lib/WWW/LbryViewer/Librarian.pm: -------------------------------------------------------------------------------- 1 | package WWW::LbryViewer::Librarian; 2 | 3 | use utf8; 4 | use 5.014; 5 | use warnings; 6 | 7 | =head1 NAME 8 | 9 | WWW::LbryViewer::Librarian - Extract Librarian data. 10 | 11 | =head1 SYNOPSIS 12 | 13 | use WWW::LbryViewer; 14 | my $obj = WWW::LbryViewer->new(%opts); 15 | 16 | my $results = $obj->lbry_search(q => $keywords); 17 | my $playlists = $obj->lbry_channel_created_playlists($channel_ID); 18 | 19 | =head1 SUBROUTINES/METHODS 20 | 21 | =cut 22 | 23 | sub _time_to_seconds { 24 | my ($time) = @_; 25 | 26 | my ($hours, $minutes, $seconds) = (0, 0, 0); 27 | 28 | if ($time =~ /(\d+):(\d+):(\d+)/) { 29 | ($hours, $minutes, $seconds) = ($1, $2, $3); 30 | } 31 | elsif ($time =~ /(\d+):(\d+)/) { 32 | ($minutes, $seconds) = ($1, $2); 33 | } 34 | elsif ($time =~ /(\d+)/) { 35 | $seconds = $1; 36 | } 37 | 38 | $hours * 3600 + $minutes * 60 + $seconds; 39 | } 40 | 41 | sub _human_number_to_int { 42 | my ($text) = @_; 43 | 44 | $text // return undef; 45 | 46 | # 7.6K -> 7600; 7.6M -> 7600000 47 | if ($text =~ /([\d,.]+)\s*([KMB])/i) { 48 | 49 | my $v = $1; 50 | my $u = $2; 51 | my $m = ($u eq 'K' ? 1e3 : ($u eq 'M' ? 1e6 : ($u eq 'B' ? 1e9 : 1))); 52 | 53 | $v =~ tr/,/./; 54 | 55 | return int($v * $m); 56 | } 57 | 58 | if ($text =~ /([\d,.]+)/) { 59 | my $v = $1; 60 | $v =~ tr/,.//d; 61 | return int($v); 62 | } 63 | 64 | return 0; 65 | } 66 | 67 | sub _thumbnail_quality { 68 | my ($width) = @_; 69 | 70 | $width // return 'medium'; 71 | 72 | if ($width == 1280) { 73 | return "maxres"; 74 | } 75 | 76 | if ($width == 640) { 77 | return "sddefault"; 78 | } 79 | 80 | if ($width == 480) { 81 | return 'high'; 82 | } 83 | 84 | if ($width == 320) { 85 | return 'medium'; 86 | } 87 | 88 | if ($width == 120) { 89 | return 'default'; 90 | } 91 | 92 | if ($width <= 120) { 93 | return 'small'; 94 | } 95 | 96 | if ($width <= 176) { 97 | return 'medium'; 98 | } 99 | 100 | if ($width <= 480) { 101 | return 'high'; 102 | } 103 | 104 | if ($width <= 640) { 105 | return 'sddefault'; 106 | } 107 | 108 | if ($width <= 1280) { 109 | return "maxres"; 110 | } 111 | 112 | return 'medium'; 113 | } 114 | 115 | sub _fix_url_protocol { 116 | my ($self, $url) = @_; 117 | 118 | $url // return undef; 119 | 120 | if ($url =~ m{^https://}) { # ok 121 | return $url; 122 | } 123 | if ($url =~ s{^.*?//}{}) { 124 | return "https://" . $url; 125 | } 126 | if ($url =~ /^\w+\./) { 127 | return "https://" . $url; 128 | } 129 | 130 | if ($url =~ m{^/}) { 131 | return $self->get_librarian_url() . $url; 132 | } 133 | 134 | return $url; 135 | } 136 | 137 | sub _unscramble { 138 | my ($str) = @_; 139 | 140 | my $i = my $l = length($str); 141 | 142 | $str =~ s/(.)(.{$i})/$2$1/sg while (--$i > 0); 143 | $str =~ s/(.)(.{$i})/$2$1/sg while (++$i < $l); 144 | 145 | return $str; 146 | } 147 | 148 | sub _extract_author_name { 149 | my ($info) = @_; 150 | eval { $info->{longBylineText}{runs}[0]{text} } // eval { $info->{shortBylineText}{runs}[0]{text} }; 151 | } 152 | 153 | sub _extract_video_id { 154 | my ($info) = @_; 155 | eval { $info->{videoId} } || eval { $info->{navigationEndpoint}{watchEndpoint}{videoId} } || undef; 156 | } 157 | 158 | sub _extract_length_seconds { 159 | my ($time) = @_; 160 | _time_to_seconds($time); 161 | } 162 | 163 | sub _extract_published_text { 164 | my ($text) = @_; 165 | 166 | if ($text =~ /(\d+)\s+(\w+)/) { 167 | return "$1 $2 ago"; 168 | } 169 | 170 | if ($text =~ /(\d+)\s*(\w+)/) { 171 | return "$1 $2 ago"; 172 | } 173 | 174 | return $text; 175 | } 176 | 177 | sub _extract_published_date { 178 | my ($date) = @_; 179 | 180 | require Encode; 181 | require Time::Piece; 182 | 183 | my $time = eval { Time::Piece->strptime($date, '%B %d, %Y') } // return; 184 | return Encode::decode_utf8($time->strftime('%Y%m%d')); 185 | } 186 | 187 | sub _extract_channel_id { 188 | my ($info) = @_; 189 | eval { $info->{channelId} } 190 | // eval { $info->{shortBylineText}{runs}[0]{navigationEndpoint}{browseEndpoint}{browseId} } 191 | // eval { $info->{navigationEndpoint}{browseEndpoint}{browseId} }; 192 | } 193 | 194 | sub _extract_view_count_text { 195 | my ($info) = @_; 196 | eval { $info->{shortViewCountText}{runs}[0]{text} }; 197 | } 198 | 199 | sub _extract_query_url { 200 | my ($self, $str) = @_; 201 | 202 | my %params = $self->parse_query_string($str); 203 | 204 | if (defined($params{url})) { 205 | 206 | my $url = $params{url}; 207 | 208 | if ($url !~ /^https?:/) { 209 | require MIME::Base64; 210 | $url = MIME::Base64::decode_base64($url); 211 | } 212 | 213 | return $url; 214 | } 215 | 216 | return undef; 217 | } 218 | 219 | sub _extract_thumbnails { 220 | my ($self, $info) = @_; 221 | eval { 222 | [ 223 | map { 224 | my %thumb = %$_; 225 | 226 | $thumb{quality} = _thumbnail_quality($thumb{width}); 227 | $thumb{url} = $thumb{'-src'}; 228 | 229 | if ($thumb{url} =~ /\?(.+)/) { 230 | $thumb{url} = $self->_extract_query_url($1); 231 | } 232 | 233 | $thumb{url} = $self->_fix_url_protocol($thumb{url}); 234 | 235 | \%thumb; 236 | } @{$info} 237 | ] 238 | }; 239 | } 240 | 241 | sub _extract_playlist_thumbnail { 242 | my ($self, $info) = @_; 243 | eval { 244 | $self->_fix_url_protocol( 245 | (grep { _thumbnail_quality($_->{width}) =~ /medium|high/ } @{$info->{thumbnailRenderer}{playlistVideoThumbnailRenderer}{thumbnail}{thumbnails}}) 246 | [0]{url} // $info->{thumbnailRenderer}{playlistVideoThumbnailRenderer}{thumbnail}{thumbnails}[0]{url}); 247 | } // eval { 248 | $self->_fix_url_protocol((grep { _thumbnail_quality($_->{width}) =~ /medium|high/ } @{$info->{thumbnail}{thumbnails}})[0]{url} 249 | // $info->{thumbnail}{thumbnails}[0]{url}); 250 | }; 251 | } 252 | 253 | sub _extract_title { 254 | my ($info) = @_; 255 | eval { $info->{title}{runs}[0]{text} } // eval { $info->{title}{accessibility}{accessibilityData}{label} }; 256 | } 257 | 258 | sub _extract_description { 259 | my ($info) = @_; 260 | 261 | # FIXME: this is not the video description 262 | eval { $info->{title}{accessibility}{accessibilityData}{label} }; 263 | } 264 | 265 | sub _extract_view_count { 266 | my ($text) = @_; 267 | _human_number_to_int($text || 0); 268 | } 269 | 270 | sub _extract_video_count { 271 | my ($text) = @_; 272 | _human_number_to_int($text || 0); 273 | } 274 | 275 | sub _extract_subscriber_count { 276 | my ($text) = @_; 277 | _human_number_to_int($text || 0); 278 | } 279 | 280 | sub _extract_playlist_id { 281 | my ($info) = @_; 282 | eval { $info->{playlistId} }; 283 | } 284 | 285 | sub _extract_itemSection_entry { 286 | my ($self, $data, %args) = @_; 287 | 288 | ref($data) eq 'HASH' or return; 289 | 290 | $args{type} //= 'video'; 291 | 292 | # Video 293 | if ($args{type} eq 'video' and defined($data->{'-class'}) and $data->{'-class'} eq 'video') { 294 | 295 | my %video; 296 | 297 | my $info = $data->{div}; 298 | my $links = $data->{p}; 299 | 300 | my $is_video = 0; 301 | my $published_date = ''; 302 | 303 | foreach my $entry (@{$info}) { 304 | 305 | if (($entry->{'-class'} // '') eq 'thumbnailWrapper' or ($entry->{'-class'} // '') eq 'relVid__thumbnailWrapper') { 306 | my $link = $entry->{a}[0]; 307 | $video{videoId} = (($link->{'-href'} // '') =~ s{^/}{}r); 308 | $video{videoThumbnails} = $self->_extract_thumbnails($link->{img}); 309 | 310 | my $p = $entry->{p}[0]; 311 | if (defined($p->{'#text'})) { 312 | $video{lengthSeconds} = _extract_length_seconds($p->{'#text'}) || 0; 313 | } 314 | } 315 | 316 | if (($entry->{'-class'} // '') eq 'claimMeta' or ($entry->{'-class'} // '') eq 'relVid__meta') { 317 | $is_video = 1; 318 | my $p = $entry->{p}; 319 | $video{publishedText} = _extract_published_text($p->[0]{'#text'}); 320 | $published_date = $p->[0]{'-title'}; 321 | $video{publishDate} = _extract_published_date($p->[0]{'-title'}); 322 | $video{viewCount} = _extract_view_count($p->[1]); 323 | $video{viewCountText} = $p->[1]; 324 | } 325 | } 326 | 327 | $video{title} = $links->[0]{a}[0]{'#text'}; 328 | $video{author} = $links->[1]{a}[0]{'#text'} // $links->[0]{a}[0]{'#text'}; 329 | $video{authorId} = (($links->[1]{a}[0]{'-href'} // $links->[0]{a}[0]{'-href'} // '') =~ s{^/}{}r); 330 | 331 | # Probably it's a channel 332 | if (not $is_video) { 333 | return $self->_extract_itemSection_entry($data, %args, type => 'channel'); 334 | } 335 | 336 | $video{title} // return; 337 | 338 | $video{lengthSeconds} //= 0; 339 | $video{type} //= 'video'; 340 | $video{liveNow} = ($video{lengthSeconds} == 0); # maybe live? 341 | $video{description} = $video{title}; 342 | 343 | return \%video; 344 | } 345 | 346 | # Playlist 347 | if ($args{type} eq 'playlist') { # TODO 348 | 349 | my %playlist; 350 | my $info = $data->{compactPlaylistRenderer}; 351 | 352 | $playlist{type} = 'playlist'; 353 | 354 | $playlist{title} = _extract_title($info) // return; 355 | $playlist{playlistId} = _extract_playlist_id($info) // return; 356 | $playlist{author} = _extract_author_name($info); 357 | $playlist{authorId} = _extract_channel_id($info); 358 | $playlist{videoCount} = _extract_video_count($info); 359 | $playlist{playlistThumbnail} = $self->_extract_playlist_thumbnail($info); 360 | $playlist{description} = _extract_description($info); 361 | 362 | return \%playlist; 363 | } 364 | 365 | # Channel 366 | if ($args{type} eq 'channel') { 367 | 368 | my %channel; 369 | 370 | my $info = $data->{div}; 371 | my $links = $data->{p}; 372 | 373 | foreach my $entry (@{$info}) { 374 | if (($entry->{'-class'} // '') eq 'thumbnailWrapper') { 375 | my $link = $entry->{a}[0]; 376 | $channel{authorId} = (($link->{'-href'} // '') =~ s{^/}{}r); 377 | $channel{authorThumbnails} = $self->_extract_thumbnails($link->{img}); 378 | } 379 | } 380 | 381 | $channel{author} = $links->[0]{a}[0]{'#text'} // $links->[1]{a}[0]{'#text'}; 382 | $channel{authorId} = (($links->[1]{a}[0]{'-href'} // $links->[0]{a}[0]{'-href'} // '') =~ s{^/}{}r); 383 | 384 | if (($links->[2]{'#text'} // '') =~ /([\d,.]+\s*[KMB]?)\s*followers\s*([\d,.]+\s*[KMB]?)\s*uploads/i) { 385 | my ($subs, $uploads) = ($1, $2); 386 | $channel{subCount} = _extract_subscriber_count($subs); 387 | $channel{videoCount} = _extract_video_count($uploads); 388 | } 389 | 390 | $channel{type} = 'channel'; 391 | $channel{title} = $channel{author}; 392 | $channel{description} = $channel{author}; 393 | 394 | return \%channel; 395 | } 396 | 397 | return; 398 | } 399 | 400 | sub _parse_itemSection { 401 | my ($self, $entry, %args) = @_; 402 | 403 | eval { ref($entry->{contents}) eq 'ARRAY' } || return; 404 | 405 | my @results; 406 | 407 | foreach my $entry (@{$entry->{contents}}) { 408 | 409 | my $item = $self->_extract_itemSection_entry($entry, %args); 410 | 411 | if (defined($item) and ref($item) eq 'HASH') { 412 | push @results, $item; 413 | } 414 | } 415 | 416 | if (exists($entry->{continuations}) and ref($entry->{continuations}) eq 'ARRAY') { 417 | 418 | my $token = eval { $entry->{continuations}[0]{nextContinuationData}{continuation} }; 419 | 420 | if (defined($token)) { 421 | push @results, 422 | scalar { 423 | type => 'nextpage', 424 | token => "ytplaylist:$args{type}:$token", 425 | }; 426 | } 427 | } 428 | 429 | return @results; 430 | } 431 | 432 | sub _parse_itemSection_nextpage { 433 | my ($self, $entry, %args) = @_; 434 | 435 | eval { ref($entry->{contents}) eq 'ARRAY' } || return; 436 | 437 | foreach my $entry (@{$entry->{contents}}) { 438 | 439 | # Continuation page 440 | if (exists $entry->{continuationItemRenderer}) { 441 | 442 | my $info = $entry->{continuationItemRenderer}; 443 | my $token = eval { $info->{continuationEndpoint}{continuationCommand}{token} }; 444 | 445 | if (defined($token)) { 446 | return 447 | scalar { 448 | type => 'nextpage', 449 | token => "ytbrowse:$args{type}:$token", 450 | }; 451 | } 452 | } 453 | } 454 | 455 | return; 456 | } 457 | 458 | sub _extract_sectionList_results { 459 | my ($self, $data, %args) = @_; 460 | 461 | $data // return; 462 | ref($data) eq 'HASH' or return; 463 | $data->{contents} // return; 464 | ref($data->{contents}) eq 'ARRAY' or return; 465 | 466 | my @results; 467 | 468 | foreach my $entry (@{$data->{contents}}) { 469 | 470 | # Playlists 471 | if (eval { ref($entry->{shelfRenderer}{content}{verticalListRenderer}{items}) eq 'ARRAY' }) { 472 | my $res = {contents => $entry->{shelfRenderer}{content}{verticalListRenderer}{items}}; 473 | push @results, $self->_parse_itemSection($res, %args); 474 | push @results, $self->_parse_itemSection_nextpage($res, %args); 475 | next; 476 | } 477 | 478 | # Playlist videos 479 | if (eval { ref($entry->{itemSectionRenderer}{contents}[0]{playlistVideoListRenderer}{contents}) eq 'ARRAY' }) { 480 | my $res = $entry->{itemSectionRenderer}{contents}[0]{playlistVideoListRenderer}; 481 | push @results, $self->_parse_itemSection($res, %args); 482 | push @results, $self->_parse_itemSection_nextpage($res, %args); 483 | next; 484 | } 485 | 486 | # Video results 487 | if (exists $entry->{itemSectionRenderer}) { 488 | my $res = $entry->{itemSectionRenderer}; 489 | push @results, $self->_parse_itemSection($res, %args); 490 | push @results, $self->_parse_itemSection_nextpage($res, %args); 491 | } 492 | 493 | # Continuation page 494 | if (exists $entry->{continuationItemRenderer}) { 495 | 496 | my $info = $entry->{continuationItemRenderer}; 497 | my $token = eval { $info->{continuationEndpoint}{continuationCommand}{token} }; 498 | 499 | if (defined($token)) { 500 | push @results, 501 | scalar { 502 | type => 'nextpage', 503 | token => "ytsearch:$args{type}:$token", 504 | }; 505 | } 506 | } 507 | } 508 | 509 | if (@results and exists $data->{continuations}) { 510 | push @results, $self->_parse_itemSection($data, %args); 511 | } 512 | 513 | return @results; 514 | } 515 | 516 | sub _extract_channel_header { 517 | my ($self, $data, %args) = @_; 518 | eval { $data->{header}{c4TabbedHeaderRenderer} } // eval { $data->{metadata}{channelMetadataRenderer} }; 519 | } 520 | 521 | sub _add_author_to_results { 522 | my ($self, $data, $results, %args) = @_; 523 | 524 | my $header = $self->_extract_channel_header($data, %args); 525 | 526 | my $channel_id = eval { $header->{channelId} } // eval { $header->{externalId} }; 527 | my $channel_name = eval { $header->{title} }; 528 | 529 | foreach my $result (@$results) { 530 | if (ref($result) eq 'HASH') { 531 | $result->{author} = $channel_name if defined($channel_name); 532 | $result->{authorId} = $channel_id if defined($channel_id); 533 | } 534 | } 535 | 536 | return 1; 537 | } 538 | 539 | sub _find_sectionList { 540 | my ($self, $data) = @_; 541 | 542 | $data // return undef; 543 | ref($data) eq 'HASH' or return undef; 544 | 545 | if (exists($data->{alerts})) { 546 | if ( 547 | ref($data->{alerts}) eq 'ARRAY' and grep { 548 | eval { $_->{alertRenderer}{type} =~ /error/i } 549 | } @{$data->{alerts}} 550 | ) { 551 | return undef; 552 | } 553 | } 554 | 555 | if (not exists $data->{contents}) { 556 | return undef; 557 | } 558 | 559 | eval { 560 | ( 561 | grep { 562 | eval { exists($_->{tabRenderer}{content}{sectionListRenderer}{contents}) } 563 | } @{$data->{contents}{singleColumnBrowseResultsRenderer}{tabs}} 564 | )[0]{tabRenderer}{content}{sectionListRenderer}; 565 | } // undef; 566 | } 567 | 568 | sub _extract_channel_uploads { 569 | my ($self, $data, %args) = @_; 570 | 571 | my @results = $self->_extract_sectionList_results($self->_find_sectionList($data), %args); 572 | $self->_add_author_to_results($data, \@results, %args); 573 | return @results; 574 | } 575 | 576 | sub _extract_channel_playlists { 577 | my ($self, $data, %args) = @_; 578 | 579 | my @results = $self->_extract_sectionList_results($self->_find_sectionList($data), %args); 580 | $self->_add_author_to_results($data, \@results, %args); 581 | return @results; 582 | } 583 | 584 | sub _extract_playlist_videos { 585 | my ($self, $data, %args) = @_; 586 | 587 | my @results = $self->_extract_sectionList_results($self->_find_sectionList($data), %args); 588 | $self->_add_author_to_results($data, \@results, %args); 589 | return @results; 590 | } 591 | 592 | sub _channel_data { 593 | my ($self, $channel, %args) = @_; 594 | 595 | # TODO: implement 596 | } 597 | 598 | sub _prepare_results_for_return { 599 | my ($self, $results, %args) = @_; 600 | 601 | (defined($results) and ref($results) eq 'ARRAY') || return; 602 | 603 | my @results = @$results; 604 | 605 | @results || return; 606 | 607 | if (@results and $results[-1]{type} eq 'nextpage') { 608 | 609 | my $nextpage = pop(@results); 610 | 611 | if (defined($nextpage->{token}) and @results) { 612 | 613 | if ($self->get_debug) { 614 | say STDERR ":: Returning results with a continuation page token..."; 615 | } 616 | 617 | return { 618 | url => $args{url}, 619 | results => { 620 | entries => \@results, 621 | continuation => $nextpage->{token}, 622 | }, 623 | }; 624 | } 625 | } 626 | 627 | my $url = $args{url}; 628 | 629 | if ($url =~ m{^https://m\.youtube\.com}) { 630 | $url = undef; 631 | } 632 | 633 | return { 634 | url => $url, 635 | results => \@results, 636 | }; 637 | } 638 | 639 | =head2 lbry_video_page(id => $id) 640 | 641 | Get and parse the video page for a given video ID. Returns a HASH structure. 642 | 643 | =cut 644 | 645 | sub lbry_video_page { 646 | my ($self, %args) = @_; 647 | 648 | my $url = $self->get_librarian_url . '/' . $args{id}; 649 | my $hash = $self->_get_librarian_data($url) // return; 650 | 651 | my $info = $hash->{html}[0]{body}[0]; 652 | 653 | return $info; 654 | } 655 | 656 | =head2 lbry_video_page_html(id => $id) 657 | 658 | Get the video page for a given video ID as HTML. 659 | 660 | =cut 661 | 662 | sub lbry_video_page_html { 663 | my ($self, %args) = @_; 664 | 665 | my $url = $self->get_librarian_url . '/' . $args{id}; 666 | my $html = $self->lwp_get($url) // return; 667 | 668 | return $html; 669 | } 670 | 671 | =head2 lbry_video_info(id => $id) 672 | 673 | Get video info for a given video ID. 674 | 675 | =cut 676 | 677 | sub lbry_video_info { 678 | my ($self, %args) = @_; 679 | 680 | my $url = $self->get_librarian_url . '/' . $args{id}; 681 | my $html = $self->lwp_get($url) // return; 682 | my $hash = $self->_parse_html($html) // return; 683 | 684 | # Related videos 685 | my $related_vids_data = $hash->{html}[0]{body}[0]{div}; 686 | 687 | foreach my $key (qw(videoData videoData__left videoData__right relVids)) { 688 | ref($related_vids_data) eq 'ARRAY' or last; 689 | foreach my $entry (@$related_vids_data) { 690 | if (ref($entry) eq 'HASH' and ($entry->{'-class'} // '') eq $key and exists($entry->{div})) { 691 | $related_vids_data = $entry->{'div'}; 692 | last; 693 | } 694 | } 695 | } 696 | 697 | my @related_videos; 698 | if (ref($related_vids_data) eq 'ARRAY') { 699 | foreach my $entry (@$related_vids_data) { 700 | ref($entry) eq 'HASH' or next; 701 | exists($entry->{div}) or next; 702 | $entry->{'-class'} = 'video'; 703 | my $info = $self->_extract_itemSection_entry($entry, type => 'video'); 704 | push @related_videos, $info; 705 | } 706 | } 707 | 708 | my %info = ( 709 | type => 'video', 710 | extra_info => 1, 711 | videoId => $args{id}, 712 | related_videos => \@related_videos, 713 | ); 714 | 715 | # Title 716 | $info{title} = $hash->{html}[0]{head}[0]{title}; 717 | $info{title} =~ s{ - Librarian\z}{}; 718 | 719 | # View count 720 | if ($html =~ m{>visibility\s*

(\d+)

\s*}) { 721 | $info{viewCount} = $1; 722 | } 723 | 724 | # Likes 725 | if ($html =~ m{>thumb_up\s*

(\d+)

\s*}) { 726 | $info{likeCount} = $1; 727 | } 728 | 729 | # Dislikes 730 | if ($html =~ m{>thumb_down\s*

(\d+)

\s*}) { 731 | $info{dislikeCount} = $1; 732 | } 733 | 734 | # Rating 735 | { 736 | my $likes = $info{likeCount} // 0; 737 | my $dislikes = $info{dislikeCount} // 0; 738 | 739 | my $rating = 0; 740 | if ($likes + $dislikes > 0) { 741 | $rating = $likes / ($likes + $dislikes) * 5; 742 | } 743 | $info{rating} = sprintf('%.2f', $rating); 744 | } 745 | 746 | # TODO: extract the duration of the video 747 | #if ($html =~ m{

([\d:]+)

}) { 748 | # $info{lengthSeconds} = _time_to_seconds($1); 749 | #} 750 | 751 | # Thumbnail 752 | if ($html =~ m{}) { 753 | require HTML::Entities; 754 | my $url = HTML::Entities::decode_entities($1); 755 | if ($url =~ /\?(.+)/) { 756 | $url = $self->_extract_query_url($1); 757 | } 758 | $info{videoThumbnails} = [ 759 | scalar { 760 | quality => 'medium', 761 | url => $url, 762 | width => 1280, 763 | height => 720, 764 | } 765 | ]; 766 | } 767 | 768 | # Published date 769 | # FIXME: fails when language is not English 770 | if ($html =~ m{

Shared (.*?)

}) { 771 | $info{publishDate} = _extract_published_date($1); 772 | } 773 | 774 | # Description 775 | if ($html =~ m{
(.*?)
}s) { 776 | require HTML::Entities; 777 | my $desc = $1; 778 | $desc =~ s{

(.*?)

}{ $1 =~ s{
}{\n}gr }sge; # replace
with 1 newline inside

...

779 | $desc =~ s{
}{\n\n}g; # replace
with 2 newlines 780 | $desc =~ s{
}{'-' x 23}ge; # replace
with ---- 781 | $desc =~ s{<.*?>}{}gs; # remove HTML tags 782 | $desc =~ s{(?:\R\s*\R\s*)+}{\n\n}g; # replace 2+ newlines with 2 newlines 783 | $desc =~ s/^\s+//; # remove leading space 784 | $desc =~ s/\s+\z//; # remove trailing space 785 | $info{description} = HTML::Entities::decode_entities($desc); 786 | } 787 | 788 | # Channel name 789 | if ($html =~ m{
\s*\s*

\s*(.*?)}) { 790 | require HTML::Entities; 791 | $info{author} = HTML::Entities::decode_entities($1); 792 | } 793 | 794 | # Claim ID 795 | if ($html =~ m{

(.*?)

}s) { 796 | my $hash = $self->parse_utf8_json_string($1); 797 | $info{author} //= $hash->{channelName}; 798 | $info{authorId} = $hash->{channelName} . ':' . $hash->{channelId}; 799 | $info{channelId} = $hash->{channelId}; 800 | $info{claimId} = $hash->{claimId}; 801 | } 802 | 803 | return \%info; 804 | } 805 | 806 | sub _parse_html { 807 | my ($self, $html, %args) = @_; 808 | 809 | require HTML::TreeBuilder; 810 | 811 | # Workaround for invalid meta tags (occurring in description) 812 | $html =~ s{}{}sg; 813 | 814 | my $tree = HTML::TreeBuilder->new_from_content($html); 815 | my $xml = $tree->as_XML; 816 | 817 | require WWW::LbryViewer::ParseXML; 818 | my $hash = eval { WWW::LbryViewer::ParseXML::xml2hash($xml) } // return; 819 | 820 | return $hash; 821 | } 822 | 823 | sub _extract_search_results { 824 | my ($self, $hash, %args) = @_; 825 | 826 | my $body = $hash->{html}[0]{body}; 827 | my $results = $body->[0]{div}; 828 | 829 | ref($results) eq 'ARRAY' or return; 830 | 831 | # Extract video results from a category 832 | if (eval { ($results->[0]{'-class'} // '') eq 'categoryBar' }) { 833 | shift @$results; 834 | $results = eval { $results->[0]{div} }; 835 | ref($results) eq 'ARRAY' or return; 836 | } 837 | 838 | my @videos; 839 | my @next_page; 840 | 841 | foreach my $entry (@$results) { 842 | 843 | if (exists $entry->{div}) { 844 | foreach my $video (@{$entry->{div}}) { 845 | push @videos, $self->_extract_itemSection_entry($video); 846 | } 847 | } 848 | 849 | #~ if (exists $entry->{'-class'} and $entry->{'-class'} eq 'pageSelector') { 850 | #~ my $a = $entry->{'a'}[-1]; 851 | #~ my $type = $args{type} // 'video'; 852 | #~ push @next_page, 853 | #~ { 854 | #~ type => 'nextpage', 855 | #~ token => sprintf('lbry:search:%s:%s', $type, $self->_fix_url_protocol($a->{'-href'}) // ''), 856 | #~ }; 857 | #~ } 858 | } 859 | 860 | push @videos, @next_page; 861 | 862 | return @videos; 863 | } 864 | 865 | sub _get_librarian_data { 866 | my ($self, $url, %args) = @_; 867 | 868 | my $html = $self->lwp_get($url) // return; 869 | my $hash = $self->_parse_html($html, %args) // return; 870 | 871 | return $hash; 872 | } 873 | 874 | =head2 lbry_search(q => $keyword, %args) 875 | 876 | Search for videos given a keyword string (uri-escaped). 877 | 878 | =cut 879 | 880 | sub lbry_search { 881 | my ($self, %args) = @_; 882 | 883 | my $url = $self->get_librarian_url . "/search"; 884 | 885 | my %params = (q => $args{q}); 886 | 887 | # This does not support caching 888 | # my $content = $self->lwp_post($url, \%params) // return; 889 | # my $hash = $self->_parse_html($content, %args) // return; 890 | 891 | # This supports caching 892 | my $GET_url = $self->_append_url_args($url, %params); 893 | my $hash = $self->_get_librarian_data($GET_url, %args) // return; 894 | 895 | my @results = $self->_extract_search_results($hash, %args); 896 | $self->_prepare_results_for_return(\@results, %args, url => $GET_url); 897 | } 898 | 899 | =head2 lbry_search_from_url($url, %args) 900 | 901 | Returns results, given an URL. 902 | 903 | =cut 904 | 905 | sub lbry_search_from_url { 906 | my ($self, $url, %args) = @_; 907 | 908 | my $hash = $self->_get_librarian_data($url, %args) // return; 909 | my @results = $self->_extract_search_results($hash, %args); 910 | 911 | $self->_prepare_results_for_return(\@results, %args, url => $url); 912 | } 913 | 914 | =head2 lbry_category_videos($category_id, %args) 915 | 916 | Returns videos from a given category ID. 917 | 918 | =cut 919 | 920 | sub lbry_category_videos { 921 | my ($self, $category_id, %args) = @_; 922 | 923 | my $url = $self->_make_feed_url(defined($category_id) ? ('/$/' . $category_id) : ''); 924 | my $hash = $self->_get_librarian_data($url, %args) // return; 925 | 926 | my @results = $self->_extract_search_results($hash, %args); 927 | $self->_prepare_results_for_return(\@results, %args, url => $url); 928 | } 929 | 930 | =head2 lbry_channel_search($channel, q => $keyword, %args) 931 | 932 | Search for videos given a keyword string (uri-escaped) from a given channel ID or username. 933 | 934 | =cut 935 | 936 | sub lbry_channel_search { 937 | my ($self, $channel, %args) = @_; 938 | my ($url, $hash) = $self->_channel_data($channel, %args, type => 'search', params => {query => $args{q}}); 939 | 940 | $hash // return; 941 | 942 | my @results = $self->_extract_sectionList_results($self->_find_sectionList($hash), %args, type => 'video'); 943 | $self->_prepare_results_for_return(\@results, %args, url => $url); 944 | } 945 | 946 | =head2 lbry_channel_uploads($channel, %args) 947 | 948 | Latest uploads for a given channel ID or username. 949 | 950 | =cut 951 | 952 | sub lbry_channel_uploads { 953 | my ($self, $channel, %args) = @_; 954 | 955 | $channel // return; 956 | 957 | my $url = $self->get_librarian_url . "/$channel"; 958 | 959 | my $hash = $self->_get_librarian_data($url, %args) // return; 960 | my @results = $self->_extract_search_results($hash, %args); 961 | 962 | # Sort the results by published date 963 | @results = sort { ($b->{publishDate} // 0) <=> ($a->{publishDate} // 0) } @results; 964 | 965 | # Popular videos (on the current page) 966 | if (defined($args{sort_by}) and $args{sort_by} eq 'popular') { 967 | @results = sort { ($b->{viewCount} // 0) <=> ($a->{viewCount} // 0) } @results; 968 | } 969 | 970 | $self->_prepare_results_for_return(\@results, %args, url => $url); 971 | } 972 | 973 | =head2 lbry_channel_info($channel, %args) 974 | 975 | Channel info (such as title) for a given channel ID or username. 976 | 977 | =cut 978 | 979 | sub lbry_channel_info { 980 | my ($self, $channel, %args) = @_; 981 | my ($url, $hash) = $self->_channel_data($channel, %args, type => ''); 982 | return $hash; 983 | } 984 | 985 | =head2 lbry_channel_title($channel, %args) 986 | 987 | Exact the channel title (as a string) for a given channel ID or username. 988 | 989 | =cut 990 | 991 | sub lbry_channel_title { 992 | my ($self, $channel, %args) = @_; 993 | my ($url, $hash) = $self->_channel_data($channel, %args, type => ''); 994 | $hash // return; 995 | my $header = $self->_extract_channel_header($hash, %args) // return; 996 | my $title = eval { $header->{title} }; 997 | return $title; 998 | } 999 | 1000 | =head2 lbry_channel_id($username, %args) 1001 | 1002 | Exact the channel ID (as a string) for a given channel username. 1003 | 1004 | =cut 1005 | 1006 | sub lbry_channel_id { 1007 | my ($self, $username, %args) = @_; 1008 | my ($url, $hash) = $self->_channel_data($username, %args, type => ''); 1009 | $hash // return; 1010 | my $header = $self->_extract_channel_header($hash, %args) // return; 1011 | my $id = eval { $header->{channelId} } // eval { $header->{externalId} }; 1012 | return $id; 1013 | } 1014 | 1015 | =head2 lbry_channel_created_playlists($channel, %args) 1016 | 1017 | Playlists created by a given channel ID or username. 1018 | 1019 | =cut 1020 | 1021 | sub lbry_channel_created_playlists { 1022 | my ($self, $channel, %args) = @_; 1023 | my ($url, $hash) = $self->_channel_data($channel, %args, type => 'playlists', params => {view => 1}); 1024 | 1025 | $hash // return; 1026 | 1027 | my @results = $self->_extract_channel_playlists($hash, %args, type => 'playlist'); 1028 | $self->_prepare_results_for_return(\@results, %args, url => $url); 1029 | } 1030 | 1031 | =head2 lbry_channel_all_playlists($channel, %args) 1032 | 1033 | All playlists for a given channel ID or username. 1034 | 1035 | =cut 1036 | 1037 | sub lbry_channel_all_playlists { 1038 | my ($self, $channel, %args) = @_; 1039 | my ($url, $hash) = $self->_channel_data($channel, %args, type => 'playlists'); 1040 | 1041 | $hash // return; 1042 | 1043 | my @results = $self->_extract_channel_playlists($hash, %args, type => 'playlist'); 1044 | $self->_prepare_results_for_return(\@results, %args, url => $url); 1045 | } 1046 | 1047 | =head2 lbry_playlist_videos($playlist_id, %args) 1048 | 1049 | Videos from a given playlist ID. 1050 | 1051 | =cut 1052 | 1053 | sub lbry_playlist_videos { 1054 | my ($self, $playlist_id, %args) = @_; 1055 | 1056 | # TODO: implement it 1057 | } 1058 | 1059 | =head2 lbry_playlist_next_page($url, $token, %args) 1060 | 1061 | Load more items from a playlist, given a continuation token. 1062 | 1063 | =cut 1064 | 1065 | sub lbry_playlist_next_page { 1066 | my ($self, $url, $token, %args) = @_; 1067 | 1068 | # TODO: implement it 1069 | } 1070 | 1071 | =head1 AUTHOR 1072 | 1073 | Trizen, C<< >> 1074 | 1075 | 1076 | =head1 SUPPORT 1077 | 1078 | You can find documentation for this module with the perldoc command. 1079 | 1080 | perldoc WWW::LbryViewer::InitialData 1081 | 1082 | 1083 | =head1 LICENSE AND COPYRIGHT 1084 | 1085 | Copyright 2013-2015 Trizen. 1086 | 1087 | This program is free software; you can redistribute it and/or modify it 1088 | under the terms of either: the GNU General Public License as published 1089 | by the Free Software Foundation; or the Artistic License. 1090 | 1091 | See L for more information. 1092 | 1093 | =cut 1094 | 1095 | 1; # End of WWW::LbryViewer::InitialData 1096 | -------------------------------------------------------------------------------- /lib/WWW/LbryViewer/ParseJSON.pm: -------------------------------------------------------------------------------- 1 | package WWW::LbryViewer::ParseJSON; 2 | 3 | use utf8; 4 | use 5.014; 5 | use warnings; 6 | 7 | =head1 NAME 8 | 9 | WWW::LbryViewer::ParseJSON - Parse JSON content. 10 | 11 | =head1 SYNOPSIS 12 | 13 | use WWW::LbryViewer::ParseJSON; 14 | my $obj = WWW::LbryViewer::ParseJSON->new(%opts); 15 | 16 | =head1 SUBROUTINES/METHODS 17 | 18 | =cut 19 | 20 | =head2 parse_json_string($json_string) 21 | 22 | Parse a JSON string and return a HASH ref. 23 | 24 | =cut 25 | 26 | sub parse_utf8_json_string { 27 | my ($self, $json) = @_; 28 | 29 | if (not defined($json) or $json eq '') { 30 | return {}; 31 | } 32 | 33 | require JSON; 34 | my $hash = eval { JSON::from_json($json) }; 35 | return $@ ? do { warn "[JSON]: $@\n"; {} } : $hash; 36 | } 37 | 38 | sub parse_json_string { 39 | my ($self, $json) = @_; 40 | 41 | if (not defined($json) or $json eq '') { 42 | return {}; 43 | } 44 | 45 | require JSON; 46 | my $hash = eval { JSON::decode_json($json) }; 47 | return $@ ? do { warn "[JSON]: $@\n"; {} } : $hash; 48 | } 49 | 50 | =head2 make_json_string($ref) 51 | 52 | Create a JSON string from a HASH or ARRAY ref. 53 | 54 | =cut 55 | 56 | sub make_json_string { 57 | my ($self, $ref) = @_; 58 | 59 | require JSON; 60 | my $str = eval { JSON::encode_json($ref) }; 61 | return $@ ? do { warn "[JSON]: $@\n"; '' } : $str; 62 | } 63 | 64 | =head1 AUTHOR 65 | 66 | Trizen, C<< >> 67 | 68 | 69 | =head1 SUPPORT 70 | 71 | You can find documentation for this module with the perldoc command. 72 | 73 | perldoc WWW::LbryViewer::ParseJSON 74 | 75 | 76 | =head1 LICENSE AND COPYRIGHT 77 | 78 | Copyright 2013-2015 Trizen. 79 | 80 | This program is free software; you can redistribute it and/or modify it 81 | under the terms of either: the GNU General Public License as published 82 | by the Free Software Foundation; or the Artistic License. 83 | 84 | See L for more information. 85 | 86 | =cut 87 | 88 | 1; # End of WWW::LbryViewer::ParseJSON 89 | -------------------------------------------------------------------------------- /lib/WWW/LbryViewer/ParseXML.pm: -------------------------------------------------------------------------------- 1 | package WWW::LbryViewer::ParseXML; 2 | 3 | use utf8; 4 | use 5.014; 5 | use warnings; 6 | 7 | =encoding utf8 8 | 9 | =head1 NAME 10 | 11 | WWW::LbryViewer::ParseXML - Convert XML to a HASH ref structure. 12 | 13 | =head1 SYNOPSIS 14 | 15 | Parse XML content and return an HASH ref structure. 16 | 17 | Usage: 18 | 19 | use WWW::LbryViewer::ParseXML; 20 | my $hash_ref = WWW::LbryViewer::ParseXML::xml2hash($xml_string); 21 | 22 | =head1 SUBROUTINES/METHODS 23 | 24 | =head2 xml2hash($xml_string) 25 | 26 | Parse XML and return an HASH ref. 27 | 28 | =cut 29 | 30 | sub xml2hash { 31 | my $xml = shift(@_) // return; 32 | 33 | $xml = "$xml"; # copy the string 34 | 35 | my $xml_ref = {}; 36 | 37 | my %args = ( 38 | attr => '-', 39 | text => '#text', 40 | empty => q{}, 41 | @_ 42 | ); 43 | 44 | my %ctags; 45 | my $ref = $xml_ref; 46 | 47 | state $inv_chars = q{!"#$@%&'()*+,/;\\<=>?\]\[^`{|}~}; 48 | state $valid_tag = qr{[^\-.\s0-9$inv_chars][^$inv_chars\s]*}; 49 | 50 | { 51 | if ( 52 | $xml =~ m{\G< \s* 53 | ($valid_tag) \s* 54 | ((?>$valid_tag\s*=\s*(?>".*?"|'.*?')|\s+)+)? \s* 55 | (/)?\s*> \s* 56 | }gcsxo 57 | ) { 58 | 59 | my ($tag, $attrs, $closed) = ($1, $2, $3); 60 | 61 | if (defined $attrs) { 62 | push @{$ctags{$tag}}, $ref; 63 | 64 | $ref = 65 | ref $ref eq 'HASH' 66 | ? ref $ref->{$tag} 67 | ? $ref->{$tag} 68 | : ( 69 | defined $ref->{$tag} 70 | ? ($ref->{$tag} = [$ref->{$tag}]) 71 | : ($ref->{$tag} //= []) 72 | ) 73 | : ref $ref eq 'ARRAY' ? ref $ref->[-1]{$tag} 74 | ? $ref->[-1]{$tag} 75 | : ( 76 | defined $ref->[-1]{$tag} 77 | ? ($ref->[-1]{$tag} = [$ref->[-1]{$tag}]) 78 | : ($ref->[-1]{$tag} //= []) 79 | ) 80 | : []; 81 | 82 | ++$#{$ref} if ref $ref eq 'ARRAY'; 83 | 84 | while ( 85 | $attrs =~ m{\G 86 | ($valid_tag) \s*=\s* 87 | (?> 88 | "(.*?)" 89 | | 90 | '(.*?)' 91 | ) \s* 92 | }gsxo 93 | ) { 94 | my ($key, $value) = ($1, $+); 95 | $key = join(q{}, $args{attr}, $key); 96 | if (ref $ref eq 'ARRAY') { 97 | $ref->[-1]{$key} = _decode_entities($value); 98 | } 99 | elsif (ref $ref eq 'HASH') { 100 | $ref->{$key} = $value; 101 | } 102 | } 103 | 104 | if (defined $closed) { 105 | $ref = pop @{$ctags{$tag}}; 106 | } 107 | 108 | if ($xml =~ m{\G<\s*/\s*\Q$tag\E\s*>\s*}gc) { 109 | $ref = pop @{$ctags{$tag}}; 110 | } 111 | elsif ($xml =~ m{\G([^<]+)(?=<)}gsc) { 112 | if (ref $ref eq 'ARRAY') { 113 | $ref->[-1]{$args{text}} .= _decode_entities($1); 114 | $ref = pop @{$ctags{$tag}}; 115 | } 116 | elsif (ref $ref eq 'HASH') { 117 | $ref->{$args{text}} .= $1; 118 | $ref = pop @{$ctags{$tag}}; 119 | } 120 | } 121 | } 122 | elsif (defined $closed) { 123 | if (ref $ref eq 'ARRAY') { 124 | if (exists $ref->[-1]{$tag}) { 125 | if (ref $ref->[-1]{$tag} ne 'ARRAY') { 126 | $ref->[-1]{$tag} = [$ref->[-1]{$tag}]; 127 | } 128 | push @{$ref->[-1]{$tag}}, $args{empty}; 129 | } 130 | else { 131 | $ref->[-1]{$tag} = $args{empty}; 132 | } 133 | } 134 | } 135 | else { 136 | if ($xml =~ /\G(?=<(?!!))/) { 137 | push @{$ctags{$tag}}, $ref; 138 | 139 | $ref = 140 | ref $ref eq 'HASH' 141 | ? ref $ref->{$tag} 142 | ? $ref->{$tag} 143 | : ( 144 | defined $ref->{$tag} 145 | ? ($ref->{$tag} = [$ref->{$tag}]) 146 | : ($ref->{$tag} //= []) 147 | ) 148 | : ref $ref eq 'ARRAY' ? ref $ref->[-1]{$tag} 149 | ? $ref->[-1]{$tag} 150 | : ( 151 | defined $ref->[-1]{$tag} 152 | ? ($ref->[-1]{$tag} = [$ref->[-1]{$tag}]) 153 | : ($ref->[-1]{$tag} //= []) 154 | ) 155 | : []; 156 | 157 | ++$#{$ref} if ref $ref eq 'ARRAY'; 158 | redo; 159 | } 160 | elsif ($xml =~ /\G\s*/gcs or $xml =~ /\G([^<]+)(?=<)/gsc) { 161 | my ($text) = $1; 162 | 163 | if ($xml =~ m{\G<\s*/\s*\Q$tag\E\s*>\s*}gc) { 164 | if (ref $ref eq 'ARRAY') { 165 | if (exists $ref->[-1]{$tag}) { 166 | if (ref $ref->[-1]{$tag} ne 'ARRAY') { 167 | $ref->[-1]{$tag} = [$ref->[-1]{$tag}]; 168 | } 169 | push @{$ref->[-1]{$tag}}, $text; 170 | } 171 | else { 172 | $ref->[-1]{$tag} .= _decode_entities($text); 173 | } 174 | } 175 | elsif (ref $ref eq 'HASH') { 176 | $ref->{$tag} .= $text; 177 | } 178 | } 179 | else { 180 | push @{$ctags{$tag}}, $ref; 181 | 182 | $ref = 183 | ref $ref eq 'HASH' 184 | ? ref $ref->{$tag} 185 | ? $ref->{$tag} 186 | : ( 187 | defined $ref->{$tag} 188 | ? ($ref->{$tag} = [$ref->{$tag}]) 189 | : ($ref->{$tag} //= []) 190 | ) 191 | : ref $ref eq 'ARRAY' ? ref $ref->[-1]{$tag} 192 | ? $ref->[-1]{$tag} 193 | : ( 194 | defined $ref->[-1]{$tag} 195 | ? ($ref->[-1]{$tag} = [$ref->[-1]{$tag}]) 196 | : ($ref->[-1]{$tag} //= []) 197 | ) 198 | : []; 199 | 200 | ++$#{$ref} if ref $ref eq 'ARRAY'; 201 | 202 | if (ref $ref eq 'ARRAY') { 203 | if (exists $ref->[-1]{$tag}) { 204 | if (ref $ref->[-1]{$tag} ne 'ARRAY') { 205 | $ref->[-1] = [$ref->[-1]{$tag}]; 206 | } 207 | push @{$ref->[-1]}, {$args{text} => $text}; 208 | } 209 | else { 210 | $ref->[-1]{$args{text}} .= $text; 211 | } 212 | } 213 | elsif (ref $ref eq 'HASH') { 214 | $ref->{$tag} .= $text; 215 | } 216 | } 217 | } 218 | } 219 | 220 | if ($xml =~ m{\G<\s*/\s*\Q$tag\E\s*>\s*}gc) { 221 | ## tag closed - ok 222 | } 223 | 224 | redo; 225 | } 226 | elsif ($xml =~ m{\G<\s*/\s*($valid_tag)\s*>\s*}gco) { 227 | if (exists $ctags{$1} and @{$ctags{$1}}) { 228 | $ref = pop @{$ctags{$1}}; 229 | } 230 | redo; 231 | } 232 | elsif ($xml =~ /\G\s*/gcs or $xml =~ m{\G([^<]+)(?=<)}gsc) { 233 | if (ref $ref eq 'ARRAY') { 234 | $ref->[-1]{$args{text}} .= $1; 235 | } 236 | elsif (ref $ref eq 'HASH') { 237 | $ref->{$args{text}} .= $1; 238 | } 239 | redo; 240 | } 241 | elsif ($xml =~ /\G<\?/gc) { 242 | $xml =~ /\G.*?\?>\s*/gcs or die "Invalid XML!"; 243 | redo; 244 | } 245 | elsif ($xml =~ /\G\s*/gcs or die "Comment not closed!"; 247 | redo; 248 | } 249 | elsif ($xml =~ /\G$valid_tag|\s+|".*?"|'.*?')*\[.*?\]>\s*/sgco 251 | or $xml =~ /\G.*?>\s*/sgc 252 | or die "DOCTYPE not closed!"; 253 | redo; 254 | } 255 | elsif ($xml =~ /\G\z/gc) { 256 | ## ok 257 | } 258 | elsif ($xml =~ /\G\s+/gc) { 259 | redo; 260 | } 261 | else { 262 | die "Syntax error near: --> ", [split(/\n/, substr($xml, pos($xml), 2**6))]->[0], " <--\n"; 263 | } 264 | } 265 | 266 | return $xml_ref; 267 | } 268 | 269 | { 270 | my %entities = ( 271 | 'amp' => '&', 272 | 'quot' => '"', 273 | 'apos' => "'", 274 | 'gt' => '>', 275 | 'lt' => '<', 276 | ); 277 | 278 | state $ent_re = do { 279 | local $" = '|'; 280 | qr/&(@{[keys %entities]});/; 281 | }; 282 | 283 | sub _decode_entities { 284 | $_[0] =~ s/$ent_re/$entities{$1}/gor; 285 | } 286 | } 287 | 288 | =head1 AUTHOR 289 | 290 | Trizen, C<< >> 291 | 292 | =head1 SUPPORT 293 | 294 | You can find documentation for this module with the perldoc command. 295 | 296 | perldoc WWW::LbryViewer::ParseXML 297 | 298 | 299 | =head1 LICENSE AND COPYRIGHT 300 | 301 | Copyright 2012-2015 Trizen. 302 | 303 | This program is free software; you can redistribute it and/or modify it 304 | under the terms of either: the GNU General Public License as published 305 | by the Free Software Foundation; or the Artistic License. 306 | 307 | See L for more information. 308 | 309 | =cut 310 | 311 | 1; # End of WWW::LbryViewer::ParseXML 312 | -------------------------------------------------------------------------------- /lib/WWW/LbryViewer/PlaylistItems.pm: -------------------------------------------------------------------------------- 1 | package WWW::LbryViewer::PlaylistItems; 2 | 3 | use utf8; 4 | use 5.014; 5 | use warnings; 6 | 7 | =head1 NAME 8 | 9 | WWW::LbryViewer::PlaylistItems - Manage playlist entries. 10 | 11 | =head1 SYNOPSIS 12 | 13 | use WWW::LbryViewer; 14 | my $obj = WWW::LbryViewer->new(%opts); 15 | my $videos = $obj->videos_from_playlistID($playlist_id); 16 | 17 | =head1 SUBROUTINES/METHODS 18 | 19 | =cut 20 | 21 | sub _make_playlistItems_url { 22 | my ($self, %opts) = @_; 23 | return 24 | $self->_make_feed_url( 25 | 'playlistItems', 26 | pageToken => $self->page_token, 27 | %opts 28 | ); 29 | } 30 | 31 | =head2 videos_from_playlist_id($playlist_id) 32 | 33 | Get videos from a specific playlistID. 34 | 35 | =cut 36 | 37 | sub videos_from_playlist_id { 38 | my ($self, $id) = @_; 39 | 40 | if (my $results = $self->yt_playlist_videos($id)) { 41 | return $results; 42 | } 43 | 44 | my $url = $self->_make_feed_url("playlists/$id"); 45 | $self->_get_results($url); 46 | } 47 | 48 | =head2 favorites($channel_id) 49 | 50 | =head2 uploads($channel_id) 51 | 52 | =head2 likes($channel_id) 53 | 54 | Get the favorites, uploads and likes for a given channel ID. 55 | 56 | =cut 57 | 58 | =head2 favorites_from_username($username) 59 | 60 | =head2 uploads_from_username($username) 61 | 62 | =head2 likes_from_username($username) 63 | 64 | Get the favorites, uploads and likes for a given YouTube username. 65 | 66 | =cut 67 | 68 | { 69 | no strict 'refs'; 70 | foreach my $name (qw(favorites uploads likes)) { 71 | 72 | *{__PACKAGE__ . '::' . $name . '_from_username'} = sub { 73 | my ($self, $username) = @_; 74 | $self->videos_from_username($username); 75 | }; 76 | 77 | *{__PACKAGE__ . '::' . $name} = sub { 78 | my ($self, $channel_id) = @_; 79 | $self->videos_from_channel_id($channel_id); 80 | }; 81 | } 82 | } 83 | 84 | =head1 AUTHOR 85 | 86 | Trizen, C<< >> 87 | 88 | 89 | =head1 SUPPORT 90 | 91 | You can find documentation for this module with the perldoc command. 92 | 93 | perldoc WWW::LbryViewer::PlaylistItems 94 | 95 | 96 | =head1 LICENSE AND COPYRIGHT 97 | 98 | Copyright 2013-2015 Trizen. 99 | 100 | This program is free software; you can redistribute it and/or modify it 101 | under the terms of either: the GNU General Public License as published 102 | by the Free Software Foundation; or the Artistic License. 103 | 104 | See L for more information. 105 | 106 | =cut 107 | 108 | 1; # End of WWW::LbryViewer::PlaylistItems 109 | -------------------------------------------------------------------------------- /lib/WWW/LbryViewer/Playlists.pm: -------------------------------------------------------------------------------- 1 | package WWW::LbryViewer::Playlists; 2 | 3 | use utf8; 4 | use 5.014; 5 | use warnings; 6 | 7 | =head1 NAME 8 | 9 | WWW::LbryViewer::Playlists - YouTube playlists related mehods. 10 | 11 | =head1 SYNOPSIS 12 | 13 | use WWW::LbryViewer; 14 | my $obj = WWW::LbryViewer->new(%opts); 15 | my $info = $obj->playlist_from_id($playlist_id); 16 | 17 | =head1 SUBROUTINES/METHODS 18 | 19 | =cut 20 | 21 | sub _make_playlists_url { 22 | my ($self, %opts) = @_; 23 | 24 | if (not exists $opts{'part'}) { 25 | $opts{'part'} = 'snippet,contentDetails'; 26 | } 27 | 28 | $self->_make_feed_url('playlists', %opts,); 29 | } 30 | 31 | sub get_playlist_id { 32 | my ($self, $playlist_name, %fields) = @_; 33 | 34 | my $url = $self->_simple_feeds_url('channels', qw(part contentDetails), %fields); 35 | my $res = $self->_get_results($url); 36 | 37 | ref($res->{results}{items}) eq 'ARRAY' || return; 38 | @{$res->{results}{items}} || return; 39 | 40 | return $res->{results}{items}[0]{contentDetails}{relatedPlaylists}{$playlist_name}; 41 | } 42 | 43 | =head2 playlist_from_id($playlist_id) 44 | 45 | Return info for one or more playlists. 46 | PlaylistIDs can be separated by commas. 47 | 48 | =cut 49 | 50 | sub playlist_from_id { 51 | my ($self, $id, $part) = @_; 52 | $self->_get_results($self->_make_playlists_url(id => $id, part => ($part // 'snippet'))); 53 | } 54 | 55 | =head2 playlists($channel_id) 56 | 57 | Get and return playlists from a channel ID. 58 | 59 | =cut 60 | 61 | sub playlists { 62 | my ($self, $channel_id) = @_; 63 | 64 | if (my $results = $self->yt_channel_created_playlists($channel_id)) { 65 | return $results; 66 | } 67 | 68 | if (my $results = $self->yt_channel_all_playlists($channel_id)) { 69 | return $results; 70 | } 71 | 72 | my $url = $self->_make_feed_url("channels/playlists/$channel_id"); 73 | $self->_get_results($url); 74 | } 75 | 76 | =head2 playlists_from_username($username) 77 | 78 | Get and return the playlists created for a given username. 79 | 80 | =cut 81 | 82 | sub playlists_from_username { 83 | my ($self, $username) = @_; 84 | $self->playlists($username); 85 | } 86 | 87 | =head1 AUTHOR 88 | 89 | Trizen, C<< >> 90 | 91 | 92 | =head1 SUPPORT 93 | 94 | You can find documentation for this module with the perldoc command. 95 | 96 | perldoc WWW::LbryViewer::Playlists 97 | 98 | 99 | =head1 LICENSE AND COPYRIGHT 100 | 101 | Copyright 2013-2015 Trizen. 102 | 103 | This program is free software; you can redistribute it and/or modify it 104 | under the terms of either: the GNU General Public License as published 105 | by the Free Software Foundation; or the Artistic License. 106 | 107 | See L for more information. 108 | 109 | =cut 110 | 111 | 1; # End of WWW::LbryViewer::Playlists 112 | -------------------------------------------------------------------------------- /lib/WWW/LbryViewer/RegularExpressions.pm: -------------------------------------------------------------------------------- 1 | package WWW::LbryViewer::RegularExpressions; 2 | 3 | use utf8; 4 | use 5.014; 5 | use warnings; 6 | 7 | require Exporter; 8 | our @ISA = qw(Exporter); 9 | 10 | =head1 NAME 11 | 12 | WWW::LbryViewer::RegularExpressions - Various utils. 13 | 14 | =head1 SYNOPSIS 15 | 16 | use WWW::LbryViewer::RegularExpressions; 17 | use WWW::LbryViewer::RegularExpressions ($get_video_id_re); 18 | 19 | =cut 20 | 21 | my $opt_begin_chars = q{:;=}; # stdin option valid begin chars 22 | 23 | # Options 24 | our $range_num_re = qr{^([0-9]{1,3}+)(?>-|\.\.)([0-9]{1,3}+)?\z}; 25 | our $digit_or_equal_re = qr/(?(?=[1-9])|=)/; 26 | our $non_digit_or_opt_re = qr{^(?!$range_num_re)(?>[0-9]{1,3}[^0-9]|[0-9]{4}|[^0-9$opt_begin_chars])}; 27 | 28 | # Generic name 29 | our $generic_name_re = qr/[a-zA-Z0-9_.\-\@:]{3,128}/; 30 | our $valid_channel_id_re = qr{(?:^|/)(?\@$generic_name_re)(?:/|\z)}; 31 | 32 | our $get_channel_videos_id_re = qr{^.*/(?:channel|c)/(?(?:[%\w]+(?:[-.]++[%\w]++)*|$generic_name_re))}; 33 | our $get_channel_playlists_id_re = qr{$get_channel_videos_id_re/playlists}; 34 | 35 | our $get_username_videos_re = qr{^.*/user/(?[-.\w]+)}; 36 | our $get_username_playlists_re = qr{$get_username_videos_re/playlists}; 37 | 38 | # Video ID 39 | my $video_id_re = qr{(?>\@(?>[^/]+/[^/]+|[^/]+)|[^/]+[/:][a-f0-9]{40}\b|[^/]+:[a-f0-9]\b)}; 40 | our $valid_video_id_re = qr{^$video_id_re\z}; 41 | our $get_video_id_re = qr{/(?$video_id_re)$}; 42 | 43 | # Playlist ID 44 | our $valid_playlist_id_re = qr{^$generic_name_re\z}; 45 | our $get_playlist_id_re = qr{(?:(?:(?>playlist\?list|view_play_list\?p|list)=)|\w#p/c/)(?$generic_name_re)}; 46 | 47 | our $valid_opt_re = qr{^[$opt_begin_chars]([A-Za-z]++(?:-[A-Za-z]++)?(?>${digit_or_equal_re}.*)?)$}; 48 | 49 | our @EXPORT = qw( 50 | $generic_name_re 51 | $range_num_re 52 | $digit_or_equal_re 53 | $non_digit_or_opt_re 54 | $valid_channel_id_re 55 | $valid_video_id_re 56 | $get_video_id_re 57 | $valid_playlist_id_re 58 | $get_playlist_id_re 59 | $valid_opt_re 60 | $get_channel_videos_id_re 61 | $get_channel_playlists_id_re 62 | $get_username_videos_re 63 | $get_username_playlists_re 64 | ); 65 | 66 | =head1 AUTHOR 67 | 68 | Trizen, C<< >> 69 | 70 | 71 | =head1 SUPPORT 72 | 73 | You can find documentation for this module with the perldoc command. 74 | 75 | perldoc WWW::LbryViewer::RegularExpressions 76 | 77 | 78 | =head1 LICENSE AND COPYRIGHT 79 | 80 | Copyright 2012-2013 Trizen. 81 | 82 | This program is free software; you can redistribute it and/or modify it 83 | under the terms of either: the GNU General Public License as published 84 | by the Free Software Foundation; or the Artistic License. 85 | 86 | See L for more information. 87 | 88 | =cut 89 | 90 | 1; # End of WWW::LbryViewer::RegularExpressions 91 | -------------------------------------------------------------------------------- /lib/WWW/LbryViewer/Search.pm: -------------------------------------------------------------------------------- 1 | package WWW::LbryViewer::Search; 2 | 3 | use utf8; 4 | use 5.014; 5 | use warnings; 6 | 7 | =head1 NAME 8 | 9 | WWW::LbryViewer::Search - Search for stuff on YouTube 10 | 11 | =head1 SYNOPSIS 12 | 13 | use WWW::LbryViewer; 14 | my $obj = WWW::LbryViewer->new(%opts); 15 | $obj->search_videos(@keywords); 16 | 17 | =head1 SUBROUTINES/METHODS 18 | 19 | =cut 20 | 21 | sub _make_search_url { 22 | my ($self, %opts) = @_; 23 | 24 | my @features; 25 | 26 | if (defined(my $vd = $self->get_videoDefinition)) { 27 | if ($vd eq 'high') { 28 | push @features, 'hd'; 29 | } 30 | } 31 | 32 | if (defined(my $vc = $self->get_videoCaption)) { 33 | if ($vc eq 'true' or $vc eq '1') { 34 | push @features, 'subtitles'; 35 | } 36 | } 37 | 38 | if (defined(my $vd = $self->get_videoDimension)) { 39 | if ($vd eq '3d') { 40 | push @features, '3d'; 41 | } 42 | } 43 | 44 | if (defined(my $license = $self->get_videoLicense)) { 45 | if ($license eq 'creative_commons') { 46 | push @features, 'creative_commons'; 47 | } 48 | } 49 | 50 | return $self->_make_feed_url( 51 | 'search', 52 | 53 | region => $self->get_region, 54 | sort_by => $self->get_order, 55 | date => $self->get_date, 56 | page => $self->page_token, 57 | duration => $self->get_videoDuration, 58 | 59 | (@features ? (features => join(',', @features)) : ()), 60 | 61 | %opts, 62 | ); 63 | } 64 | 65 | =head2 search_for($types,$keywords;\%args) 66 | 67 | Search for a list of types (comma-separated). 68 | 69 | =cut 70 | 71 | sub search_for { 72 | my ($self, $type, $keywords, $args) = @_; 73 | 74 | if (ref($args) ne 'HASH') { 75 | $args = {}; 76 | } 77 | 78 | $keywords //= []; 79 | 80 | if (ref($keywords) ne 'ARRAY') { 81 | $keywords = [split ' ', $keywords]; 82 | } 83 | 84 | $keywords = $self->escape_string(join(' ', @{$keywords})); 85 | 86 | # Search in a channel's videos 87 | if (defined(my $channel_id = $self->get_channelId)) { 88 | 89 | $self->set_channelId(); # clear the channel ID 90 | 91 | if (my $results = $self->yt_channel_search($channel_id, q => $keywords, type => $type, %$args)) { 92 | return $results; 93 | } 94 | 95 | my $url = $self->_make_feed_url("channels/search/$channel_id", q => $keywords); 96 | return $self->_get_results($url); 97 | } 98 | 99 | if (my $results = $self->lbry_search(q => $keywords, type => $type, %$args)) { 100 | return $results; 101 | } 102 | 103 | return {}; 104 | } 105 | 106 | { 107 | no strict 'refs'; 108 | 109 | foreach my $pair ( 110 | { 111 | name => 'videos', 112 | type => 'video', 113 | }, 114 | { 115 | name => 'playlists', 116 | type => 'playlist', 117 | }, 118 | { 119 | name => 'channels', 120 | type => 'channel', 121 | }, 122 | { 123 | name => 'all', 124 | type => 'all', 125 | } 126 | ) { 127 | *{__PACKAGE__ . '::' . "search_$pair->{name}"} = sub { 128 | my $self = shift; 129 | $self->search_for($pair->{type}, @_); 130 | }; 131 | } 132 | } 133 | 134 | =head2 search_videos($keywords;\%args) 135 | 136 | Search and return the found video results. 137 | 138 | =cut 139 | 140 | =head2 search_playlists($keywords;\%args) 141 | 142 | Search and return the found playlists. 143 | 144 | =cut 145 | 146 | =head2 search_channels($keywords;\%args) 147 | 148 | Search and return the found channels. 149 | 150 | =cut 151 | 152 | =head2 search_all($keywords;\%args) 153 | 154 | Search and return the results. 155 | 156 | =cut 157 | 158 | =head2 related_to_videoID($id) 159 | 160 | Retrieves a list of videos that are related to the video ID. 161 | 162 | =cut 163 | 164 | sub related_to_videoID { 165 | my ($self, $videoID) = @_; 166 | 167 | my $info = $self->lbry_video_info(id => $videoID); 168 | my $related_videos = $info->{related_videos} // []; 169 | 170 | return 171 | scalar { 172 | url => undef, 173 | results => $related_videos, 174 | }; 175 | } 176 | 177 | =head1 AUTHOR 178 | 179 | Trizen, C<< >> 180 | 181 | 182 | =head1 SUPPORT 183 | 184 | You can find documentation for this module with the perldoc command. 185 | 186 | perldoc WWW::LbryViewer::Search 187 | 188 | 189 | =head1 LICENSE AND COPYRIGHT 190 | 191 | Copyright 2013-2015 Trizen. 192 | 193 | This program is free software; you can redistribute it and/or modify it 194 | under the terms of either: the GNU General Public License as published 195 | by the Free Software Foundation; or the Artistic License. 196 | 197 | See L for more information. 198 | 199 | =cut 200 | 201 | 1; # End of WWW::LbryViewer::Search 202 | -------------------------------------------------------------------------------- /lib/WWW/LbryViewer/Utils.pm: -------------------------------------------------------------------------------- 1 | package WWW::LbryViewer::Utils; 2 | 3 | use utf8; 4 | use 5.014; 5 | use warnings; 6 | 7 | =head1 NAME 8 | 9 | WWW::LbryViewer::Utils - Various utils. 10 | 11 | =head1 SYNOPSIS 12 | 13 | use WWW::LbryViewer::Utils; 14 | 15 | my $yv_utils = WWW::LbryViewer::Utils->new(%opts); 16 | 17 | print $yv_utils->format_time(3600); 18 | 19 | =head1 SUBROUTINES/METHODS 20 | 21 | =head2 new(%opts) 22 | 23 | Options: 24 | 25 | =over 4 26 | 27 | =item thousand_separator => "" 28 | 29 | Character used as thousand separator. 30 | 31 | =item months => [] 32 | 33 | Month names for I 34 | 35 | =item lbry_url_format => "" 36 | 37 | A youtube URL format for sprintf(format, videoID). 38 | 39 | =back 40 | 41 | =cut 42 | 43 | sub new { 44 | my ($class, %opts) = @_; 45 | 46 | my $self = bless { 47 | thousand_separator => q{,}, 48 | lbry_url_format => 'https://open.lbry.com/%s', 49 | }, $class; 50 | 51 | $self->{months} = [ 52 | qw( 53 | Jan Feb Mar 54 | Apr May Jun 55 | Jul Aug Sep 56 | Oct Nov Dec 57 | ) 58 | ]; 59 | 60 | foreach my $key (keys %{$self}) { 61 | $self->{$key} = delete $opts{$key} 62 | if exists $opts{$key}; 63 | } 64 | 65 | foreach my $invalid_key (keys %opts) { 66 | warn "Invalid key: '${invalid_key}'"; 67 | } 68 | 69 | return $self; 70 | } 71 | 72 | =head2 extension($type) 73 | 74 | Returns the extension format from a given type. 75 | 76 | From a string like 'video/webm;+codecs="vp9"', it returns 'webm'. 77 | 78 | =cut 79 | 80 | sub extension { 81 | my ($self, $type) = @_; 82 | 83 | $type //= ''; 84 | 85 | $type =~ /\bflv\b/i ? q{flv} 86 | : $type =~ /\bopus\b/i ? q{opus} 87 | : $type =~ /\b3gpp?\b/i ? q{3gp} 88 | : $type =~ m{^video/(\w+)} ? $1 89 | : $type =~ m{^audio/(\w+)} ? $1 90 | : $type =~ /\bwebm\b/i ? q{webm} 91 | : q{mp4}; 92 | } 93 | 94 | =head2 format_time($sec) 95 | 96 | Returns time from seconds. 97 | 98 | =cut 99 | 100 | sub format_time { 101 | my ($self, $sec) = @_; 102 | 103 | $sec //= 0; 104 | 105 | $sec >= 3600 106 | ? join q{:}, map { sprintf '%02d', $_ } $sec / 3600 % 24, $sec / 60 % 60, $sec % 60 107 | : join q{:}, map { sprintf '%02d', $_ } $sec / 60 % 60, $sec % 60; 108 | } 109 | 110 | =head2 format_duration($duration) 111 | 112 | Return seconds from duration (PT1H20M10S). 113 | 114 | =cut 115 | 116 | # PT5M3S -> 05:03 117 | # PT1H20M10S -> 01:20:10 118 | # PT16S -> 00:16 119 | 120 | sub format_duration { 121 | my ($self, $duration) = @_; 122 | 123 | $duration // return 0; 124 | my ($hour, $min, $sec) = (0, 0, 0); 125 | 126 | $hour = $1 if ($duration =~ /(\d+)H/); 127 | $min = $1 if ($duration =~ /(\d+)M/); 128 | $sec = $1 if ($duration =~ /(\d+)S/); 129 | 130 | $hour * 60 * 60 + $min * 60 + $sec; 131 | } 132 | 133 | =head2 format_date($date) 134 | 135 | Return string "04 May 2010" from "2010-05-04T00:25:55.000Z" 136 | 137 | =cut 138 | 139 | sub format_date { 140 | my ($self, $date) = @_; 141 | 142 | $date // return undef; 143 | 144 | # 2010-05-04T00:25:55.000Z 145 | # to: 04 May 2010 146 | 147 | $date =~ s{^ 148 | (?\d{4}) 149 | - 150 | (?\d{2}) 151 | - 152 | (?\d{2}) 153 | .* 154 | } 155 | {$+{day} $self->{months}[$+{month} - 1] $+{year}}x; 156 | 157 | return $date; 158 | } 159 | 160 | =head2 date_to_age($date) 161 | 162 | Return the (approximated) age for a given date of the form "2010-05-04T00:25:55.000Z". 163 | 164 | =cut 165 | 166 | sub date_to_age { 167 | my ($self, $date) = @_; 168 | 169 | $date // return undef; 170 | 171 | $date =~ m{^ 172 | (?\d{4}) 173 | - 174 | (?\d{2}) 175 | - 176 | (?\d{2}) 177 | [a-zA-Z] 178 | (?\d{2}) 179 | : 180 | (?\d{2}) 181 | : 182 | (?\d{2}) 183 | }x || return undef; 184 | 185 | my ($sec, $min, $hour, $day, $month, $year) = gmtime(time); 186 | 187 | $year += 1900; 188 | $month += 1; 189 | 190 | my %month_days = ( 191 | 1 => 31, 192 | 2 => 28, 193 | 3 => 31, 194 | 4 => 30, 195 | 5 => 31, 196 | 6 => 30, 197 | 7 => 31, 198 | 8 => 31, 199 | 9 => 30, 200 | 10 => 31, 201 | 11 => 30, 202 | 12 => 31, 203 | ); 204 | 205 | my $lambda = sub { 206 | 207 | if ($year == $+{year}) { 208 | if ($month == $+{month}) { 209 | if ($day == $+{day}) { 210 | if ($hour == $+{hour}) { 211 | if ($min == $+{min}) { 212 | return join(' ', $sec - $+{sec}, 'seconds'); 213 | } 214 | return join(' ', $min - $+{min}, 'minutes'); 215 | } 216 | return join(' ', $hour - $+{hour}, 'hours'); 217 | } 218 | return join(' ', $day - $+{day}, 'days'); 219 | } 220 | 221 | if ($month - $+{month} == 1) { 222 | my $day_diff = $+{day} - $day; 223 | if ($day_diff > 0 and $day_diff < $month_days{$+{month} + 0}) { 224 | return join(' ', $month_days{$+{month} + 0} - $day_diff, 'days'); 225 | } 226 | } 227 | 228 | return join(' ', $month - $+{month}, 'months'); 229 | } 230 | 231 | if ($year - $+{year} == 1) { 232 | my $month_diff = $+{month} - $month; 233 | if ($month_diff > 0) { 234 | return join(' ', 12 - $month_diff, 'months'); 235 | } 236 | } 237 | 238 | return join(' ', $year - $+{year}, 'years'); 239 | }; 240 | 241 | my $age = $lambda->(); 242 | 243 | if ($age =~ /^1\s/) { # singular mode 244 | $age =~ s/s\z//; 245 | } 246 | 247 | return $age; 248 | } 249 | 250 | =head2 has_entries($result) 251 | 252 | Returns true if a given result has entries. 253 | 254 | =cut 255 | 256 | sub has_entries { 257 | my ($self, $result) = @_; 258 | 259 | $result // return 0; 260 | 261 | ref($result) eq 'HASH' or return; 262 | 263 | if (ref($result->{results}) eq 'HASH') { 264 | ref($result->{results}{entries}) eq 'ARRAY' or return; 265 | return (scalar(@{$result->{results}{entries}}) > 0); 266 | } 267 | 268 | ref($result->{results}) eq 'ARRAY' or return; 269 | return (scalar(@{$result->{results}}) > 0); 270 | } 271 | 272 | =head2 normalize_filename($title, $fat32safe) 273 | 274 | Replace file-unsafe characters and trim spaces. 275 | 276 | =cut 277 | 278 | sub normalize_filename { 279 | my ($self, $title, $fat32safe) = @_; 280 | 281 | state $unix_like = $^O =~ /^(?:linux|freebsd|openbsd)\z/i; 282 | 283 | if (not $fat32safe and not $unix_like) { 284 | $fat32safe = 1; 285 | } 286 | 287 | if ($fat32safe) { 288 | 289 | state $has_unidecode = eval { require Text::Unidecode; 1 }; 290 | 291 | if ($has_unidecode) { 292 | $title = Text::Unidecode::unidecode($title); 293 | } 294 | 295 | $title =~ s/: / - /g; 296 | $title =~ tr{:"*/?\\|}{;'+%!%%}; # " 297 | $title =~ tr/<>//d; 298 | $title =~ s{%+}{%}g; 299 | } 300 | else { 301 | $title =~ s{/+}{%}g; 302 | } 303 | 304 | my $basename = join(q{ }, split(q{ }, $title)); 305 | $basename = substr($basename, 0, 128); # make sure the filename is not too long 306 | return $basename; 307 | } 308 | 309 | =head2 format_text(%opt) 310 | 311 | Formats a text with information from streaming and video info. 312 | 313 | The structure of C<%opt> is: 314 | 315 | ( 316 | streaming => HASH, 317 | info => HASH, 318 | text => STRING, 319 | escape => BOOL, 320 | fat32safe => BOOL, 321 | ) 322 | 323 | =cut 324 | 325 | sub format_text { 326 | my ($self, %opt) = @_; 327 | 328 | my $streaming = $opt{streaming}; 329 | my $info = $opt{info}; 330 | my $text = $opt{text}; 331 | my $escape = $opt{escape}; 332 | my $fat32safe = $opt{fat32safe}; 333 | 334 | my %special_tokens = ( 335 | ID => sub { $self->get_video_id($info) }, 336 | AUTHOR => sub { $self->get_channel_title($info) }, 337 | CHANNELID => sub { $self->get_channel_id($info) }, 338 | DEFINITION => sub { $self->get_definition($info) }, 339 | DIMENSION => sub { $self->get_dimension($info) }, 340 | 341 | VIEWS => sub { $self->get_views($info) }, 342 | VIEWS_SHORT => sub { $self->get_views_approx($info) }, 343 | 344 | VIDEOS => sub { $self->set_thousands($self->get_channel_video_count($info)) }, 345 | VIDEOS_SHORT => sub { $self->short_human_number($self->get_channel_video_count($info)) }, 346 | 347 | SUBS => sub { $self->get_channel_subscriber_count($info) }, 348 | SUBS_SHORT => sub { $self->short_human_number($self->get_channel_subscriber_count($info)) }, 349 | 350 | ITEMS => sub { $self->set_thousands($self->get_playlist_item_count($info)) }, 351 | ITEMS_SHORT => sub { $self->short_human_number($self->get_playlist_item_count($info)) }, 352 | 353 | LIKES => sub { $self->get_likes($info) }, 354 | DISLIKES => sub { $self->get_dislikes($info) }, 355 | 356 | COMMENTS => sub { $self->get_comments($info) }, 357 | DURATION => sub { $self->get_duration($info) }, 358 | TIME => sub { $self->get_time($info) }, 359 | TITLE => sub { $self->get_title($info) }, 360 | FTITLE => sub { $self->normalize_filename($self->get_title($info), $fat32safe) }, 361 | CAPTION => sub { $self->get_caption($info) }, 362 | PUBLISHED => sub { $self->get_publication_date($info) }, 363 | AGE => sub { $self->get_publication_age($info) }, 364 | AGE_SHORT => sub { $self->get_publication_age_approx($info) }, 365 | DESCRIPTION => sub { $self->get_description($info) }, 366 | 367 | RATING => sub { 368 | my $likes = $self->get_likes($info) // 0; 369 | my $dislikes = $self->get_dislikes($info) // 0; 370 | 371 | my $rating = 0; 372 | if ($likes + $dislikes > 0) { 373 | $rating = $likes / ($likes + $dislikes) * 5; 374 | } 375 | 376 | sprintf('%.2f', $rating); 377 | }, 378 | 379 | ( 380 | defined($streaming) 381 | ? ( 382 | RESOLUTION => sub { $streaming->{resolution} }, 383 | ITAG => sub { $streaming->{streaming}{itag} }, 384 | SUB => sub { $streaming->{srt_file} }, 385 | VIDEO => sub { $streaming->{streaming}{url} }, 386 | FORMAT => sub { $self->extension($streaming->{streaming}{type}) }, 387 | 388 | AUDIO => sub { 389 | ref($streaming->{streaming}{__AUDIO__}) eq 'HASH' 390 | ? $streaming->{streaming}{__AUDIO__}{url} 391 | : q{}; 392 | }, 393 | 394 | AOV => sub { 395 | ref($streaming->{streaming}{__AUDIO__}) eq 'HASH' 396 | ? $streaming->{streaming}{__AUDIO__}{url} 397 | : $streaming->{streaming}{url}; 398 | }, 399 | ) 400 | : () 401 | ), 402 | 403 | URL => sub { sprintf($self->{lbry_url_format}, $self->get_video_id($info)) }, 404 | ); 405 | 406 | my $tokens_re = do { 407 | local $" = '|'; 408 | qr/\*(@{[keys %special_tokens]})\*/; 409 | }; 410 | 411 | my %special_escapes = ( 412 | a => "\a", 413 | b => "\b", 414 | e => "\e", 415 | f => "\f", 416 | n => "\n", 417 | r => "\r", 418 | t => "\t", 419 | ); 420 | 421 | my $escapes_re = do { 422 | local $" = q{}; 423 | qr/\\([@{[keys %special_escapes]}])/; 424 | }; 425 | 426 | $text =~ s/$escapes_re/$special_escapes{$1}/g; 427 | 428 | $escape 429 | ? $text =~ s<$tokens_re><\Q${\($special_tokens{$1}() // '')}\E>gr 430 | : $text =~ s<$tokens_re><${\($special_tokens{$1}() // '')}>gr; 431 | } 432 | 433 | =head2 set_thousands($num) 434 | 435 | Return the number with thousand separators. 436 | 437 | =cut 438 | 439 | sub set_thousands { # ugly, but fast 440 | my ($self, $n) = @_; 441 | 442 | return 0 unless $n; 443 | 444 | if ($n =~ /[KMB]/) { # human-readable number 445 | return $n; 446 | } 447 | 448 | length($n) > 3 or return $n; 449 | 450 | my $l = length($n) - 3; 451 | my $i = ($l - 1) % 3 + 1; 452 | my $x = substr($n, 0, $i) . $self->{thousand_separator}; 453 | 454 | while ($i < $l) { 455 | $x .= substr($n, $i, 3) . $self->{thousand_separator}; 456 | $i += 3; 457 | } 458 | 459 | return $x . substr($n, $i); 460 | } 461 | 462 | =head2 get_video_id($info) 463 | 464 | Get videoID. 465 | 466 | =cut 467 | 468 | sub get_video_id { 469 | my ($self, $info) = @_; 470 | $info->{videoId}; 471 | } 472 | 473 | sub get_playlist_id { 474 | my ($self, $info) = @_; 475 | $info->{playlistId}; 476 | } 477 | 478 | sub get_playlist_video_count { 479 | my ($self, $info) = @_; 480 | $info->{videoCount}; 481 | } 482 | 483 | =head2 get_description($info) 484 | 485 | Get description. 486 | 487 | =cut 488 | 489 | sub get_description { 490 | my ($self, $info) = @_; 491 | 492 | my $desc = $info->{descriptionHtml} // $info->{description} // ''; 493 | 494 | require URI::Escape; 495 | require HTML::Entities; 496 | 497 | # Decode external links 498 | $desc =~ s{.*?}{ 499 | my $url = $1; 500 | if ($url =~ /(?:^|;)q=([^&]+)/) { 501 | URI::Escape::uri_unescape($1); 502 | } 503 | else { 504 | $url; 505 | } 506 | }segi; 507 | 508 | # Decode hashtags 509 | $desc =~ s{(.*?)}{$1}sgi; 510 | 511 | # Decode internal links to videos / playlists 512 | $desc =~ s{(https://www\.youtube\.com)/watch\?.*?}{ 513 | my $url = $2; 514 | my $params = URI::Escape::uri_unescape($1); 515 | "$url/$params"; 516 | }segi; 517 | 518 | # Decode internal youtu.be links 519 | $desc =~ s{(https://youtu\.be)/.*?}{ 520 | my $url = $2; 521 | my $params = URI::Escape::uri_unescape($1); 522 | "$url/$params"; 523 | }segi; 524 | 525 | # Decode other internal links 526 | $desc =~ s{.*?}{https://youtube.com/$1}sgi; 527 | 528 | $desc =~ s{
}{\n}gi; 529 | $desc =~ s{.*?}{$1}sgi; 530 | $desc =~ s/<.*?>//gs; 531 | 532 | $desc = HTML::Entities::decode_entities($desc); 533 | $desc =~ s/^\s+//; 534 | 535 | if (not $desc =~ /\S/ or length($desc) < length($info->{description} // '')) { 536 | $desc = $info->{description} // ''; 537 | } 538 | 539 | ($desc =~ /\S/) ? $desc : 'No description available...'; 540 | } 541 | 542 | sub read_lines_from_file { 543 | my ($self, $file, $mode) = @_; 544 | 545 | $mode //= '<'; 546 | 547 | open(my $fh, $mode, $file) or return; 548 | chomp(my @lines = <$fh>); 549 | close $fh; 550 | 551 | my %seen; 552 | 553 | # Keep the most recent ones 554 | @lines = reverse(@lines); 555 | @lines = grep { !$seen{$_}++ } @lines; 556 | 557 | return @lines; 558 | } 559 | 560 | sub default_channels { 561 | my ($self) = @_; 562 | 563 | my %channels = ( 564 | '@ComputingForever:9' => 'Computing Forever', 565 | '@veritasium:f' => 'Veritasium', 566 | '@3Blue1Brown:b' => '3Blue1Brown', 567 | '@DistroTube:2' => 'DistroTube', 568 | '@AlphaNerd:8' => 'Mental Outlaw', 569 | '@techlore:3' => 'Techlore', 570 | '@RobBraxmanTech:6' => 'Rob Braxman Tech', 571 | '@gotbletu' => 'gotbletu', 572 | '@academyofideas' => 'Academy of Ideas', 573 | ); 574 | 575 | my @channels = map { [$_, $channels{$_}] } keys %channels; 576 | 577 | # Sort channels by channel name 578 | @channels = sort { CORE::fc($a->[1]) cmp CORE::fc($b->[1]) } @channels; 579 | 580 | return @channels; 581 | } 582 | 583 | sub read_channels_from_file { 584 | my ($self, $file, $mode) = @_; 585 | 586 | $mode //= '<:utf8'; 587 | 588 | # Read channels and remove duplicates 589 | my %channels = map { split(/ /, $_, 2) } grep { not /^#/ } grep { /\S\s+\S/ } $self->read_lines_from_file($file, $mode); 590 | 591 | # Filter valid channels and pair with channel ID with title 592 | my @channels = map { [$_, $channels{$_} =~ s/^\@//r] } grep { defined($channels{$_}) } keys %channels; 593 | 594 | # Sort channels by channel name 595 | @channels = sort { CORE::fc($a->[1]) cmp CORE::fc($b->[1]) } @channels; 596 | 597 | return @channels; 598 | } 599 | 600 | sub get_local_playlist_filenames { 601 | my ($self, $dir) = @_; 602 | require Encode; 603 | grep { -f $_ } sort { CORE::fc($a) cmp CORE::fc($b) } map { Encode::decode_utf8($_) } glob("$dir/*.dat"); 604 | } 605 | 606 | sub make_local_playlist_filename { 607 | my ($self, $title, $playlistID) = @_; 608 | my $basename = $title . ' -- ' . $playlistID . '.txt'; 609 | $basename = $self->normalize_filename($basename); 610 | return $basename; 611 | } 612 | 613 | sub local_playlist_snippet { 614 | my ($self, $id) = @_; 615 | 616 | require File::Basename; 617 | my $title = File::Basename::basename($id); 618 | 619 | $title =~ s/\.dat\z//; 620 | $title =~ s/ -- PL[-\w]+\z//; 621 | $title =~ s/_/ /g; 622 | $title = ucfirst($title); 623 | 624 | require Storable; 625 | my $entries = eval { Storable::retrieve($id) } // []; 626 | 627 | if (ref($entries) ne 'ARRAY') { 628 | $entries = []; 629 | } 630 | 631 | my $video_count = 0; 632 | my $video_id = undef; 633 | 634 | if (@$entries) { 635 | $video_id = $self->get_video_id($entries->[0]); 636 | $video_count = scalar(@$entries); 637 | } 638 | 639 | scalar { 640 | author => "local", 641 | authorId => "local", 642 | description => $title, 643 | playlistId => $id, 644 | playlistThumbnail => (defined($video_id) ? "https://i.ytimg.com/vi/$video_id/mqdefault.jpg" : undef), 645 | title => $title, 646 | type => "playlist", 647 | videoCount => $video_count, 648 | }; 649 | } 650 | 651 | sub local_channel_snippet { 652 | my ($self, $id, $title) = @_; 653 | 654 | scalar { 655 | author => $title, 656 | authorId => $id, 657 | type => "channel", 658 | description => "", 659 | subCount => undef, 660 | videoCount => undef, 661 | }; 662 | } 663 | 664 | =head2 get_title($info) 665 | 666 | Get title. 667 | 668 | =cut 669 | 670 | sub get_title { 671 | my ($self, $info) = @_; 672 | $info->{title}; 673 | } 674 | 675 | =head2 get_thumbnail_url($info;$type='default') 676 | 677 | Get thumbnail URL. 678 | 679 | =cut 680 | 681 | sub get_thumbnail_url { 682 | my ($self, $info, $type) = @_; 683 | 684 | if (exists $info->{videoId}) { 685 | $info->{type} = 'video'; 686 | } 687 | 688 | if ($info->{type} eq 'playlist') { 689 | return $info->{playlistThumbnail}; 690 | } 691 | 692 | if ($info->{type} eq 'channel') { 693 | ref($info->{authorThumbnails}) eq 'ARRAY' or return ''; 694 | 695 | foreach my $thumbnail (map { ref($_) eq 'ARRAY' ? @{$_} : $_ } @{$info->{authorThumbnails}}) { 696 | if (exists $thumbnail->{quality} and $thumbnail->{quality} eq $type) { 697 | return $thumbnail->{url}; 698 | } 699 | } 700 | 701 | return eval { $info->{authorThumbnails}[0]{url} } // ''; 702 | } 703 | 704 | ref($info->{videoThumbnails}) eq 'ARRAY' or return ''; 705 | 706 | my @thumbs = map { ref($_) eq 'ARRAY' ? @{$_} : $_ } @{$info->{videoThumbnails}}; 707 | my @wanted = grep { $_->{quality} eq $type } grep { ref($_) eq 'HASH' } @thumbs; 708 | 709 | my %types = ( 710 | low => '', 711 | high => 'hq', 712 | medium => 'mq', 713 | standard => 'sd', 714 | ); 715 | 716 | if (exists $types{$type}) { 717 | 718 | my $type_prefix = $types{$type}; 719 | my @selected = grep { $_->{url} =~ m{/${type_prefix}default\.\w} } @thumbs; 720 | 721 | if (@selected) { 722 | @wanted = @selected; 723 | } 724 | else { 725 | $_->{url} =~ s{/\K\w*?(?=default\.\w)}{$type_prefix} for @thumbs; 726 | @wanted = @thumbs; 727 | } 728 | } 729 | 730 | my $url; 731 | 732 | if (@wanted) { 733 | $url = eval { $wanted[0]{url} } // return ''; 734 | } 735 | else { 736 | ## warn "[!] Couldn't find thumbnail of type <<$type>>..."; 737 | $url = eval { $thumbs[0]{url} } // return ''; 738 | } 739 | 740 | # Clean URL of trackers and other junk 741 | $url =~ s/\.(?:jpg|png|webp)\K\?.*//; 742 | 743 | # Prefer JPEG over WEBP (otherwise, it fails when webp-pixbuf-loader is not installed - #50) 744 | if ($url =~ s/\.webp\z/.jpg/) { 745 | $url =~ s{/vi_webp/}{/vi/}; 746 | } 747 | 748 | return $url; 749 | } 750 | 751 | sub get_channel_title { 752 | my ($self, $info) = @_; 753 | 754 | #$info->{snippet}{channelTitle} || $self->get_channel_id($info); 755 | $info->{author} // $info->{title}; 756 | } 757 | 758 | sub get_author { 759 | my ($self, $info) = @_; 760 | $info->{author}; 761 | } 762 | 763 | sub get_comment_id { 764 | my ($self, $info) = @_; 765 | $info->{commentId} // $info->{id}; 766 | } 767 | 768 | sub get_video_count { 769 | my ($self, $info) = @_; 770 | $info->{videoCount} // 0; 771 | } 772 | 773 | sub get_subscriber_count { 774 | my ($self, $info) = @_; 775 | $info->{subCount} // 0; 776 | } 777 | 778 | sub get_channel_subscriber_count { 779 | my ($self, $info) = @_; 780 | $info->{subCount} // 0; 781 | } 782 | 783 | sub get_channel_video_count { 784 | my ($self, $info) = @_; 785 | $info->{videoCount} // 0; 786 | } 787 | 788 | sub get_playlist_item_count { 789 | my ($self, $info) = @_; 790 | $info->{videoCount} // 0; 791 | } 792 | 793 | sub get_comment_content { 794 | my ($self, $info) = @_; 795 | $info->{content} // $info->{text}; 796 | } 797 | 798 | sub get_id { 799 | my ($self, $info) = @_; 800 | $info->{videoId}; 801 | } 802 | 803 | sub calculate_rating { 804 | my ($self, $info) = @_; 805 | 806 | my $likes = $self->get_likes($info) // return undef; 807 | my $dislikes = $self->get_dislikes($info); 808 | my $views = $self->get_views($info) // return undef; 809 | 810 | my $rating = "1.00"; 811 | 812 | if (defined($likes) and $dislikes) { 813 | if ($likes > 0) { 814 | $rating = sprintf('%.2f', $likes / ($likes + $dislikes) * 4 + 1); 815 | } 816 | elsif ($dislikes == 0) { 817 | $rating = "0.00"; 818 | } 819 | } 820 | elsif ($likes and $views and $views >= $likes) { 821 | ##$rating = sprintf("%.2g%%", $likes / $views * 100); 822 | $rating = sprintf("%.2g%%", log($likes + 1) / log($views + 1) * 100); 823 | } 824 | else { 825 | $rating = "N/A"; 826 | } 827 | 828 | return $rating; 829 | } 830 | 831 | sub get_rating { 832 | my ($self, $info) = @_; 833 | my $rating = $info->{rating} // return $self->calculate_rating($info); 834 | sprintf('%.2f', $rating); 835 | } 836 | 837 | sub get_channel_id { 838 | my ($self, $info) = @_; 839 | $info->{authorId}; 840 | } 841 | 842 | sub get_category_id { 843 | my ($self, $info) = @_; 844 | $info->{genre} // $info->{category} // 'Unknown'; 845 | } 846 | 847 | sub get_category_name { 848 | my ($self, $info) = @_; 849 | 850 | state $categories = { 851 | 1 => 'Film & Animation', 852 | 2 => 'Autos & Vehicles', 853 | 10 => 'Music', 854 | 15 => 'Pets & Animals', 855 | 17 => 'Sports', 856 | 19 => 'Travel & Events', 857 | 20 => 'Gaming', 858 | 22 => 'People & Blogs', 859 | 23 => 'Comedy', 860 | 24 => 'Entertainment', 861 | 25 => 'News & Politics', 862 | 26 => 'Howto & Style', 863 | 27 => 'Education', 864 | 28 => 'Science & Technology', 865 | 29 => 'Nonprofits & Activism', 866 | }; 867 | 868 | $info->{genre} // $info->{category} // 'Unknown'; 869 | } 870 | 871 | sub get_publication_date { 872 | my ($self, $info) = @_; 873 | 874 | if (defined $info->{publishedText}) { 875 | return $info->{publishedText}; 876 | } 877 | 878 | require Encode; 879 | require Time::Piece; 880 | 881 | my $time; 882 | 883 | if (defined($info->{published})) { 884 | $time = eval { Time::Piece->new($info->{published}) }; 885 | } 886 | elsif (defined($info->{timestamp})) { 887 | $time = eval { Time::Piece->new($info->{timestamp}) }; 888 | } 889 | elsif (defined($info->{publishDate})) { 890 | if ($info->{publishDate} =~ /^[0-9]+\z/) { # time given as "%yyyy%mm%dd" (from youtube-dl) 891 | $time = eval { Time::Piece->strptime($info->{publishDate}, '%Y%m%d') }; 892 | } 893 | else { 894 | $time = eval { Time::Piece->strptime($info->{publishDate}, '%Y-%m-%d') }; 895 | } 896 | } 897 | 898 | if (defined($time)) { 899 | $info->{timestamp} = [@$time]; 900 | return Encode::decode_utf8($time->strftime("%d %B %Y")); 901 | } 902 | 903 | return undef; 904 | } 905 | 906 | sub get_publication_time { 907 | my ($self, $info) = @_; 908 | 909 | require Time::Piece; 910 | require Time::Seconds; 911 | 912 | if ($self->get_time($info) eq 'LIVE') { 913 | my $time = $info->{timestamp} // Time::Piece->new(); 914 | 915 | if (ref($time) eq 'ARRAY') { 916 | $time = bless($time, "Time::Piece"); 917 | } 918 | 919 | return $time; 920 | } 921 | 922 | if (defined($info->{publishedText})) { 923 | 924 | my $age = $info->{publishedText}; 925 | my $t = $info->{timestamp} // Time::Piece->new(); 926 | 927 | if (ref($t) eq 'ARRAY') { 928 | $t = bless($t, "Time::Piece"); 929 | } 930 | 931 | if ($age =~ /^(\d+) sec/) { 932 | $t -= $1; 933 | } 934 | 935 | if ($age =~ /^(\d+) min/) { 936 | $t -= $1 * Time::Seconds::ONE_MINUTE(); 937 | } 938 | 939 | if ($age =~ /^(\d+) hour/) { 940 | $t -= $1 * Time::Seconds::ONE_HOUR(); 941 | } 942 | 943 | if ($age =~ /^(\d+) day/) { 944 | $t -= $1 * Time::Seconds::ONE_DAY(); 945 | } 946 | 947 | if ($age =~ /^(\d+) week/) { 948 | $t -= $1 * Time::Seconds::ONE_WEEK(); 949 | } 950 | 951 | if ($age =~ /^(\d+) month/) { 952 | $t -= $1 * Time::Seconds::ONE_MONTH(); 953 | } 954 | 955 | if ($age =~ /^(\d+) year/) { 956 | $t -= $1 * Time::Seconds::ONE_YEAR(); 957 | } 958 | 959 | return $t; 960 | } 961 | 962 | return $self->get_publication_date($info); # should not happen 963 | } 964 | 965 | sub get_publication_age { 966 | my ($self, $info) = @_; 967 | ( 968 | $info->{publishedText} // $info->{time_text} // do { 969 | 970 | $self->get_publication_date($info); 971 | $info->{timestamp} // return undef; 972 | 973 | require Time::Piece; 974 | my $then = $info->{timestamp}; 975 | 976 | if (ref($then) eq 'ARRAY') { 977 | $then = bless($then, 'Time::Piece'); 978 | } 979 | 980 | # Format: "2010-02-19T00:25:55" 981 | my $date = $then->strftime("%Y-%m-%dT%H:%M:%S"); 982 | 983 | # Convert date to age 984 | $self->date_to_age($date); 985 | } 986 | ) =~ s/\sago\z//r; 987 | } 988 | 989 | sub get_publication_age_approx { 990 | my ($self, $info) = @_; 991 | 992 | my $age = $self->get_publication_age($info) // ''; 993 | 994 | if ($age =~ /hour|min|sec/) { 995 | return "0d"; 996 | } 997 | 998 | if ($age =~ /^(\d+) day/) { 999 | return "$1d"; 1000 | } 1001 | 1002 | if ($age =~ /^(\d+) week/) { 1003 | return "$1w"; 1004 | } 1005 | 1006 | if ($age =~ /^(\d+) month/) { 1007 | return "$1m"; 1008 | } 1009 | 1010 | if ($age =~ /^(\d+) year/) { 1011 | return "$1y"; 1012 | } 1013 | 1014 | return $age; 1015 | } 1016 | 1017 | sub get_duration { 1018 | my ($self, $info) = @_; 1019 | $info->{lengthSeconds}; 1020 | } 1021 | 1022 | sub get_time { 1023 | my ($self, $info) = @_; 1024 | 1025 | if ($info->{liveNow} and ($self->get_duration($info) || 0) == 0) { 1026 | return 'LIVE'; 1027 | } 1028 | 1029 | $self->format_time($self->get_duration($info) // return undef); 1030 | } 1031 | 1032 | sub get_definition { 1033 | my ($self, $info) = @_; 1034 | 1035 | #uc($info->{contentDetails}{definition} // '-'); 1036 | #...; 1037 | "unknown"; 1038 | } 1039 | 1040 | sub get_dimension { 1041 | my ($self, $info) = @_; 1042 | 1043 | #uc($info->{contentDetails}{dimension}); 1044 | #...; 1045 | "unknown"; 1046 | } 1047 | 1048 | sub get_caption { 1049 | my ($self, $info) = @_; 1050 | 1051 | #$info->{contentDetails}{caption}; 1052 | #...; 1053 | "unknown"; 1054 | } 1055 | 1056 | sub get_views { 1057 | my ($self, $info) = @_; 1058 | $info->{viewCount} // 0; 1059 | } 1060 | 1061 | sub short_human_number { 1062 | my ($self, $int) = @_; 1063 | 1064 | $int // return undef; 1065 | 1066 | if ($int < 1000) { 1067 | return $int; 1068 | } 1069 | 1070 | if ($int >= 10 * 1e9) { # ten billions 1071 | return sprintf("%dB", int($int / 1e9)); 1072 | } 1073 | 1074 | if ($int >= 1e9) { # billions 1075 | return sprintf("%.2gB", $int / 1e9); 1076 | } 1077 | 1078 | if ($int >= 10 * 1e6) { # ten millions 1079 | return sprintf("%dM", int($int / 1e6)); 1080 | } 1081 | 1082 | if ($int >= 1e6) { # millions 1083 | return sprintf("%.2gM", $int / 1e6); 1084 | } 1085 | 1086 | if ($int >= 10 * 1e3) { # ten thousands 1087 | return sprintf("%dK", int($int / 1e3)); 1088 | } 1089 | 1090 | if ($int >= 1e3) { # thousands 1091 | return sprintf("%.2gK", $int / 1e3); 1092 | } 1093 | 1094 | return $int; 1095 | } 1096 | 1097 | sub get_views_approx { 1098 | my ($self, $info) = @_; 1099 | my $views = $self->get_views($info); 1100 | $self->short_human_number($views); 1101 | } 1102 | 1103 | sub get_likes { 1104 | my ($self, $info) = @_; 1105 | $info->{likeCount}; 1106 | } 1107 | 1108 | sub get_dislikes { 1109 | my ($self, $info) = @_; 1110 | $info->{dislikeCount}; 1111 | } 1112 | 1113 | sub get_comments { 1114 | my ($self, $info) = @_; 1115 | 1116 | #$info->{statistics}{commentCount}; 1117 | 1; 1118 | } 1119 | 1120 | { 1121 | no strict 'refs'; 1122 | foreach my $pair ([playlist => {'playlist' => 1}], 1123 | [channel => {'channel' => 1}], 1124 | [video => {'video' => 1, 'playlistItem' => 1}], 1125 | [subscription => {'subscription' => 1}], 1126 | [activity => {'activity' => 1}], 1127 | ) { 1128 | 1129 | *{__PACKAGE__ . '::' . 'is_' . $pair->[0]} = sub { 1130 | my ($self, $item) = @_; 1131 | 1132 | if ($pair->[0] eq 'video') { 1133 | return 1 if defined $item->{videoId}; 1134 | } 1135 | 1136 | if ($pair->[0] eq 'playlist') { 1137 | return 1 if defined $item->{playlistId}; 1138 | } 1139 | 1140 | exists $pair->[1]{$item->{type} // ''}; 1141 | }; 1142 | 1143 | } 1144 | } 1145 | 1146 | sub is_channelID { 1147 | my ($self, $id) = @_; 1148 | $id || return; 1149 | $id =~ /^@./; 1150 | } 1151 | 1152 | sub is_videoID { 1153 | my ($self, $id) = @_; 1154 | $id || return; 1155 | $id =~ /^[-a-zA-Z0-9_]{11}\z/; 1156 | } 1157 | 1158 | sub period_to_date { 1159 | my ($self, $amount, $period) = @_; 1160 | 1161 | state $day = 60 * 60 * 24; 1162 | state $week = $day * 7; 1163 | state $month = $day * 30.4368; 1164 | state $year = $day * 365.242; 1165 | 1166 | my $time = $amount * ( 1167 | $period =~ /^d/i ? $day 1168 | : $period =~ /^w/i ? $week 1169 | : $period =~ /^m/i ? $month 1170 | : $period =~ /^y/i ? $year 1171 | : 0 1172 | ); 1173 | 1174 | my $now = time; 1175 | my @time = gmtime($now - $time); 1176 | join('-', $time[5] + 1900, sprintf('%02d', $time[4] + 1), sprintf('%02d', $time[3])) . 'T' 1177 | . join(':', sprintf('%02d', $time[2]), sprintf('%02d', $time[1]), sprintf('%02d', $time[0])) . 'Z'; 1178 | } 1179 | 1180 | =head1 AUTHOR 1181 | 1182 | Trizen, C<< >> 1183 | 1184 | 1185 | =head1 SUPPORT 1186 | 1187 | You can find documentation for this module with the perldoc command. 1188 | 1189 | perldoc WWW::LbryViewer::Utils 1190 | 1191 | 1192 | =head1 LICENSE AND COPYRIGHT 1193 | 1194 | Copyright 2012-2020 Trizen. 1195 | 1196 | This program is free software; you can redistribute it and/or modify it 1197 | under the terms of either: the GNU General Public License as published 1198 | by the Free Software Foundation; or the Artistic License. 1199 | 1200 | See L for more information. 1201 | 1202 | =cut 1203 | 1204 | 1; # End of WWW::LbryViewer::Utils 1205 | -------------------------------------------------------------------------------- /lib/WWW/LbryViewer/VideoCategories.pm: -------------------------------------------------------------------------------- 1 | package WWW::LbryViewer::VideoCategories; 2 | 3 | use utf8; 4 | use 5.014; 5 | use warnings; 6 | 7 | =head1 NAME 8 | 9 | WWW::LbryViewer::VideoCategories - videoCategory resource handler. 10 | 11 | =head1 SYNOPSIS 12 | 13 | use WWW::LbryViewer; 14 | my $obj = WWW::LbryViewer->new(%opts); 15 | my $cats = $obj->video_categories(); 16 | 17 | =head1 SUBROUTINES/METHODS 18 | 19 | =cut 20 | 21 | =head2 video_categories() 22 | 23 | Return video categories for a specific region ID. 24 | 25 | =cut 26 | 27 | sub video_categories { 28 | my ($self) = @_; 29 | 30 | return [{id => "featured", title => "Featured"}, 31 | {id => "popculture", title => "Pop Culture"}, 32 | {id => "artists", title => "Artists"}, 33 | {id => "education", title => "Education"}, 34 | {id => "lifestyle", title => "Lifestyle"}, 35 | {id => "spooky", title => "Spooky"}, 36 | {id => "gaming", title => "Gaming"}, 37 | {id => "tech", title => "Tech"}, 38 | {id => "comedy", title => "Comedy"}, 39 | {id => "music", title => "Music"}, 40 | {id => "sports", title => "Sports"}, 41 | {id => "universe", title => "Universe"}, 42 | {id => "finance", title => "Finance 2.0"}, 43 | {id => "spirituality", title => "Spirituality"}, 44 | {id => "news", title => "News & Politics"}, 45 | {id => "rabbithole", title => "Rabbit Hole"}, 46 | ]; 47 | } 48 | 49 | =head1 AUTHOR 50 | 51 | Trizen, C<< >> 52 | 53 | 54 | =head1 SUPPORT 55 | 56 | You can find documentation for this module with the perldoc command. 57 | 58 | perldoc WWW::LbryViewer::VideoCategories 59 | 60 | 61 | =head1 LICENSE AND COPYRIGHT 62 | 63 | Copyright 2013-2015 Trizen. 64 | 65 | This program is free software; you can redistribute it and/or modify it 66 | under the terms of either: the GNU General Public License as published 67 | by the Free Software Foundation; or the Artistic License. 68 | 69 | See L for more information. 70 | 71 | =cut 72 | 73 | 1; # End of WWW::LbryViewer::VideoCategories 74 | -------------------------------------------------------------------------------- /lib/WWW/LbryViewer/Videos.pm: -------------------------------------------------------------------------------- 1 | package WWW::LbryViewer::Videos; 2 | 3 | use utf8; 4 | use 5.014; 5 | use warnings; 6 | 7 | =head1 NAME 8 | 9 | WWW::LbryViewer::Videos - videos handler. 10 | 11 | =head1 SYNOPSIS 12 | 13 | use WWW::LbryViewer; 14 | my $obj = WWW::LbryViewer->new(%opts); 15 | my $info = $obj->video_details($videoID); 16 | 17 | =head1 SUBROUTINES/METHODS 18 | 19 | =cut 20 | 21 | sub _make_videos_url { 22 | my ($self, %opts) = @_; 23 | return $self->_make_feed_url('videos', %opts); 24 | } 25 | 26 | { 27 | no strict 'refs'; 28 | foreach my $part ( 29 | qw( 30 | id 31 | snippet 32 | contentDetails 33 | fileDetails 34 | player 35 | liveStreamingDetails 36 | processingDetails 37 | recordingDetails 38 | statistics 39 | status 40 | suggestions 41 | topicDetails 42 | ) 43 | ) { 44 | *{__PACKAGE__ . '::' . 'video_' . $part} = sub { 45 | my ($self, $id) = @_; 46 | return $self->_get_results($self->_make_videos_url(id => $id, part => $part)); 47 | }; 48 | } 49 | } 50 | 51 | =head2 trending_videos_from_category($category_id) 52 | 53 | Get popular videos from a category ID. 54 | 55 | =cut 56 | 57 | sub trending_videos_from_category { 58 | my ($self, $category) = @_; 59 | 60 | if (defined($category) and $category eq 'featured') { 61 | return $self->popular_videos; 62 | } 63 | 64 | return $self->lbry_category_videos($category); 65 | } 66 | 67 | =head2 send_rating_to_video($videoID, $rating) 68 | 69 | Send rating to a video. $rating can be either 'like' or 'dislike'. 70 | 71 | =cut 72 | 73 | sub send_rating_to_video { 74 | my ($self, $video_id, $rating) = @_; 75 | 76 | if ($rating eq 'none' or $rating eq 'like' or $rating eq 'dislike') { 77 | my $url = $self->_simple_feeds_url('videos/rate', id => $video_id, rating => $rating); 78 | return defined($self->lwp_post($url, $self->_auth_lwp_header())); 79 | } 80 | 81 | return; 82 | } 83 | 84 | =head2 like_video($videoID) 85 | 86 | Like a video. Returns true on success. 87 | 88 | =cut 89 | 90 | sub like_video { 91 | my ($self, $video_id) = @_; 92 | $self->send_rating_to_video($video_id, 'like'); 93 | } 94 | 95 | =head2 dislike_video($videoID) 96 | 97 | Dislike a video. Returns true on success. 98 | 99 | =cut 100 | 101 | sub dislike_video { 102 | my ($self, $video_id) = @_; 103 | $self->send_rating_to_video($video_id, 'dislike'); 104 | } 105 | 106 | sub _ytdl_video_details { 107 | my ($self, $id) = @_; 108 | $self->_info_from_ytdl($id); 109 | } 110 | 111 | sub _fallback_video_details { 112 | my ($self, $id, $fields) = @_; 113 | 114 | if ($self->get_debug) { 115 | say STDERR ":: Extracting video info using the fallback method..."; 116 | } 117 | 118 | my $info = $self->_ytdl_video_details($id); 119 | 120 | if (defined($info) and ref($info) eq 'HASH') { 121 | return scalar { 122 | 123 | extra_info => 1, 124 | type => 'video', 125 | 126 | title => $info->{fulltitle} // $info->{title}, 127 | videoId => $id, 128 | 129 | #<<< 130 | videoThumbnails => [ 131 | map { 132 | scalar { 133 | quality => 'medium', 134 | url => $_->{url}, 135 | width => $_->{width}, 136 | height => $_->{height}, 137 | } 138 | } @{$info->{thumbnails}} 139 | ], 140 | #>>> 141 | 142 | liveNow => ($info->{is_live} ? 1 : 0), 143 | description => $info->{description}, 144 | lengthSeconds => $info->{duration}, 145 | 146 | likeCount => $info->{like_count}, 147 | dislikeCount => $info->{dislike_count}, 148 | 149 | category => eval { $info->{categories}[0] } // $info->{category}, 150 | publishDate => $info->{upload_date} // $info->{release_date}, 151 | 152 | keywords => $info->{tags}, 153 | viewCount => $info->{view_count}, 154 | 155 | author => $info->{channel}, 156 | 157 | #authorId => (split(/\//, $id))[0], 158 | authorId => (split(/\//, ($info->{channel_url} // '')))[-1] // '', 159 | rating => $info->{average_rating}, 160 | }; 161 | } 162 | else { 163 | 164 | if ($self->get_debug) { 165 | say STDERR ":: The fallback method failed. Trying the main method.."; 166 | } 167 | 168 | if (defined(my $info = $self->lbry_video_info(id => $id))) { 169 | return $info; 170 | } 171 | } 172 | 173 | return {}; 174 | } 175 | 176 | sub video_details { 177 | my ($self, $id, $fields) = @_; 178 | 179 | # Extract info from the Librarian website 180 | if (not $self->get_force_fallback and defined(my $info = $self->lbry_video_info(id => $id))) { 181 | return $info; 182 | } 183 | 184 | # Extract info with youtube-dl / yt-dlp 185 | return $self->_fallback_video_details($id, $fields); 186 | } 187 | 188 | =head2 Return details 189 | 190 | Each function returns a HASH ref, with a key called 'results', and another key, called 'url'. 191 | 192 | The 'url' key contains a string, which is the URL for the retrieved content. 193 | 194 | The 'results' key contains another HASH ref with the keys 'etag', 'items' and 'kind'. 195 | From the 'results' key, only the 'items' are relevant to us. This key contains an ARRAY ref, 196 | with a HASH ref for each result. An example of the item array's content are shown below. 197 | 198 | =cut 199 | 200 | =head1 AUTHOR 201 | 202 | Trizen, C<< >> 203 | 204 | 205 | =head1 SUPPORT 206 | 207 | You can find documentation for this module with the perldoc command. 208 | 209 | perldoc WWW::LbryViewer::Videos 210 | 211 | 212 | =head1 LICENSE AND COPYRIGHT 213 | 214 | Copyright 2013-2015 Trizen. 215 | 216 | This program is free software; you can redistribute it and/or modify it 217 | under the terms of either: the GNU General Public License as published 218 | by the Free Software Foundation; or the Artistic License. 219 | 220 | See L for more information. 221 | 222 | =cut 223 | 224 | 1; # End of WWW::LbryViewer::Videos 225 | -------------------------------------------------------------------------------- /share/gtk-lbry-viewer.desktop: -------------------------------------------------------------------------------- 1 | [Desktop Entry] 2 | Name=GTK Lbry Viewer 3 | Version=1.0 4 | Comment=Search and play LBRY videos. 5 | Exec=gtk-lbry-viewer 6 | Icon=gtk-lbry-viewer 7 | StartupNotify=false 8 | Terminal=false 9 | Type=Application 10 | Categories=AudioVideo;GTK; 11 | -------------------------------------------------------------------------------- /share/icons/default_thumb.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/trizen/lbry-viewer/477d05839e76bc8729c9d8941443b66f31cbc381/share/icons/default_thumb.jpg -------------------------------------------------------------------------------- /share/icons/feed.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/trizen/lbry-viewer/477d05839e76bc8729c9d8941443b66f31cbc381/share/icons/feed.png -------------------------------------------------------------------------------- /share/icons/feed_gray.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/trizen/lbry-viewer/477d05839e76bc8729c9d8941443b66f31cbc381/share/icons/feed_gray.png -------------------------------------------------------------------------------- /share/icons/gtk-lbry-viewer.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/trizen/lbry-viewer/477d05839e76bc8729c9d8941443b66f31cbc381/share/icons/gtk-lbry-viewer.png -------------------------------------------------------------------------------- /share/icons/left_arrow.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/trizen/lbry-viewer/477d05839e76bc8729c9d8941443b66f31cbc381/share/icons/left_arrow.png -------------------------------------------------------------------------------- /share/icons/right_arrow.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/trizen/lbry-viewer/477d05839e76bc8729c9d8941443b66f31cbc381/share/icons/right_arrow.png -------------------------------------------------------------------------------- /share/icons/spinner.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/trizen/lbry-viewer/477d05839e76bc8729c9d8941443b66f31cbc381/share/icons/spinner.gif -------------------------------------------------------------------------------- /share/icons/user.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/trizen/lbry-viewer/477d05839e76bc8729c9d8941443b66f31cbc381/share/icons/user.png -------------------------------------------------------------------------------- /t/00-load.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | 3 | use 5.014; 4 | use Test::More tests => 1; 5 | 6 | BEGIN { 7 | use_ok( 'WWW::LbryViewer' ) || print "Bail out!\n"; 8 | } 9 | 10 | diag( "Testing WWW::LbryViewer $WWW::LbryViewer::VERSION, Perl $], $^X" ); 11 | -------------------------------------------------------------------------------- /t/kwalitee.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use 5.006; 4 | use strict; 5 | use warnings FATAL => 'all'; 6 | use Test::More; 7 | 8 | BEGIN { 9 | plan( skip_all => 'these tests are for release candidate testing' ) 10 | unless $ENV{RELEASE_TESTING}; 11 | } 12 | 13 | eval { 14 | require Test::Kwalitee; 15 | Test::Kwalitee->import('kwalitee_ok'); 16 | kwalitee_ok(); 17 | done_testing(); 18 | }; 19 | 20 | plan( skip_all => 'Test::Kwalitee not installed; skipping' ) if $@; 21 | -------------------------------------------------------------------------------- /t/pod.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | 3 | use strict; 4 | use warnings; 5 | use Test::More; 6 | 7 | # Ensure a recent version of Test::Pod 8 | my $min_tp = 1.22; 9 | eval "use Test::Pod $min_tp"; 10 | plan skip_all => "Test::Pod $min_tp required for testing POD" if $@; 11 | 12 | all_pod_files_ok(); 13 | -------------------------------------------------------------------------------- /utils/auto_perltidy.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | alias perltidy='perltidy -utf8 -l=160 -f -kbl=1 -bbb -bbc -bbs -b -ple -bt=2 -pt=2 -sbt=2 -bvt=0 -sbvt=1 -cti=1 -bar -lp -anl'; 4 | which perltidy; 5 | cd ..; 6 | for i in $(git status | grep '^[[:cntrl:]]*modified:' | grep -E 'bin/|\.(pm|t)$' | perl -nE 'say +(split)[-1]'); do echo $i; perltidy -b $i; done 7 | -------------------------------------------------------------------------------- /utils/bak_cleaner.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | for i in $(git status | grep \.bak$ | perl -nE 'say +(split)[-1]'); do echo $i; rm $i; done 4 | --------------------------------------------------------------------------------