| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package MP3::M3U::Parser::Export; |
|
2
|
7
|
|
|
7
|
|
30
|
use strict; |
|
|
7
|
|
|
|
|
9
|
|
|
|
7
|
|
|
|
|
166
|
|
|
3
|
7
|
|
|
7
|
|
19
|
use warnings; |
|
|
7
|
|
|
|
|
11
|
|
|
|
7
|
|
|
|
|
180
|
|
|
4
|
7
|
|
|
7
|
|
24
|
use vars qw( $VERSION ); |
|
|
7
|
|
|
|
|
9
|
|
|
|
7
|
|
|
|
|
250
|
|
|
5
|
7
|
|
|
7
|
|
23
|
use Carp qw( croak ); |
|
|
7
|
|
|
|
|
7
|
|
|
|
7
|
|
|
|
|
447
|
|
|
6
|
7
|
|
|
7
|
|
2211
|
use MP3::M3U::Parser::Constants; |
|
|
7
|
|
|
|
|
10
|
|
|
|
7
|
|
|
|
|
552
|
|
|
7
|
7
|
|
|
7
|
|
2487
|
use MP3::M3U::Parser::Dummy; |
|
|
7
|
|
|
|
|
11
|
|
|
|
7
|
|
|
|
|
8854
|
|
|
8
|
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
$VERSION = '2.32'; |
|
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
|
878
|
my($self, @args) = @_; |
|
22
|
7
|
50
|
|
|
|
36
|
my %opt = @args % 2 ? () : @args; |
|
23
|
7
|
|
33
|
|
|
38
|
my $format = $opt{'-format'} || $self->{expformat} || $DEFAULT{format }; |
|
24
|
7
|
|
66
|
|
|
43
|
my $encoding = $opt{'-encoding'} || $self->{encoding} || $DEFAULT{encoding }; |
|
25
|
7
|
|
33
|
|
|
38
|
my $drives = $opt{'-drives'} || $self->{expdrives} || $DEFAULT{drives }; |
|
26
|
7
|
|
66
|
|
|
41
|
my $overwrite = $opt{'-overwrite'} || $self->{overwrite} || $DEFAULT{overwrite}; |
|
27
|
7
|
|
33
|
|
|
35
|
my $to_scalar = $opt{'-toscalar'} || $self->{exptoscalar} || $DEFAULT{toscalar }; |
|
28
|
7
|
|
66
|
|
|
30
|
my $file = $opt{'-file'} || $self->_default_filename( $format ); |
|
29
|
|
|
|
|
|
|
|
|
30
|
7
|
100
|
|
|
|
30
|
$file = $self->_locate_file($file) if ! $to_scalar; |
|
31
|
7
|
100
|
|
|
|
59
|
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
|
|
|
|
23
|
if ( $to_scalar ) { |
|
37
|
2
|
|
|
|
|
2
|
${$to_scalar} = $OUTPUT; |
|
|
2
|
|
|
|
|
4
|
|
|
38
|
|
|
|
|
|
|
} |
|
39
|
|
|
|
|
|
|
else { |
|
40
|
5
|
|
|
|
|
58
|
my $fh = $self->_check_export_params( $file, $to_scalar, $overwrite ); |
|
41
|
5
|
50
|
|
|
|
9
|
print {$fh} $OUTPUT or croak "Can't print to FH: $!"; |
|
|
5
|
|
|
|
|
51
|
|
|
42
|
5
|
|
|
|
|
22
|
$fh->close; |
|
43
|
|
|
|
|
|
|
} |
|
44
|
|
|
|
|
|
|
|
|
45
|
7
|
|
|
|
|
235
|
$self->{EXPORTF}++; |
|
46
|
7
|
100
|
|
|
|
46
|
return $self if defined wantarray; |
|
47
|
4
|
|
|
|
|
20
|
return; |
|
48
|
|
|
|
|
|
|
} |
|
49
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
sub _default_filename { |
|
51
|
2
|
|
|
2
|
|
3
|
my($self, $format) = @_; |
|
52
|
2
|
50
|
|
|
|
5
|
croak 'Export format is missing' if ! $format; |
|
53
|
2
|
|
|
|
|
11
|
return sprintf $DEFAULT{filename}, $self->{EXPORTF}, $format; |
|
54
|
|
|
|
|
|
|
} |
|
55
|
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
sub _check_export_params { |
|
57
|
5
|
|
|
5
|
|
11
|
my($self, $file, $to_scalar, $overwrite) = @_; |
|
58
|
5
|
|
|
|
|
8
|
my $fh; |
|
59
|
5
|
0
|
0
|
|
|
15
|
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
|
|
|
|
16
|
if ( ! $to_scalar ) { |
|
63
|
5
|
50
|
33
|
|
|
160
|
if ( -e $file && ! $overwrite ) { |
|
64
|
0
|
|
|
|
|
0
|
croak "The export file '$file' exists & overwrite option is not set"; |
|
65
|
|
|
|
|
|
|
} |
|
66
|
5
|
|
|
|
|
28
|
require IO::File; |
|
67
|
5
|
|
|
|
|
40
|
$fh = IO::File->new; |
|
68
|
5
|
50
|
|
|
|
183
|
$fh->open( $file, '>' ) |
|
69
|
|
|
|
|
|
|
or croak "I can't open export file '$file' for writing: $!"; |
|
70
|
|
|
|
|
|
|
} |
|
71
|
5
|
|
|
|
|
531
|
return $fh; |
|
72
|
|
|
|
|
|
|
} |
|
73
|
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
sub _export_to_html { |
|
75
|
4
|
|
|
4
|
|
8
|
my($self, $encoding, $drives, $to_scalar, $file) = @_; |
|
76
|
4
|
|
|
|
|
4
|
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
|
|
|
|
|
6
|
my $old_seconds = $self->{seconds}; |
|
82
|
4
|
|
|
|
|
6
|
$self->{seconds} = 'format'; |
|
83
|
4
|
|
|
|
|
5
|
my %t; |
|
84
|
4
|
|
|
|
|
23
|
@t{ qw( up cd data down ) } = split m{\Q\E}xms, |
|
85
|
|
|
|
|
|
|
$self->_template; |
|
86
|
4
|
|
|
|
|
24
|
foreach (keys %t) { |
|
87
|
16
|
|
|
|
|
31
|
$t{$_} = $self->_trim( $t{$_} ); |
|
88
|
|
|
|
|
|
|
} |
|
89
|
|
|
|
|
|
|
my $tmptime = $self->{TOTAL_TIME} ? $self->_seconds($self->{TOTAL_TIME}) |
|
90
|
4
|
50
|
|
|
|
26
|
: undef; |
|
91
|
4
|
|
|
|
|
9
|
my @tmptime; |
|
92
|
|
|
|
|
|
|
|
|
93
|
4
|
50
|
|
|
|
15
|
if ($tmptime) { |
|
94
|
4
|
|
|
|
|
12
|
@tmptime = split m{:}xms,$tmptime; |
|
95
|
4
|
50
|
|
|
|
20
|
unshift @tmptime, 'Z' if $#tmptime <= 1; |
|
96
|
|
|
|
|
|
|
} |
|
97
|
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
my $average = $self->{AVERAGE_TIME} |
|
99
|
|
|
|
|
|
|
? $self->_seconds( $self->{AVERAGE_TIME} ) |
|
100
|
4
|
50
|
|
|
|
17
|
: 'Unknown' |
|
101
|
|
|
|
|
|
|
; |
|
102
|
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
my $HTML = { |
|
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
|
4
|
100
|
|
|
|
30
|
TOTAL_TIME => @tmptime ? [ @tmptime ] : EMPTY_STRING, |
|
|
|
50
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
}; |
|
112
|
|
|
|
|
|
|
|
|
113
|
4
|
|
|
|
|
29
|
$OUTPUT .= $self->_tcompile(template => $t{up}, params=> {HTML => $HTML}); |
|
114
|
4
|
|
|
|
|
11
|
my($song,$cdrom, $dlen); |
|
115
|
4
|
|
|
|
|
7
|
foreach my $cd (@{ $self->{'_M3U_'} }) { |
|
|
4
|
|
|
|
|
12
|
|
|
116
|
4
|
50
|
|
|
|
6
|
next if($#{$cd->{data}} < 0); |
|
|
4
|
|
|
|
|
23
|
|
|
117
|
4
|
50
|
|
|
|
17
|
$cdrom .= "$cd->{drive}\\" if $drives ne 'off'; |
|
118
|
4
|
|
|
|
|
9
|
$cdrom .= $cd->{list}; |
|
119
|
4
|
|
|
|
|
18
|
$OUTPUT .= sprintf $t{cd}."\n", $cdrom; |
|
120
|
4
|
|
|
|
|
5
|
foreach my $m3u (@{ $cd->{data} }) { |
|
|
4
|
|
|
|
|
10
|
|
|
121
|
43
|
|
|
|
|
65
|
$song = $m3u->[ID3]; |
|
122
|
43
|
50
|
|
|
|
73
|
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
|
|
|
|
140
|
$dlen = $m3u->[LEN] ? $self->_seconds($m3u->[LEN]) : ' '; |
|
129
|
43
|
50
|
|
|
|
123
|
$song = $song ? $self->_escape($song) : ' '; |
|
130
|
|
|
|
|
|
|
$OUTPUT .= sprintf "%s\n", $self->_tcompile( |
|
131
|
|
|
|
|
|
|
template => $t{data}, |
|
132
|
43
|
|
|
|
|
651
|
params => { |
|
133
|
|
|
|
|
|
|
data => { |
|
134
|
|
|
|
|
|
|
len => $dlen, |
|
135
|
|
|
|
|
|
|
song => $song, |
|
136
|
|
|
|
|
|
|
} |
|
137
|
|
|
|
|
|
|
} |
|
138
|
|
|
|
|
|
|
); |
|
139
|
|
|
|
|
|
|
} |
|
140
|
4
|
|
|
|
|
11
|
$cdrom = EMPTY_STRING; |
|
141
|
|
|
|
|
|
|
} |
|
142
|
4
|
|
|
|
|
9
|
$OUTPUT .= $t{down}; |
|
143
|
4
|
|
|
|
|
8
|
$self->{seconds} = $old_seconds; # restore |
|
144
|
4
|
|
|
|
|
30
|
return $OUTPUT; |
|
145
|
|
|
|
|
|
|
} |
|
146
|
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
sub _export_to_xml { |
|
148
|
3
|
|
|
3
|
|
3
|
my($self, $encoding) = @_; |
|
149
|
3
|
|
|
|
|
4
|
my $OUTPUT = EMPTY_STRING; |
|
150
|
|
|
|
|
|
|
$self->{TOTAL_TIME} = $self->_seconds($self->{TOTAL_TIME}) |
|
151
|
3
|
50
|
|
|
|
22
|
if $self->{TOTAL_TIME} > 0; |
|
152
|
3
|
|
|
|
|
11
|
$OUTPUT .= sprintf qq~\n~, $encoding; |
|
153
|
|
|
|
|
|
|
$OUTPUT .= sprintf qq~\n~, |
|
154
|
|
|
|
|
|
|
$self->{TOTAL_FILES}, |
|
155
|
|
|
|
|
|
|
$self->{TOTAL_SONGS}, |
|
156
|
|
|
|
|
|
|
$self->{TOTAL_TIME}, |
|
157
|
3
|
|
|
|
|
14
|
$self->{AVERAGE_TIME}; |
|
158
|
3
|
|
|
|
|
4
|
my $sc = 0; |
|
159
|
3
|
|
|
|
|
4
|
foreach my $cd (@{ $self->{'_M3U_'} }) { |
|
|
3
|
|
|
|
|
8
|
|
|
160
|
3
|
|
|
|
|
3
|
$sc = $#{$cd->{data}}+1; |
|
|
3
|
|
|
|
|
7
|
|
|
161
|
3
|
50
|
|
|
|
14
|
next if ! $sc; |
|
162
|
|
|
|
|
|
|
$OUTPUT .= sprintf qq~\n~, |
|
163
|
|
|
|
|
|
|
$cd->{list}, |
|
164
|
|
|
|
|
|
|
$cd->{drive}, |
|
165
|
3
|
|
|
|
|
14
|
$sc; |
|
166
|
3
|
|
|
|
|
5
|
foreach my $m3u (@{ $cd->{data} }) { |
|
|
3
|
|
|
|
|
7
|
|
|
167
|
42
|
|
50
|
|
|
471
|
$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
|
|
|
|
|
28
|
$OUTPUT .= "\n"; |
|
173
|
3
|
|
|
|
|
6
|
$sc = 0; |
|
174
|
|
|
|
|
|
|
} |
|
175
|
3
|
|
|
|
|
5
|
$OUTPUT .= "\n"; |
|
176
|
3
|
|
|
|
|
8
|
return $OUTPUT; |
|
177
|
|
|
|
|
|
|
} |
|
178
|
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
# compile template |
|
180
|
|
|
|
|
|
|
sub _tcompile { |
|
181
|
47
|
|
|
47
|
|
110
|
my($self, @args) = @_; |
|
182
|
47
|
|
|
|
|
65
|
my $class = ref $self; |
|
183
|
47
|
50
|
|
|
|
112
|
croak 'Invalid number of parameters' if @args % 2; |
|
184
|
47
|
|
|
|
|
2609
|
require Text::Template; |
|
185
|
47
|
|
|
|
|
10169
|
my %opt = @args; |
|
186
|
|
|
|
|
|
|
my $t = Text::Template->new( |
|
187
|
|
|
|
|
|
|
TYPE => 'STRING', |
|
188
|
|
|
|
|
|
|
SOURCE => $opt{template}, |
|
189
|
47
|
50
|
|
|
|
172
|
DELIMITERS => ['<%', '%>'], |
|
190
|
|
|
|
|
|
|
) or croak "Couldn't construct the template: $Text::Template::ERROR"; |
|
191
|
|
|
|
|
|
|
|
|
192
|
47
|
|
|
|
|
3277
|
my @globals; |
|
193
|
47
|
|
|
|
|
46
|
foreach my $p ( keys %{ $opt{params} } ) { |
|
|
47
|
|
|
|
|
111
|
|
|
194
|
47
|
|
|
|
|
78
|
my $ref = ref $opt{params}->{$p}; |
|
195
|
47
|
0
|
|
|
|
79
|
my $prefix = $ref eq 'HASH' ? q{%} |
|
|
|
50
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
: $ref eq 'ARRAY' ? q{@} |
|
197
|
|
|
|
|
|
|
: q{$} |
|
198
|
|
|
|
|
|
|
; |
|
199
|
47
|
|
|
|
|
89
|
push @globals, $prefix . $p; |
|
200
|
|
|
|
|
|
|
} |
|
201
|
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
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
|
47
|
50
|
|
|
|
218
|
) or croak "Couldn't fill in template: $Text::Template::ERROR"; |
|
207
|
47
|
|
|
|
|
27091
|
return $text; |
|
208
|
|
|
|
|
|
|
} |
|
209
|
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
# HTML template code |
|
211
|
|
|
|
|
|
|
sub _template { |
|
212
|
3
|
|
|
3
|
|
45
|
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
|
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
|
|
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
|
|
|
|
|
|
|
|
|
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__ |