File Coverage

blib/lib/Parse/M3U/Extended.pm
Criterion Covered Total %
statement 21 21 100.0
branch n/a
condition 2 2 100.0
subroutine 5 5 100.0
pod 1 1 100.0
total 29 29 100.0


line stmt bran cond sub pod time code
1             package Parse::M3U::Extended;
2 1     1   30525 use warnings;
  1         2  
  1         30  
3 1     1   3 use strict;
  1         1  
  1         342  
4              
5             our $VERSION = 0.3;
6              
7             require Exporter;
8             our @ISA = 'Exporter';
9             our @EXPORT_OK = qw(m3u_parser $m3u_parser);
10              
11             =head1 NAME
12              
13             Parse::M3U::Extended - Extended M3U playlist parser
14              
15             =head1 SYNOPSIS
16              
17             use LWP::Simple;
18             use Parse::M3U::Extended qw(m3u_parser);
19              
20             my $m3u = get("http://example.com/foo.m3u");
21             my @items = m3u_parser($m3u);
22              
23             =head1 DESCRIPTION
24              
25             This module contains a simple parser for the Extended M3U
26             playlist format as used in e.g. HTTP Live Streaming. It also
27             supports the regular M3U format, usually found with digital
28             copies of music albums etc.
29              
30             =cut
31              
32             =head1 SUBROUTINES
33              
34             =head2 m3u_parser
35              
36             Takes a m3u playlist as a string and returns a list, with each
37             element is a hashref with the keys type and value. If the
38             playlist's first line is "#EXTM3U\n", then the elements in the
39             returned list can have type "directive", which has a "tag" key
40             and the value key is optional.
41              
42             {
43             type => 'comment',
44             value => 'a comment',
45             }
46              
47             {
48             type => 'item',
49             value => 'http://example.com/foo.mp3',
50             }
51              
52             {
53             type => 'directive',
54             tag => 'EXTM3U',
55             }
56              
57             {
58             type => 'directive',
59             tag => 'EXT-X-ALLOW-CACHE',
60             value => 'YES',
61             }
62              
63             =cut
64              
65             sub _simple {
66 5     5   5 my $type = shift;
67 5   100     36 my $key = shift // 'value';
68             return sub {{
69 22     22   53 type => $type,
70             $key => pop,
71 5         20 }};
72             }
73              
74             my @_tests = (
75             ['marker', qr/^#\s*(EXTM3U)\s*$/, _simple('directive', 'tag')],
76             ['directive', qr/^#\s*(EXT[^:]+)(?::(.+))?\s*/, sub {
77             shift() ? {
78             type => 'directive',
79             tag => $_[0],
80             (defined $_[1] ? (value => $_[1]) : ())
81             } : _simple('comment')->($_[0] . (defined $_[1] && ":$_[1]"))
82             }],
83             ['comment', qr/^#(.*)/, _simple('comment')],
84             ['item', qr/(.+)/x, _simple('item')],
85             );
86              
87              
88             sub m3u_parser {
89 5     5 1 3730 my @lines = split /\r?\n/, shift;
90 5         6 my @playlist;
91 5         8 my $m3ue = $lines[0] =~ /^#EXTM3U/;
92 5         8 for my $l (@lines) {
93 132         131 my @match = grep { defined $_->[2] }
94 33         30 map { [$_->[0], $_->[2], $l =~ /$_->[1]/] }
  132         340  
95             @_tests;
96 33         29 my ($type, $func, @vals) = @{shift @match};
  33         37  
97 33         43 push @playlist, $func->($m3ue, @vals);
98             }
99              
100 5         66 return @playlist;
101             }
102              
103             =head1 SEE ALSO
104              
105             =over
106              
107             =item * IETF Internet Draft: draft-pantos-http-live-streaming-08
108              
109             =back
110              
111             =head1 COPYRIGHT
112              
113             Copyright (c) 2012, 2016 - Olof Johansson
114             All rights reserved.
115              
116             This program is free software; you can redistribute it and/or
117             modify it under the same terms as Perl itself.
118              
119             =cut
120              
121             1;