tsiry-sandratraina.com
A modern Music Player Daemon based on Rockbox open source high quality audio player
libadwaita
audio
rust
zig
deno
mpris
rockbox
mpd
1#############################################################################
2# This is
3# http://search.cpan.org/~amolloy/Ogg-Vorbis-Header-PurePerl-0.07/PurePerl.pm
4# written by Andrew Molloy
5# Code under GNU GENERAL PUBLIC LICENCE v2
6# $Id$
7#############################################################################
8
9package vorbiscomm;
10
11use 5.005;
12use strict;
13use warnings;
14
15use Fcntl qw/SEEK_END/;
16
17our $VERSION = '0.07';
18
19sub new
20{
21 my $class = shift;
22 my $file = shift;
23
24 return load($class, $file);
25}
26
27sub load
28{
29 my $class = shift;
30 my $file = shift;
31 my $from_new = shift;
32 my %data;
33 my $self;
34
35 # there must be a better way...
36 if ($class eq 'vorbiscomm')
37 {
38 $self = bless \%data, $class;
39 }
40 else
41 {
42 $self = $class;
43 }
44
45 if ($self->{'FILE_LOADED'})
46 {
47 return $self;
48 }
49
50 $self->{'FILE_LOADED'} = 1;
51
52 # check that the file exists and is readable
53 unless ( -e $file && -r _ )
54 {
55 warn "File does not exist or cannot be read.";
56 # file does not exist, can't do anything
57 return undef;
58 }
59 # open up the file
60 open FILE, $file;
61 # make sure dos-type systems can handle it...
62 binmode FILE;
63
64 $data{'filename'} = $file;
65 $data{'fileHandle'} = \*FILE;
66
67 if (_init(\%data)) {
68 _loadInfo(\%data);
69 _loadComments(\%data);
70 _calculateTrackLength(\%data);
71 }
72
73 close FILE;
74
75 return $self;
76}
77
78sub info
79{
80 my $self = shift;
81 my $key = shift;
82
83 # if the user did not supply a key, return the entire hash
84 unless ($key)
85 {
86 return $self->{'INFO'};
87 }
88
89 # otherwise, return the value for the given key
90 return $self->{'INFO'}{lc $key};
91}
92
93sub comment_tags
94{
95 my $self = shift;
96
97 if ( $self && $self->{'COMMENT_KEYS'} ) {
98 return @{$self->{'COMMENT_KEYS'}};
99 }
100
101 return undef;
102}
103
104sub comment
105{
106 my $self = shift;
107 my $key = shift;
108
109 # if the user supplied key does not exist, return undef
110 unless($self->{'COMMENTS'}{lc $key})
111 {
112 return undef;
113 }
114
115 return @{$self->{'COMMENTS'}{lc $key}};
116}
117
118sub add_comments
119{
120 warn "Ogg::Vorbis::Header::PurePerl add_comments() unimplemented.";
121}
122
123sub edit_comment
124{
125 warn "Ogg::Vorbis::Header::PurePerl edit_comment() unimplemented.";
126}
127
128sub delete_comment
129{
130 warn "Ogg::Vorbis::Header::PurePerl delete_comment() unimplemented.";
131}
132
133sub clear_comments
134{
135 warn "Ogg::Vorbis::Header::PurePerl clear_comments() unimplemented.";
136}
137
138sub path
139{
140 my $self = shift;
141
142 return $self->{'fileName'};
143}
144
145sub write_vorbis
146{
147 warn "Ogg::Vorbis::Header::PurePerl write_vorbis unimplemented.";
148}
149
150# "private" methods
151
152sub _init
153{
154 my $data = shift;
155 my $fh = $data->{'fileHandle'};
156 my $byteCount = 0;
157
158 # check the header to make sure this is actually an Ogg-Vorbis file
159 $byteCount = _checkHeader($data);
160
161 unless($byteCount)
162 {
163 # if it's not, we can't do anything
164 return undef;
165 }
166
167 $data->{'startInfoHeader'} = $byteCount;
168 return 1; # Success
169}
170
171sub _checkHeader
172{
173 my $data = shift;
174 my $fh = $data->{'fileHandle'};
175 my $buffer;
176 my $pageSegCount;
177 my $byteCount = 0; # stores how far into the file we've read,
178 # so later reads into the file can skip right
179 # past all of the header stuff
180
181 # check that the first four bytes are 'OggS'
182 read($fh, $buffer, 4);
183 if ($buffer ne 'OggS')
184 {
185 warn "This is not an Ogg bitstream (no OggS header).";
186 return undef;
187 }
188 $byteCount += 4;
189
190 # check the stream structure version (1 byte, should be 0x00)
191 read($fh, $buffer, 1);
192 if (ord($buffer) != 0x00)
193 {
194 warn "This is not an Ogg bitstream (invalid structure version).";
195 return undef;
196 }
197 $byteCount += 1;
198
199 # check the header type flag
200 # This is a bitfield, so technically we should check all of the bits
201 # that could potentially be set. However, the only value this should
202 # possibly have at the beginning of a proper Ogg-Vorbis file is 0x02,
203 # so we just check for that. If it's not that, we go on anyway, but
204 # give a warning (this behavior may (should?) be modified in the future.
205 read($fh, $buffer, 1);
206 if (ord($buffer) != 0x02)
207 {
208 warn "Invalid header type flag (trying to go ahead anyway).";
209 }
210 $byteCount += 1;
211
212 # skip to the page_segments count
213 read($fh, $buffer, 20);
214 $byteCount += 20;
215 # we do nothing with this data
216
217 # read the number of page segments
218 read($fh, $buffer, 1);
219 $pageSegCount = ord($buffer);
220 $byteCount += 1;
221
222 # read $pageSegCount bytes, then throw 'em out
223 read($fh, $buffer, $pageSegCount);
224 $byteCount += $pageSegCount;
225
226 # check packet type. Should be 0x01 (for indentification header)
227 read($fh, $buffer, 1);
228 if (ord($buffer) != 0x01)
229 {
230 warn "Wrong vorbis header type, giving up.";
231 return undef;
232 }
233 $byteCount += 1;
234
235 # check that the packet identifies itself as 'vorbis'
236 read($fh, $buffer, 6);
237 if ($buffer ne 'vorbis')
238 {
239 warn "This does not appear to be a vorbis stream, giving up.";
240 return undef;
241 }
242 $byteCount += 6;
243
244 # at this point, we assume the bitstream is valid
245 return $byteCount;
246}
247
248sub _loadInfo
249{
250 my $data = shift;
251 my $start = $data->{'startInfoHeader'};
252 my $fh = $data->{'fileHandle'};
253 my $buffer;
254 my $byteCount = $start;
255 my %info;
256
257 seek $fh, $start, 0;
258
259 # read the vorbis version
260 read($fh, $buffer, 4);
261 $info{'version'} = _decodeInt($buffer);
262 $byteCount += 4;
263
264 # read the number of audio channels
265 read($fh, $buffer, 1);
266 $info{'channels'} = ord($buffer);
267 $byteCount += 1;
268
269 # read the sample rate
270 read($fh, $buffer, 4);
271 $info{'rate'} = _decodeInt($buffer);
272 $byteCount += 4;
273
274 # read the bitrate maximum
275 read($fh, $buffer, 4);
276 $info{'bitrate_upper'} = _decodeInt($buffer);
277 $byteCount += 4;
278
279 # read the bitrate nominal
280 read($fh, $buffer, 4);
281 $info{'bitrate_nominal'} = _decodeInt($buffer);
282 $byteCount += 4;
283
284 # read the bitrate minimal
285 read($fh, $buffer, 4);
286 $info{'bitrate_lower'} = _decodeInt($buffer);
287 $byteCount += 4;
288
289 # read the blocksize_0 and blocksize_1
290 read($fh, $buffer, 1);
291 # these are each 4 bit fields, whose actual value is 2 to the power
292 # of the value of the field
293 $info{'blocksize_0'} = 2 << ((ord($buffer) & 0xF0) >> 4);
294 $info{'blocksize_1'} = 2 << (ord($buffer) & 0x0F);
295 $byteCount += 1;
296
297 # read the framing_flag
298 read($fh, $buffer, 1);
299 $info{'framing_flag'} = ord($buffer);
300 $byteCount += 1;
301
302 # bitrate_window is -1 in the current version of vorbisfile
303 $info{'bitrate_window'} = -1;
304
305 $data->{'startCommentHeader'} = $byteCount;
306
307 $data->{'INFO'} = \%info;
308}
309
310sub _loadComments
311{
312 my $data = shift;
313 my $fh = $data->{'fileHandle'};
314 my $start = $data->{'startCommentHeader'};
315 my $buffer;
316 my $page_segments;
317 my $vendor_length;
318 my $user_comment_count;
319 my $byteCount = $start;
320 my %comments;
321
322 seek $fh, $start, 0;
323
324 # check that the first four bytes are 'OggS'
325 read($fh, $buffer, 4);
326 if ($buffer ne 'OggS')
327 {
328 warn "No comment header?";
329 return undef;
330 }
331 $byteCount += 4;
332
333 # skip over next ten bytes
334 read($fh, $buffer, 10);
335 $byteCount += 10;
336
337 # read the stream serial number
338 read($fh, $buffer, 4);
339 push @{$data->{'commentSerialNumber'}}, _decodeInt($buffer);
340 $byteCount += 4;
341
342 # read the page sequence number (should be 0x01)
343 read($fh, $buffer, 4);
344 if (_decodeInt($buffer) != 0x01)
345 {
346 warn "Comment header page sequence number is not 0x01: " +
347 _decodeInt($buffer);
348 warn "Going to keep going anyway.";
349 }
350 $byteCount += 4;
351
352 # and ignore the page checksum for now
353 read($fh, $buffer, 4);
354 $byteCount += 4;
355
356 # get the number of entries in the segment_table...
357 read($fh, $buffer, 1);
358 $page_segments = _decodeInt($buffer);
359 $byteCount += 1;
360 # then skip on past it
361 read($fh, $buffer, $page_segments);
362 $byteCount += $page_segments;
363
364 # check the header type (should be 0x03)
365 read($fh, $buffer, 1);
366 if (ord($buffer) != 0x03)
367 {
368 warn "Wrong header type: " . ord($buffer);
369 }
370 $byteCount += 1;
371
372 # now we should see 'vorbis'
373 read($fh, $buffer, 6);
374 if ($buffer ne 'vorbis')
375 {
376 warn "Missing comment header. Should have found 'vorbis', found " .
377 $buffer;
378 }
379 $byteCount += 6;
380
381 # get the vendor length
382 read($fh, $buffer, 4);
383 $vendor_length = _decodeInt($buffer);
384 $byteCount += 4;
385
386 # read in the vendor
387 read($fh, $buffer, $vendor_length);
388 $comments{'vendor'} = $buffer;
389 $byteCount += $vendor_length;
390
391 # read in the number of user comments
392 read($fh, $buffer, 4);
393 $user_comment_count = _decodeInt($buffer);
394 $byteCount += 4;
395
396 $data->{'COMMENT_KEYS'} = [];
397
398 # finally, read the comments
399 for (my $i = 0; $i < $user_comment_count; $i++)
400 {
401 # first read the length
402 read($fh, $buffer, 4);
403 my $comment_length = _decodeInt($buffer);
404 $byteCount += 4;
405
406 # then the comment itself
407 read($fh, $buffer, $comment_length);
408 $byteCount += $comment_length;
409
410 my ($key) = $buffer =~ /^([^=]+)/;
411 my ($value) = $buffer =~ /=(.*)$/;
412
413 push @{$comments{lc $key}}, $value;
414 push @{$data->{'COMMENT_KEYS'}}, lc $key;
415 }
416
417 # read past the framing_bit
418 read($fh, $buffer, 1);
419 $byteCount += 1;
420
421 $data->{'INFO'}{'offset'} = $byteCount;
422
423 $data->{'COMMENTS'} = \%comments;
424
425 # Now find the offset of the first page
426 # with audio data.
427 while(_findPage($fh))
428 {
429 $byteCount = tell($fh) - 4;
430
431 # version flag
432 read($fh, $buffer, 1);
433 if (ord($buffer) != 0x00)
434 {
435 warn "Invalid stream structure version: " .
436 sprintf("%x", ord($buffer));
437 return;
438 }
439
440 # header type flag
441 read($fh, $buffer, 1);
442 # Audio data starts as a fresh packet on a new page, so
443 # if header_type is odd it's not a fresh packet
444 next if ( ord($buffer) % 2 );
445
446 # skip past granule position, stream_serial_number,
447 # page_sequence_number, and crc
448 read($fh, $buffer, 20);
449
450 # page_segments
451 read($fh, $buffer, 1);
452 my $page_segments = ord($buffer);
453
454 # skip past the segment table
455 read($fh, $buffer, $page_segments);
456
457 # read packet_type byte
458 read($fh, $buffer, 1);
459
460 # Not an audio packet. All audio packet numbers are even
461 next if ( ord($buffer) % 2 );
462
463 # Found the first audio packet
464 last;
465 }
466
467 $data->{'INFO'}{'audio_offset'} = $byteCount;
468}
469
470sub _calculateTrackLength
471{
472 my $data = shift;
473 my $fh = $data->{'fileHandle'};
474 my $buffer;
475 my $pageSize;
476 my $granule_position;
477
478 seek($fh,-8500,SEEK_END); # that magic number is from vorbisfile.c
479 # in the constant CHUNKSIZE, which comes
480 # with the comment /* a shade over 8k;
481 # anyone using pages well over 8k gets
482 # what they deserve */
483
484 # we just keep looking through the headers until we get to the last one
485 # (there might be a couple of blocks here)
486 while(_findPage($fh))
487 {
488 # stream structure version - must be 0x00
489 read($fh, $buffer, 1);
490 if (ord($buffer) != 0x00)
491 {
492 warn "Invalid stream structure version: " .
493 sprintf("%x", ord($buffer));
494 return;
495 }
496
497 # header type flag
498 read($fh, $buffer, 1);
499 # we should check this, but for now we'll just ignore it
500
501 # absolute granule position - this is what we need!
502 read($fh, $buffer, 8);
503 $granule_position = _decodeInt($buffer);
504
505 # skip past stream_serial_number, page_sequence_number, and crc
506 read($fh, $buffer, 12);
507
508 # page_segments
509 read($fh, $buffer, 1);
510 my $page_segments = ord($buffer);
511
512 # reset pageSize
513 $pageSize = 0;
514
515 # calculate approx. page size
516 for (my $i = 0; $i < $page_segments; $i++)
517 {
518 read($fh, $buffer, 1);
519 $pageSize += ord($buffer);
520 }
521
522 seek $fh, $pageSize, 1;
523 }
524
525 $data->{'INFO'}{'length'} =
526 int($granule_position / $data->{'INFO'}{'rate'});
527}
528
529sub _findPage
530{
531 # search forward in the file for the 'OggS' page header
532 my $fh = shift;
533 my $char;
534 my $curStr = '';
535
536 while (read($fh, $char, 1))
537 {
538 $curStr = $char . $curStr;
539 $curStr = substr($curStr, 0, 4);
540
541 # we are actually looking for the string 'SggO' because we
542 # tack character on to our test string backwards, to make
543 # trimming it to 4 characters easier.
544 if ($curStr eq 'SggO')
545 {
546 return 1;
547 }
548 }
549
550 return undef;
551}
552
553sub _decodeInt
554{
555 my $bytes = shift;
556 my $num = 0;
557 my @byteList = split //, $bytes;
558 my $numBytes = @byteList;
559 my $mult = 1;
560
561 for (my $i = 0; $i < $numBytes; $i ++)
562 {
563 $num += ord($byteList[$i]) * $mult;
564 $mult *= 256;
565 }
566
567 return $num;
568}
569
570sub _decodeInt5Bit
571{
572 my $byte = ord(shift);
573
574 $byte = $byte & 0xF8; # clear out the bottm 3 bits
575 $byte = $byte >> 3; # and shifted down to where it belongs
576
577 return $byte;
578}
579
580sub _decodeInt4Bit
581{
582 my $byte = ord(shift);
583
584 $byte = $byte & 0xFC; # clear out the bottm 4 bits
585 $byte = $byte >> 4; # and shifted down to where it belongs
586
587 return $byte;
588}
589
590sub _ilog
591{
592 my $x = shift;
593 my $ret = 0;
594
595 unless ($x > 0)
596 {
597 return 0;
598 }
599
600 while ($x > 0)
601 {
602 $ret++;
603 $x = $x >> 1;
604 }
605
606 return $ret;
607}
608
6091;
610__DATA__
611
612=head1 NAME
613
614Ogg::Vorbis::Header::PurePerl - An object-oriented interface to Ogg Vorbis
615information and comment fields, implemented entirely in Perl. Intended to be
616a drop in replacement for Ogg::Vobis::Header.
617
618Unlike Ogg::Vorbis::Header, this module will go ahead and fill in all of the
619information fields as soon as you construct the object. In other words,
620the C<new> and C<load> constructors have identical behavior.
621
622=head1 SYNOPSIS
623
624 use Ogg::Vorbis::Header::PurePerl;
625 my $ogg = Ogg::Vorbis::Header::PurePerl->new("song.ogg");
626 while (my ($k, $v) = each %{$ogg->info}) {
627 print "$k: $v\n";
628 }
629 foreach my $com ($ogg->comment_tags) {
630 print "$com: $_\n" foreach $ogg->comment($com);
631 }
632
633=head1 DESCRIPTION
634
635This module is intended to be a drop in replacement for Ogg::Vorbis::Header,
636implemented entirely in Perl. It provides an object-oriented interface to
637Ogg Vorbis information and comment fields. (NOTE: This module currently
638supports only read operations).
639
640=head1 CONSTRUCTORS
641
642=head2 C<new ($filename)>
643
644Opens an Ogg Vorbis file, ensuring that it exists and is actually an
645Ogg Vorbis stream. This method does not actually read any of the
646information or comment fields, and closes the file immediately.
647
648=head2 C<load ([$filename])>
649
650Opens an Ogg Vorbis file, ensuring that it exists and is actually an
651Ogg Vorbis stream, then loads the information and comment fields. This
652method can also be used without a filename to load the information
653and fields of an already constructed instance.
654
655=head1 INSTANCE METHODS
656
657=head2 C<info ([$key])>
658
659Returns a hashref containing information about the Ogg Vorbis file from
660the file's information header. Hash fields are: version, channels, rate,
661bitrate_upper, bitrate_nominal, bitrate_lower, bitrate_window, and length.
662The bitrate_window value is not currently used by the vorbis codec, and
663will always be -1.
664
665The optional parameter, key, allows you to retrieve a single value from
666the object's hash. Returns C<undef> if the key is not found.
667
668=head2 C<comment_tags ()>
669
670Returns an array containing the key values for the comment fields.
671These values can then be passed to C<comment> to retrieve their values.
672
673=head2 C<comment ($key)>
674
675Returns an array of comment values associated with the given key.
676
677=head2 C<add_comments ($key, $value, [$key, $value, ...])>
678
679Unimplemented.
680
681=head2 C<edit_comment ($key, $value, [$num])>
682
683Unimplemented.
684
685=head2 C<delete_comment ($key, [$num])>
686
687Unimplemented.
688
689=head2 C<clear_comments ([@keys])>
690
691Unimplemented.
692
693=head2 C<write_vorbis ()>
694
695Unimplemented.
696
697=head2 C<path ()>
698
699Returns the path/filename of the file the object represents.
700
701=head1 NOTE
702
703This is ALPHA SOFTWARE. It may very well be very broken. Do not use it in
704a production environment. You have been warned.
705
706=head1 ACKNOWLEDGEMENTS
707
708Dave Brown <cpan@dagbrown.com> made this module significantly faster
709at calculating the length of ogg files.
710
711Robert Moser II <rlmoser@earthlink.net> fixed a problem with files that
712have no comments.
713
714=head1 AUTHOR
715
716Andrew Molloy E<lt>amolloy@kaizolabs.comE<gt>
717
718=head1 COPYRIGHT
719
720Copyright (c) 2003, Andrew Molloy. All Rights Reserved.
721
722This program is free software; you can redistribute it and/or modify it
723under the terms of the GNU General Public License as published by the
724Free Software Foundation; either version 2 of the License, or (at
725your option) any later version. A copy of this license is included
726with this module (LICENSE.GPL).
727
728=head1 SEE ALSO
729
730L<Ogg::Vorbis::Header>, L<Ogg::Vorbis::Decoder>
731
732=cut