File Coverage

blib/lib/MP3/M3U/Parser/Export.pm
Criterion Covered Total %
statement 119 125 95.2
branch 32 58 55.1
condition 14 37 37.8
subroutine 13 13 100.0
pod 1 1 100.0
total 179 234 76.5


line stmt bran cond sub pod time code
1             package MP3::M3U::Parser::Export;
2 7     7   45 use strict;
  7         15  
  7         254  
3 7     7   39 use warnings;
  7         14  
  7         1350  
4 7     7   38 use vars qw( $VERSION );
  7         14  
  7         479  
5 7     7   46 use Carp qw( croak );
  7         13  
  7         1635  
6 7     7   7554 use MP3::M3U::Parser::Constants;
  7         24  
  7         1062  
7 7     7   7286 use MP3::M3U::Parser::Dummy;
  7         18  
  7         34537  
8              
9             $VERSION = '2.31';
10              
11             my %DEFAULT = (
12             format => 'html',
13             filename => 'mp3_m3u%s.%s',
14             encoding => 'ISO-8859-1',
15             drives => 'on',
16             overwrite => 0,
17             toscalar => 0,
18             );
19              
20             sub export {
21 7     7 1 1710 my($self, @args) = @_;
22 7 50       59 my %opt = @args % 2 ? () : @args;
23 7   33     71 my $format = $opt{'-format'} || $self->{expformat} || $DEFAULT{format };
24 7   66     78 my $encoding = $opt{'-encoding'} || $self->{encoding} || $DEFAULT{encoding };
25 7   33     114 my $drives = $opt{'-drives'} || $self->{expdrives} || $DEFAULT{drives };
26 7   66     87 my $overwrite = $opt{'-overwrite'} || $self->{overwrite} || $DEFAULT{overwrite};
27 7   66     74 my $to_scalar = $opt{'-toscalar'} || $self->{exptoscalar} || $DEFAULT{toscalar };
28 7   66     59 my $file = $opt{'-file'} || $self->_default_filename( $format );
29              
30 7 100       52 $file = $self->_locate_file($file) if ! $to_scalar;
31 7 100       259 my $OUTPUT = $format eq 'xml'
32             ? $self->_export_to_xml( $encoding )
33             : $self->_export_to_html( $encoding, $drives, $to_scalar, $file)
34             ;
35              
36 7 100       56 if ( $to_scalar ) {
37 2         5 ${$to_scalar} = $OUTPUT;
  2         6  
38             }
39             else {
40 5         81 my $fh = $self->_check_export_params( $file, $to_scalar, $overwrite );
41 5 50       14 print {$fh} $OUTPUT or croak "Can't print to FH: $!";
  5         107  
42 5         31 $fh->close;
43             }
44              
45 7         786 $self->{EXPORTF}++;
46 7 100       75 return $self if defined wantarray;
47 4         42 return;
48             }
49              
50             sub _default_filename {
51 2     2   5 my($self, $format) = @_;
52 2 50       7 croak 'Export format is missing' if ! $format;
53 2         17 return sprintf $DEFAULT{filename}, $self->{EXPORTF}, $format;
54             }
55              
56             sub _check_export_params {
57 5     5   17 my($self, $file, $to_scalar, $overwrite) = @_;
58 5         13 my $fh;
59 5 0 0     23 if ( $to_scalar && ( ! ref $to_scalar || ref $to_scalar ne 'SCALAR' ) ) {
      33        
60 0         0 croak '-toscalar must be a SCALAR reference';
61             }
62 5 50       21 if ( ! $to_scalar ) {
63 5 50 33     337 if ( -e $file && ! $overwrite ) {
64 0         0 croak "The export file '$file' exists & overwrite option is not set";
65             }
66 5         49 require IO::File;
67 5         61 $fh = IO::File->new;
68 5 50       258 $fh->open( $file, '>' )
69             or croak "I can't open export file '$file' for writing: $!";
70             }
71 5         856 return $fh;
72             }
73              
74             sub _export_to_html {
75 4     4   24 my($self, $encoding, $drives, $to_scalar, $file) = @_;
76 4         11 my $OUTPUT = EMPTY_STRING;
77             # I don't think that weird numbers in the html mean anything
78             # to anyone. So, if you didn't want to format seconds in your
79             # code, I'm overriding it here (only for export(); Outside
80             # export(), you'll get the old value):
81 4         9 my $old_seconds = $self->{seconds};
82 4         9 $self->{seconds} = 'format';
83 4         53 my %t;
84 4         34 @t{ qw( up cd data down ) } = split m{\Q\E}xms,
85             $self->_template;
86 4         43 foreach (keys %t) {
87 16         52 $t{$_} = $self->_trim( $t{$_} );
88             }
89 4 50       42 my $tmptime = $self->{TOTAL_TIME} ? $self->_seconds($self->{TOTAL_TIME})
90             : undef;
91 4         8 my @tmptime;
92              
93 4 50       230 if ($tmptime) {
94 4         19 @tmptime = split m{:}xms,$tmptime;
95 4 50       108 unshift @tmptime, 'Z' if $#tmptime <= 1;
96             }
97              
98 4 50       29 my $average = $self->{AVERAGE_TIME}
99             ? $self->_seconds( $self->{AVERAGE_TIME} )
100             : 'Unknown'
101             ;
102              
103 4 100       37 my $HTML = {
    50          
104             ENCODING => $encoding,
105             SONGS => $self->{TOTAL_SONGS},
106             TOTAL => $self->{TOTAL_FILES},
107             AVERTIME => $average,
108             FILE => $to_scalar ? EMPTY_STRING : $self->_locate_file($file),
109             TOTAL_FILES => $self->{TOTAL_FILES},
110             TOTAL_TIME => @tmptime ? [ @tmptime ] : EMPTY_STRING,
111             };
112              
113 4         46 $OUTPUT .= $self->_tcompile(template => $t{up}, params=> {HTML => $HTML});
114 4         17 my($song,$cdrom, $dlen);
115 4         10 foreach my $cd (@{ $self->{'_M3U_'} }) {
  4         21  
116 4 50       11 next if($#{$cd->{data}} < 0);
  4         34  
117 4 50       27 $cdrom .= "$cd->{drive}\\" if $drives ne 'off';
118 4         12 $cdrom .= $cd->{list};
119 4         42 $OUTPUT .= sprintf $t{cd}."\n", $cdrom;
120 4         12 foreach my $m3u (@{ $cd->{data} }) {
  4         91  
121 43         123 $song = $m3u->[ID3];
122 43 50       116 if ( ! $song ) {
123 0         0 my @test_path = split /\\/xms, $m3u->[PATH];
124 0   0     0 my $tp = pop @test_path || $m3u->[PATH];
125 0         0 my @test_file = split /\./xms, $song;
126 0   0     0 $song = $test_file[0] || $tp;
127             }
128 43 50       681 $dlen = $m3u->[LEN] ? $self->_seconds($m3u->[LEN]) : ' ';
129 43 50       211 $song = $song ? $self->_escape($song) : ' ';
130 43         1055 $OUTPUT .= sprintf "%s\n", $self->_tcompile(
131             template => $t{data},
132             params => {
133             data => {
134             len => $dlen,
135             song => $song,
136             }
137             }
138             );
139             }
140 4         18 $cdrom = EMPTY_STRING;
141             }
142 4         14 $OUTPUT .= $t{down};
143 4         12 $self->{seconds} = $old_seconds; # restore
144 4         60 return $OUTPUT;
145             }
146              
147             sub _export_to_xml {
148 3     3   9 my($self, $encoding) = @_;
149 3         7 my $OUTPUT = EMPTY_STRING;
150 3 50       54 $self->{TOTAL_TIME} = $self->_seconds($self->{TOTAL_TIME})
151             if $self->{TOTAL_TIME} > 0;
152 3         19 $OUTPUT .= sprintf qq~\n~, $encoding;
153 3         24 $OUTPUT .= sprintf qq~\n~,
154             $self->{TOTAL_FILES},
155             $self->{TOTAL_SONGS},
156             $self->{TOTAL_TIME},
157             $self->{AVERAGE_TIME};
158 3         15 my $sc = 0;
159 3         14 foreach my $cd (@{ $self->{'_M3U_'} }) {
  3         11  
160 3         7 $sc = $#{$cd->{data}}+1;
  3         16  
161 3 50       13 next if ! $sc;
162 3         23 $OUTPUT .= sprintf qq~\n~,
163             $cd->{list},
164             $cd->{drive},
165             $sc;
166 3         6 foreach my $m3u (@{ $cd->{data} }) {
  3         11  
167 42   50     17794 $OUTPUT .= sprintf qq~%s\n~,
      50        
168             $self->_escape( $m3u->[ID3] ) || EMPTY_STRING,
169             $m3u->[LEN] || EMPTY_STRING,
170             $self->_escape( $m3u->[PATH] );
171             }
172 3         64 $OUTPUT .= "\n";
173 3         11 $sc = 0;
174             }
175 3         12 $OUTPUT .= "\n";
176 3         17 return $OUTPUT;
177             }
178              
179             # compile template
180             sub _tcompile {
181 47     47   129 my($self, @args) = @_;
182 47         80 my $class = ref $self;
183 47 50       283 croak 'Invalid number of parameters' if @args % 2;
184 47         6434 require Text::Template;
185 47         21262 my %opt = @args;
186 47 50       266 my $t = Text::Template->new(
187             TYPE => 'STRING',
188             SOURCE => $opt{template},
189             DELIMITERS => ['<%', '%>'],
190             ) or croak "Couldn't construct the template: $Text::Template::ERROR";
191              
192 47         6235 my @globals;
193 47         68 foreach my $p ( keys %{ $opt{params} } ) {
  47         170  
194 47         125 my $ref = ref $opt{params}->{$p};
195 47 0       107 my $prefix = $ref eq 'HASH' ? q{%}
    50          
196             : $ref eq 'ARRAY' ? q{@}
197             : q{$}
198             ;
199 47         146 push @globals, $prefix . $p;
200             }
201              
202 47 50       332 my $text = $t->fill_in(PACKAGE => $class . '::Dummy',
203             PREPEND => sprintf('use strict;use vars qw[%s];',
204             join q{ }, @globals ),
205             HASH => $opt{params},
206             ) or croak "Couldn't fill in template: $Text::Template::ERROR";
207 47         58110 return $text;
208             }
209              
210             # HTML template code
211             sub _template {
212 3     3   74 return <<'MP3M3UPARSERTEMPLATE';
213            
214             "http://www.w3.org/TR/html4/loose.dtd">
215            
216            
217             MP3::M3U::Parser Generated PlayList
218            
219            
220             content="text/html; charset=<%$HTML{ENCODING}%>">
221              
222            
274              
275            
276              
277            
278              
279            
280            

MP3::M3U::Parser
281            

playlist
282            
283              
284            
285            
286              
287            
288            
289             <%$HTML{SONGS}%> tracks and
290             <%$HTML{TOTAL}%> Lists in playlist,
291             average track length:
292             <%$HTML{AVERTIME}%>.
293            
294             Playlist length: <%
295             my $time;
296             if ($HTML{TOTAL_TIME}) {
297             my @time = @{$HTML{TOTAL_TIME}};
298             $time = qq~ $time[0]
299             hours ~ if $time[0] ne 'Z';
300             $time .= qq~
301             $time[1]
302             minutes
303             $time[2]
304             seconds. ~;
305             } else {
306             $time = qq~Unknown.~;
307             }
308             $time;
309              
310             %>
311             <%
312             qq~Right-click here
313             to save this HTML file.~ if $HTML{FILE}
314             %>
315            
316            
317            
318              
319            
320            
321            

<%

322             $HTML{TOTAL_FILES} > 1 ? "Playlists and Files" : "Playlist files";
323             %>:
324              
325            
326              
327            
328            
%s
329            
330            
<%$data{len}%><%$data{song}%>
331            
332              
333            
334            
335            
336             This HTML File is based on
337             WinAmp`s HTML List.
338            
339            
340             MP3M3UPARSERTEMPLATE
341             }
342              
343             1;
344              
345             __END__