File Coverage

blib/lib/Parse/M3U/Extended.pm
Criterion Covered Total %
statement 9 9 100.0
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 12 12 100.0


line stmt bran cond sub pod time code
1             package Parse::M3U::Extended;
2 1     1   54565 use warnings;
  1         3  
  1         35  
3 1     1   6 use strict;
  1         1  
  1         29  
4 1     1   1972 use Regexp::Grammars;
  1         23127  
  1         11  
5              
6             our $VERSION = 0.1;
7              
8             require Exporter;
9             our @ISA = 'Exporter';
10             our @EXPORT_OK = qw(m3u_parser $m3u_parser);
11              
12             =head1 NAME
13              
14             Parse::M3U::Extended - a simple Regexp::Grammars based M3UE parser
15              
16             =head1 SYNOPSIS
17            
18             use LWP::Simple;
19             use Parse::M3U::Extended qw(m3u_parser);
20              
21             my $m3u = get("http://example.com/foo.m3u");
22             my @items = m3u_parser($m3u);
23              
24             =head1 DESCRIPTION
25              
26             This module contains a simple parser for the Extended M3U format
27             as used in e.g. HTTP Live Streaming. It also supports the regular
28             M3U format, usually found with digital copies of music albums etc.
29              
30             =cut
31              
32             my $m3u_parser = qr{
33             <[Line]>+
34              
35             ##############
36            
37              
38            
39             (?: | | ) \n
40              
41            
42             (?: : ())?
43              
44            
45             \#
46              
47            
48             [^\#\n] [^\n]*
49              
50            
51             \#
52              
53            
54             [^\n]+
55             }xm;
56              
57             =head1 SUBROUTINES
58              
59             =head2 m3u_parser
60              
61             Takes a m3u playlist as a string and returns a list, with each
62             element is a hashref with the keys type and value. If the
63             playlist's first line is "#EXTM3U\n", then the elements in the
64             returned list can have type "directive", which has a "tag" key
65             and the value key is optional.
66              
67             {
68             type => 'comment',
69             value => 'a comment',
70             }
71              
72             {
73             type => 'item',
74             value => 'http://example.com/foo.mp3',
75             }
76              
77             {
78             type => 'directive',
79             tag => 'EXTM3U',
80             }
81              
82             {
83             type => 'directive',
84             tag => 'EXT-X-ALLOW-CACHE',
85             value => 'YES',
86             }
87              
88             Internally, it's using Regexp::Grammars, and the returned result
89             hash is then flattned. If you want to work with the result hash,
90             you can use $Parse::M3U::Extended::parser directly, but
91             documenting its structure is outside the scope of this manual.
92             Please refer to L.
93              
94             If the playlist supplied does not match an M3U file, undef is
95             returned.
96              
97             =cut
98              
99             sub m3u_parser {
100             my $playlist = shift;
101              
102             if ($playlist =~ /$m3u_parser/) {
103             return __analyze(\%/);
104             }
105             }
106              
107             # The analyze subroutine are used to flatten the structured returned
108             # from Regexp::Grammars. If you want the full tree, you can use
109             # $Parse::M3U::Extended::parser directly.
110             sub __analyze {
111             my $res = shift;
112             my $ext = 0;
113             my @ret;
114              
115             # If the first line is #EXTM3U, then it's an M3UE
116             if (exists $res->{Line}->[0]->{Directive} and
117             $res->{Line}->[0]->{Directive}->{Tag} eq 'EXTM3U') {
118             $ext = 1;
119             }
120              
121             for my $line (@{$res->{Line}}) {
122             if (exists $line->{Directive} and !$ext) {
123             my $dir = $line->{Directive};
124              
125             push @ret, {
126             type => 'comment',
127             value => "$dir->{Tag}:$dir->{Value}",
128             };
129             } elsif (exists $line->{Directive}) {
130             my $dir = $line->{Directive};
131              
132             push @ret, {
133             type => 'directive',
134             tag => $dir->{Tag},
135             exists $dir->{Value} ?
136             (value => $dir->{Value}) :
137             ()
138             };
139             } elsif (exists $line->{Comment}) {
140             push @ret, {
141             type => 'comment',
142             value => $line->{Comment}
143             };
144             } else {
145             push @ret, {
146             type => 'item',
147             value => $line->{Item}
148             };
149             }
150             }
151              
152             return @ret;
153             }
154              
155             =head1 SEE ALSO
156              
157             =over
158              
159             =item * IETF Internet Draft: draft-pantos-http-live-streaming-08
160              
161             =item * L
162              
163             =back
164              
165             =head1 COPYRIGHT
166              
167             Copyright (c) 2012 - Olof Johansson
168             All rights reserved.
169              
170             This program is free software; you can redistribute it and/or
171             modify it under the same terms as Perl itself.
172              
173             =cut
174              
175             1;