File Coverage

blib/lib/MP3/M3U/Parser/Export.pm
Criterion Covered Total %
statement 116 122 95.0
branch 32 58 55.1
condition 13 37 35.1
subroutine 12 12 100.0
pod 1 1 100.0
total 174 230 75.6


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

MP3::M3U::Parser
280            

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

<%

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