File Coverage

blib/lib/StreamFinder/Radionomy.pm
Criterion Covered Total %
statement 18 195 9.2
branch 0 128 0.0
condition 0 30 0.0
subroutine 6 17 35.2
pod 11 11 100.0
total 35 381 9.1


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             StreamFinder::Radionomy - Fetch actual raw streamable URLs from radio-station websites on Radionomy.com
4              
5             =head1 AUTHOR
6              
7             This module is Copyright (C) 2017-2019 by
8              
9             Jim Turner, C<< >>
10            
11             Email: turnerjw784@yahoo.com
12              
13             All rights reserved.
14              
15             You may distribute this module under the terms of either the GNU General
16             Public License or the Artistic License, as specified in the Perl README
17             file.
18              
19             =head1 SYNOPSIS
20              
21             use strict;
22              
23             use StreamFinder::Radionomy;
24              
25             my $station = new StreamFinder::Radionomy();
26              
27             die "Invalid URL or no streams found!\n" unless ($station);
28              
29             my $firstStream = $station->get();
30              
31             print "First Stream URL=$firstStream\n";
32              
33             my $url = $station->getURL();
34              
35             print "Stream URL=$url\n";
36              
37             my $stationTitle = $station->getTitle();
38            
39             print "Title=$stationTitle\n";
40            
41             my $stationDescription = $station->getTitle('desc');
42            
43             print "Description=$stationDescription\n";
44            
45             my $stationID = $station->getID();
46              
47             print "Station ID=$stationID\n";
48            
49             my $icon_url = $station->getIconURL();
50              
51             if ($icon_url) { #SAVE THE ICON TO A TEMP. FILE:
52              
53             my ($image_ext, $icon_image) = $station->getIconData();
54              
55             if ($icon_image && open IMGOUT, ">/tmp/${stationID}.$image_ext") {
56              
57             binmode IMGOUT;
58              
59             print IMGOUT $icon_image;
60              
61             close IMGOUT;
62              
63             }
64              
65             }
66              
67             my $stream_count = $station->count();
68              
69             print "--Stream count=$stream_count=\n";
70              
71             my @streams = $station->get();
72              
73             foreach my $s (@streams) {
74              
75             print "------ stream URL=$s=\n";
76              
77             }
78              
79             =head1 DESCRIPTION
80              
81             StreamFinder::Radionomy accepts a valid radio station ID or URL on Radionomy.com
82             and returns the actual stream URL(s), title, and cover art icon for that station.
83             The purpose is that one needs one of these URLs in order to have the option to
84             stream the station in one's own choice of media player software rather than
85             using their web browser and accepting any / all flash, ads, javascript,
86             cookies, trackers, web-bugs, and other crapware that can come with that method
87             of playing. The author uses his own custom all-purpose media player called
88             "fauxdacious" (his custom hacked version of the open-source "audacious"
89             audio player). "fauxdacious" can incorporate this module to decode and play
90             Radionomy.com streams.
91              
92             One or more streams can be returned for each station.
93              
94             =head1 SUBROUTINES/METHODS
95              
96             =over 4
97              
98             =item B(I [, "debug" [ => 0|1|2 ]])
99              
100             Accepts a Radionomy.com ID or URL and creates and returns a new station object,
101             or I if the URL is not a valid Radionomy station or no streams are found.
102             The URL can be the full URL,
103             ie. http://www.radionomy.com/en/radio/B/index,
104             http://www.radionomy.com/en/radio/B,
105             or just I.
106              
107             =item $station->B()
108              
109             Returns an array of strings representing all stream URLs found.
110              
111             =item $station->B([I])
112              
113             Similar to B() except it only returns a single stream representing
114             the first valid stream found.
115              
116             Current options are: I<"random"> and I<"noplaylists">. By default, the
117             first ("best"?) stream is returned. If I<"random"> is specified, then
118             a random one is selected from the list of streams found.
119             If I<"noplaylists"> is specified, and the stream to be returned is a
120             "playlist" (.pls or .m3u? extension), it is first fetched and the first entry
121             in the playlist is returned. This is needed by Fauxdacious Mediaplayer.
122              
123             =item $station->B()
124              
125             Returns the number of streams found for the station.
126              
127             =item $station->B(['fccid'])
128              
129             Returns the station's Radionomy ID (default) or
130             station's FCC call-letters ("fccid").
131              
132             =item $station->B(['desc'])
133              
134             Returns the station's title, or (long description).
135              
136             =item $station->B()
137              
138             Returns the URL for the station's "cover art" icon image, if any.
139              
140             =item $station->B()
141              
142             Returns a two-element array consisting of the extension (ie. "png",
143             "gif", "jpeg", etc.) and the actual icon image (binary data), if any.
144              
145             =item $station->B()
146              
147             Returns the URL for the station's "cover art" banner image, which for
148             Radionomy stations is always the icon image, as Radionomy does not
149             support a separate banner image at this time.
150              
151             =item $station->B()
152              
153             Returns a two-element array consisting of the extension (ie. "png",
154             "gif", "jpeg", etc.) and the actual station's banner image (binary data).
155              
156             =item $station->B()
157              
158             Returns the station's type ("Radionomy").
159              
160             =back
161              
162             =head1 CONFIGURATION FILES
163              
164             =over 4
165              
166             =item ~/.config/StreamFinder/Radionomy/config
167              
168             Optional text file for specifying various configuration options
169             for a specific site (submodule). Each option is specified on a
170             separate line in the format below:
171              
172             'option' => 'value' [,]
173              
174             and the options are loaded into a hash used only by the specific
175             (submodule) specified. Valid options include
176             I<-debug> => [0|1|2], and most of the L options.
177             Blank lines and lines starting with a "#" sign are ignored.
178              
179             Options specified here override any specified in I<~/.config/StreamFinder/config>.
180              
181             =item ~/.config/StreamFinder/config
182              
183             Optional text file for specifying various configuration options.
184             Each option is specified on a separate line in the format below:
185              
186             'option' => 'value' [,]
187              
188             and the options are loaded into a hash used by all sites
189             (submodules) that support them. Valid options include
190             I<-debug> => [0|1|2], and most of the L options.
191              
192             =back
193              
194             NOTE: Options specified in the options parameter list will override
195             those corresponding options specified in these files.
196              
197             =head1 KEYWORDS
198              
199             Radionomy
200              
201             =head1 DEPENDENCIES
202              
203             L, L, L
204              
205             =head1 RECCOMENDS
206              
207             wget
208              
209             =head1 BUGS
210              
211             Please report any bugs or feature requests to C, or through
212             the web interface at L. I will be notified, and then you'll
213             automatically be notified of progress on your bug as I make changes.
214              
215             =head1 SUPPORT
216              
217             You can find documentation for this module with the perldoc command.
218              
219             perldoc StreamFinder::Radionomy
220              
221             You can also look for information at:
222              
223             =over 4
224              
225             =item * RT: CPAN's request tracker (report bugs here)
226              
227             L
228              
229             =item * AnnoCPAN: Annotated CPAN documentation
230              
231             L
232              
233             =item * CPAN Ratings
234              
235             L
236              
237             =item * Search CPAN
238              
239             L
240              
241             =back
242              
243             =head1 LICENSE AND COPYRIGHT
244              
245             Copyright 2017-2019 Jim Turner.
246              
247             This program is free software; you can redistribute it and/or modify it
248             under the terms of the the Artistic License (2.0). You may obtain a
249             copy of the full license at:
250              
251             L
252              
253             Any use, modification, and distribution of the Standard or Modified
254             Versions is governed by this Artistic License. By using, modifying or
255             distributing the Package, you accept this license. Do not use, modify,
256             or distribute the Package, if you do not accept this license.
257              
258             If your Modified Version has been derived from a Modified Version made
259             by someone other than you, you are nevertheless required to ensure that
260             your Modified Version complies with the requirements of this license.
261              
262             This license does not grant you the right to use any trademark, service
263             mark, tradename, or logo of the Copyright Holder.
264              
265             This license includes the non-exclusive, worldwide, free-of-charge
266             patent license to make, have made, use, offer to sell, sell, import and
267             otherwise transfer the Package with respect to any patent claims
268             licensable by the Copyright Holder that are necessarily infringed by the
269             Package. If you institute patent litigation (including a cross-claim or
270             counterclaim) against any party alleging that the Package constitutes
271             direct or contributory patent infringement, then this Artistic License
272             to you shall terminate on the date that such litigation is filed.
273              
274             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
275             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
276             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
277             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
278             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
279             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
280             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
281             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
282              
283             =cut
284              
285             package StreamFinder::Radionomy;
286              
287 1     1   6 use strict;
  1         1  
  1         25  
