1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
|
package Music::Lyrics::LRC;
# Force me to write this properly
use strict;
use warnings;
use utf8;
# Include required modules
use Carp;
use English '-no_match_vars';
# Target reasonably old Perl
use 5.006;
# Declare package version
our $VERSION = '0.01';
# Patterns to match elements of the LRC file; these are somewhat tolerant
our %RE = (
# A blank line
blank => qr{
\A # Start of string
\s* # Any whitespace
\z # End of string
}msx,
# A meta tag line
tag => qr{
\A # Start of string
\s* # Any whitespace
\[ # Opening left bracket
([^:\v]+) # Tag name, capture
: # Colon
(.*) # Tag value, capture
\] # Closing right bracket
\s* # Any whitespace
\z # End of string
}msx,
# A lyric line
lyric => qr{
\A # Start of string
\s* # Any whitespace
\[ # Opening left bracket
(\d+) # Minutes, capture
: # Colon
(\d{2}) # Seconds, capture
[.] # Period
(\d{2}) # Hundredths of a second, capture
\] # Closing right bracket
\h* # Any horizontal whitespace
(.*\S) # Lyric line, capture
\s* # Any whitespace
\z # End of string
}msx,
);
# Parser functions to consume and process captures from the above patterns
my %parsers = (
# A meta tag line
tag => sub {
my ( $self, $tag, $value ) = @_;
$self->set_tag( $tag, $value );
},
# A lyric line
lyric => sub {
my ( $self, %ts, $text );
( $self, @ts{qw(min sec csec)}, $text ) = @_;
# Calculate the number of milliseconds
my $msec = $self->ts_to_msec( \%ts );
# Push a lyric hashref onto our list
$self->add_lyric( $msec, $text );
},
);
# Oldschool constructor
sub new {
my ($class) = @_;
# Start with empty tags and lyrics
my %self;
$self{tags} = {};
$self{lyrics} = [];
# Perlician, bless thyself
return bless \%self, $class;
}
# Read-only accessor for lyrics
sub lyrics {
my $self = shift;
my @lyrics = @{ $self->{lyrics} };
return \@lyrics;
}
# Read-only accessor for tags
sub tags {
my $self = shift;
my %tags = %{ $self->{tags} };
return \%tags;
}
# Add a new lyric to the object
sub add_lyric {
my ( $self, $time, $text ) = @_;
# Check parameters
int $time >= 0
or croak 'Bad lyric time';
$text !~ m/ \v /msx
or croak 'Bad lyric line';
# Push the lyric onto our list
return push @{ $self->{lyrics} },
{
time => $time,
text => $text,
};
}
# Set the value of a tag
sub set_tag {
my ( $self, $name, $value );
# Check parameters
$name !~ m/ [:\v] /msx
or croak 'Bad tag name';
# Tag content cannot have vertical whitespace
$value !~ m/ \v /msx
or croak 'Bad tag value';
# Set the tag's value on our hash
return ( $self->{tags}{$name} = $value );
}
# Unset a tag
sub unset_tag {
my ( $self, $name );
# Check parameters
$name !~ m/ [:\v] /msx
or croak 'Bad tag name';
exists $self->{tags}{$name}
or carp 'Tag not set';
# Delete the tag's value
return defined delete $self->{tags}{$name};
}
# Parse an LRC file from a given filehandle
sub load {
my ( $self, $fh ) = @_;
# Panic if this doesn't look like a filehandle
ref $fh eq 'GLOB'
or croak 'Not a filehandle';
# Iterate through lines
LINE: while ( my $line = <$fh> ) {
# Iterate through line types until one matches
TYPE: for my $type (qw(lyric tag blank)) {
my @vals = $line =~ $RE{$type}
or next TYPE;
exists $parsers{$type}
or next LINE;
$parsers{$type}->( $self, @vals );
next LINE;
}
# This line doesn't match anything we understand, complain but persist
warn "Unknown format for line $NR\n";
}
# Check we got to the end of the file
eof $fh or die "Failed file read: $ERRNO\n";
# All done, return the number of lyrics we have now
return scalar @{ $self->lyrics };
}
# Write an LRC file to a given filehandle
sub save {
my ( $self, $fh ) = @_;
# Panic if this doesn't look like a filehandle
ref $fh eq 'GLOB'
or croak 'Not a filehandle';
# Start counting lines written
my $lines = 0;
# Iterate through tags
for my $name ( keys %{ $self->{tags} } ) {
my $value = $self->{tags}{$name};
$lines += printf {$fh} "[%s:%s]\n", $name, $value
or die "Failed tag write: $ERRNO\n";
}
# Iterate through lyrics
for my $lyric ( @{ $self->{lyrics} } ) {
# Convert milliseconds to timestamp hash
my $msec = $lyric->{time};
my %ts = %{ $self->msec_to_ts($msec) };
# Write the line to the file, counting the lines
$lines += printf {$fh} "[%02u:%02u:%02u]%s\n",
@ts{qw(min sec csec)}, $lyric->{text}
or die "Failed lyric write: $ERRNO\n";
}
# Return the number of lines written
return $lines;
}
# Factors for timestamp<->millisecond conversions
our %MSF = (
min => 60_000,
sec => 1_000,
csec => 10,
);
# Convert an LRC timestamp hashref to milliseconds
sub ts_to_msec {
my ( $self, $ts ) = @_;
my $msec = 0;
for my $k ( keys %{$ts} ) {
$msec += $ts->{$k} * $MSF{$k};
}
return $msec;
}
# Convert milliseconds to an LRC timestamp hashref
sub msec_to_ts {
my ( $self, $msec ) = @_;
my %ts;
for my $k (qw(min sec csec)) {
$ts{$k} = int $msec / $MSF{$k};
$msec %= $MSF{$k};
}
return \%ts;
}
1;
__END__
=pod
=for stopwords
LRC tradename licensable MERCHANTABILITY
=head1 NAME
Music::Lyrics::LRC - Manipulate LRC karaoke lyrics files
=head1 VERSION
Version 0.01
=head1 SYNOPSIS
This section to be completed.
=head1 DESCRIPTION
Read, write, and do simple manipulations of the LRC lyrics files used for some
karaoke devices.
=head1 SUBROUTINES/METHODS
This section to be completed.
=head1 DIAGNOSTICS
This section to be completed.
=head1 CONFIGURATION AND ENVIRONMENT
None to speak of.
=head1 DEPENDENCIES
=over 4
=item *
Perl 5.6 or newer
=item *
C<Carp>
=item *
C<English>
=back
=head1 INCOMPATIBILITIES
Probably.
=head1 BUGS AND LIMITATIONS
Yes.
=head1 AUTHOR
Tom Ryder C<< <tom@sanctum.geek.nz> >>
=head1 LICENSE AND COPYRIGHT
Copyright (C) 2017 Tom Ryder
This program is free software; you can redistribute it and/or modify it under
the terms of the Artistic License (2.0). You may obtain a copy of the full
license at:
<http://www.perlfoundation.org/artistic_license_2_0>
Any use, modification, and distribution of the Standard or Modified Versions is
governed by this Artistic License. By using, modifying or distributing the
Package, you accept this license. Do not use, modify, or distribute the
Package, if you do not accept this license.
If your Modified Version has been derived from a Modified Version made by
someone other than you, you are nevertheless required to ensure that your
Modified Version complies with the requirements of this license.
This license does not grant you the right to use any trademark, service mark,
tradename, or logo of the Copyright Holder.
This license includes the non-exclusive, worldwide, free-of-charge patent
license to make, have made, use, offer to sell, sell, import and otherwise
transfer the Package with respect to any patent claims licensable by the
Copyright Holder that are necessarily infringed by the Package. If you
institute patent litigation (including a cross-claim or counterclaim) against
any party alleging that the Package constitutes direct or contributory patent
infringement, then this Artistic License to you shall terminate on the date
that such litigation is filed.
Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND
CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED
WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR
NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW.
UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR
ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY
OUT OF THE USE OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
DAMAGE.
=cut
|