288 1     1   5 use warnings;
  1         2  
  1         20  
289 1     1   4 use URI::Escape;
  1         2  
  1         39  
290 1     1   18 use HTML::Entities ();
  1         3  
  1         15  
291 1     1   4 use LWP::UserAgent ();
  1         2  
  1         24  
292 1     1   4 use vars qw(@ISA @EXPORT);
  1         8  
  1         2338  
293              
294             my $DEBUG = 0;
295             my %uops = ();
296             my @userAgentOps = ();
297              
298             require Exporter;
299              
300             @ISA = qw(Exporter);
301             @EXPORT = qw(get getURL getType getID getTitle getIconURL getIconData getImageURL getImageData);
302              
303             sub new
304             {
305 0     0 1   my $class = shift;
306 0           my $url = shift;
307              
308 0           my $self = {};
309 0 0         return undef unless ($url);
310              
311 0           foreach my $p ("$ENV{HOME}/.config/StreamFinder/config", "$ENV{HOME}/.config/StreamFinder/Radionomy/config") {
312 0 0         if (open IN, $p) {
313 0           my ($atr, $val);
314 0           while () {
315 0           chomp;
316 0 0         next if (/^\s*\#/o);
317 0           ($atr, $val) = split(/\s*\=\>\s*/o, $_, 2);
318 0           eval "\$uops{$atr} = $val";
319             }
320 0           close IN;
321             }
322             }
323 0           foreach my $i (qw(agent from conn_cache default_headers local_address ssl_opts max_size
324             max_redirect parse_head protocols_allowed protocols_forbidden requests_redirectable
325             proxy no_proxy)) {
326 0 0         push @userAgentOps, $i, $uops{$i} if (defined $uops{$i});
327             }
328             push (@userAgentOps, 'agent', 'Mozilla/5.0 (X11; Linux x86_64; rv:68.0) Gecko/20100101 Firefox/68.0')
329 0 0         unless (defined $uops{'agent'});
330 0 0         $uops{'timeout'} = 10 unless (defined $uops{'timeout'});
331 0 0         $DEBUG = $uops{'debug'} if (defined $uops{'debug'});
332              
333 0           while (@_) {
334 0 0         if ($_[0] =~ /^\-?debug$/o) {
335 0           shift;
336 0 0 0       $DEBUG = (defined($_[0]) && $_[0] =~/^[0-9]$/) ? shift : 1;
337             }
338             }
339              
340 0           (my $url2fetch = $url);
341 0 0         $url2fetch = 'https://www.radionomy.com/en/radio/' . $url . '/index' unless ($url =~ /^https?\:/);
342 0 0         unless ($url2fetch =~ m#\/index#) {
343 0 0         $url2fetch .= '/' unless ($url2fetch =~ m#\/$#);
344 0           $url2fetch .= 'index';
345             }
346 0 0         $self->{'id'} = $1 if ($url2fetch =~ m#\/([^\/]+)\/index#);
347 0           my $html = '';
348 0 0         print STDERR "-0(Radionomy): URL=$url2fetch=\n" if ($DEBUG);
349 0           my $ua = LWP::UserAgent->new(@userAgentOps);
350 0           $ua->timeout($uops{'timeout'});
351 0           $ua->cookie_jar({});
352 0           $ua->env_proxy;
353 0           my $response = $ua->get($url2fetch);
354 0 0         if ($response->is_success) {
355 0           $html = $response->decoded_content;
356             } else {
357 0 0         print STDERR $response->status_line if ($DEBUG);
358             }
359 0 0         print STDERR "-1: html=$html=\n" if ($DEBUG > 1);
360 0 0         return undef unless ($html); #STEP 1 FAILED, INVALID STATION URL, PUNT!
361 0           $self->{'cnt'} = 0;
362 0 0         $self->{'fccid'} = ($html =~ m#\

([^\<]+)#) ? $1 : '';

363 0 0 0       $self->{'fccid'} = $1 if (defined($self->{'fccid'}) && $self->{'fccid'} =~ /\b([KW]\w{2,3})\b/);
364 0 0 0       $self->{'fccid'} = $1 if (!$self->{'fccid'} && $self->{'title'} =~ /\b([KW]\w{2,3})\b/);
365 0 0         $self->{'iconurl'} = ($html =~ m#\"og\:image\"\s+content\=\"([^\"]+)\"#) ? $1 : '';
366 0           $self->{'imageurl'} = $self->{'iconurl'};
367 0           $html =~ s/\\\"/\"\;/gs;
368 0 0         $self->{'title'} = ($html =~ m#\"og\:title\"\s+content\=\"([^\"]+)\"#) ? $1 : '';
369 0 0         $self->{'description'} = ($html =~ m#\b(?:name\=\"|property\=\"og\:)description\"\s+content\=\"([^\"]+)\"#) ? $1 : $self->{'title'};
370 0           $self->{'title'} = HTML::Entities::decode_entities($self->{'title'});
371 0           $self->{'title'} = uri_unescape($self->{'title'});
372 0           $self->{'description'} = HTML::Entities::decode_entities($self->{'description'});
373 0           $self->{'description'} = uri_unescape($self->{'description'});
374 0 0         print STDERR "-2: icon=".$self->{'iconurl'}."= title=".$self->{'title'}."=\n" if ($DEBUG);
375 0 0         $url2fetch = ($html =~ m#\
376 0 0         print STDERR "-3: url2=$url2fetch=\n" if ($DEBUG);
377 0 0         return undef unless ($url2fetch);
378 0           $html = '';
379 0 0         if ($url2fetch =~ s#\/\;\.\w+$##) {
380 0           $self->{'cnt'} = 1;
381 0           $self->{'total'} = 1;
382 0           $self->{'streams'} = [$url2fetch];
383 0 0         print STDERR "-SUCCESS: DIRECT STREAM=$url2fetch=\n" if ($DEBUG);
384 0           bless $self, $class; #BLESS IT!
385              
386 0           return $self;
387             }
388              
389 0           $response = $ua->get($url2fetch);
390 0 0         if ($response->is_success) {
391 0           $html = $response->decoded_content;
392             } else {
393 0 0         print STDERR $response->status_line if ($DEBUG);
394             }
395            
396 0 0         print STDERR "-4: streamlist=$html=\n" if ($DEBUG);
397 0 0         return undef unless ($html); #STEP 1 FAILED, INVALID STATION URL, PUNT!
398              
399 0           my @streams = split /\r?\n/s, $html;
400 0           $self->{'cnt'} = scalar @streams;
401 0 0         print STDERR "-count=".$self->{'cnt'}."= iconurl=".$self->{'iconurl'}."=\n" if ($DEBUG);
402 0 0         return undef unless ($self->{'cnt'}); #STEP 2 FAILED - NO PLAYABLE STREAMS FOUND, PUNT!
403              
404 0           $self->{'total'} = $self->{'cnt'};
405 0           $self->{'streams'} = \@streams;
406 0 0         print STDERR "-SUCCESS: 1st stream=".${$self->{'streams'}}[0]."=\n" if ($DEBUG);
  0            
407 0           bless $self, $class; #BLESS IT!
408              
409 0           return $self;
410             }
411              
412             sub get
413             {
414 0     0 1   my $self = shift;
415              
416 0 0         return wantarray ? @{$self->{'streams'}} : ${$self->{'streams'}}[0];
  0            
  0            
417             }
418              
419             sub getURL #LIKE GET, BUT ONLY RANDOMLY SELECT ONE TO RETURN:
420             {
421 0     0 1   my $self = shift;
422 0 0         my $arglist = (defined $_[0]) ? join('|',@_) : '';
423 0 0         my $idx = ($arglist =~ /\b\-?random\b/) ? int rand scalar @{$self->{'streams'}} : 0;
  0            
424 0 0 0       if ($arglist =~ /\b\-?noplaylists\b/ && ${$self->{'streams'}}[$idx] =~ /\.(pls|m3u8?)$/i) {
  0            
425 0           my $plType = $1;
426 0           my $firstStream = ${$self->{'streams'}}[$idx];
  0            
427 0 0         print STDERR "-getURL($idx): NOPLAYLISTS and (".${$self->{'streams'}}[$idx].")\n" if ($DEBUG);
  0            
428 0           my $ua = LWP::UserAgent->new(@userAgentOps);
429 0           $ua->timeout($uops{'timeout'});
430 0           $ua->cookie_jar({});
431 0           $ua->env_proxy;
432 0           my $html = '';
433 0           my $response = $ua->get($firstStream);
434 0 0         if ($response->is_success) {
435 0           $html = $response->decoded_content;
436             } else {
437 0 0         print STDERR $response->status_line if ($DEBUG);
438 0           my $no_wget = system('wget','-V');
439 0 0         unless ($no_wget) {
440 0 0         print STDERR "\n..trying wget...\n" if ($DEBUG);
441 0           $html = `wget -t 2 -T 20 -O- -o /dev/null \"$firstStream\" 2>/dev/null `;
442             }
443             }
444 0           my @lines = split(/\r?\n/, $html);
445 0           $firstStream = '';
446 0 0         if ($plType =~ /pls/) { #PLS:
447 0           my $firstTitle = '';
448 0           foreach my $line (@lines) {
449 0 0         if ($line =~ m#^\s*File\d+\=(.+)$#) {
    0          
450 0   0       $firstStream ||= $1;
451             } elsif ($line =~ m#^\s*Title\d+\=(.+)$#) {
452 0   0       $firstTitle ||= $1;
453             }
454             }
455 0   0       $self->{'title'} ||= $firstTitle;
456 0 0         print STDERR "-getURL(PLS): first=$firstStream= title=$firstTitle=\n" if ($DEBUG);
457             } else { #m3u8:
458 0           (my $urlpath = ${$self->{'streams'}}[$idx]) =~ s#[^\/]+$##;
  0            
459 0           foreach my $line (@lines) {
460 0 0         if ($line =~ m#^\s*([^\#].+)$#) {
461 0           my $urlpart = $1;
462 0           $urlpart =~ s#^\s+##;
463 0           $urlpart =~ s#^\/##;
464 0 0         $firstStream = ($urlpart =~ m#https?\:#) ? $urlpart : ($urlpath . '/' . $urlpart);
465 0           last;
466             }
467             }
468 0 0         print STDERR "-getURL(m3u?): first=$firstStream=\n" if ($DEBUG);
469             }
470 0   0       return $firstStream || ${$self->{'streams'}}[$idx];
471             }
472 0           return ${$self->{'streams'}}[$idx];
  0            
473             }
474              
475             sub count
476             {
477 0     0 1   my $self = shift;
478 0           return $self->{'total'}; #TOTAL NUMBER OF PLAYABLE STREAM URLS FOUND.
479             }
480              
481             sub getType
482             {
483 0     0 1   my $self = shift;
484 0           return 'Radionomy'; #STATION TYPE (FOR PARENT StreamFinder MODULE).
485             }
486              
487             sub getID
488             {
489 0     0 1   my $self = shift;
490 0 0 0       return $self->{'fccid'} if (defined($_[0]) && $_[0] =~ /fcc/i); #STATION'S CALL LETTERS OR RADIONOMY-ID.
491 0           return $self->{'id'};
492             }
493              
494             sub getTitle
495             {
496 0     0 1   my $self = shift;
497 0 0 0       return $self->{'description'} if (defined($_[0]) && $_[0] =~ /^\-?(?:long|desc)/i);
498 0           return $self->{'title'}; #STATION'S TITLE(DESCRIPTION), IF ANY.
499             }
500              
501             sub getIconURL
502             {
503 0     0 1   my $self = shift;
504 0           return $self->{'iconurl'}; #URL TO THE STATION'S THUMBNAIL ICON, IF ANY.
505             }
506              
507             sub getIconData
508             {
509 0     0 1   my $self = shift;
510 0 0         return () unless ($self->{'iconurl'});
511 0           my $ua = LWP::UserAgent->new(@userAgentOps);
512 0           $ua->timeout($uops{'timeout'});
513 0           $ua->cookie_jar({});
514 0           $ua->env_proxy;
515 0           my $art_image = '';
516 0           my $response = $ua->get($self->{'iconurl'});
517 0 0         if ($response->is_success) {
518 0           $art_image = $response->decoded_content;
519             } else {
520 0 0         print STDERR $response->status_line if ($DEBUG);
521             }
522 0 0         return () unless ($art_image);
523 0           (my $image_ext = $self->{'iconurl'}) =~ s/^.+\.//;
524 0           $image_ext =~ s/[^A-Za-z].*$//;
525 0           return ($image_ext, $art_image);
526             }
527              
528             sub getImageURL
529             {
530 0     0 1   my $self = shift;
531 0           return $self->{'imageurl'}; #URL TO THE STATION'S BANNER IMAGE, IF ANY.
532             }
533              
534             sub getImageData
535             {
536 0     0 1   my $self = shift;
537 0 0         return () unless ($self->{'imageurl'});
538 0           my $ua = LWP::UserAgent->new(@userAgentOps);
539 0           $ua->timeout($uops{'timeout'});
540 0           $ua->cookie_jar({});
541 0           $ua->env_proxy;
542 0           my $art_image = '';
543 0           my $response = $ua->get($self->{'imageurl'});
544 0 0         if ($response->is_success) {
545 0           $art_image = $response->decoded_content;
546             } else {
547 0 0         print STDERR $response->status_line if ($DEBUG);
548             }
549 0 0         return () unless ($art_image);
550 0           my $image_ext = $self->{'imageurl'};
551 0 0         $image_ext = ($self->{'imageurl'} =~ /\.(\w+)$/) ? $1 : 'png';
552 0           $image_ext =~ s/[^A-Za-z].*$//;
553 0           return ($image_ext, $art_image);
554             }
555              
556             1