1# Copyright (C) 2005-2008 Quentin Sculo <squentin@free.fr>
2#
3# This file is part of Gmusicbrowser.
4# Gmusicbrowser is free software; you can redistribute it and/or modify
5# it under the terms of the GNU General Public License version 3, as
6# published by the Free Software Foundation
7package Tag::MPC;
8use strict;
9use warnings;
10our @ISA=('Tag::MP3');
11my (@profiles,@freq);
12
13INIT
14{ @profiles=
15  (	'na',		'Unstable/Experimental','na',			'na',
16	'na',		'below Telephone',	'below Telephone',	'Telephone',
17	'Thumb',	'Radio',		'Standard',		'Xtreme',
18	'Insane',	'BrainDead',		'above BrainDead',	'above BrainDead'
19  );
20  @freq=(44100,48000,37800,32000);
21}
22
23sub new
24{   my ($class,$file,$findlength)=@_;
25    my $self=bless {}, $class;
26    local $_;
27    # check that the file exists
28    unless (-e $file)
29    {	warn "File '$file' does not exist.\n";
30	return undef;
31    }
32    $self->{filename} = $file;
33    $self->_open or return undef;
34
35    $self->_FindTags;
36    $self->_ReadHeader;
37    return undef unless $self->{info};
38    $self->_close;
39    return $self;
40}
41
42sub _ReadHeader
43{	my $self=$_[0];
44	my %info;
45	$info{channels}=2;
46	my $fh=$self->{fileHandle};
47	my $offset=$self->{startaudio};
48	seek $fh,$offset,0;
49	read $fh,my$buf,11;
50	if ($buf=~m/^MPCK/) #SV8
51	{	seek $fh,$offset+4,0;
52		$self->readV8packets;
53		my $info= $self->{info};
54		$info->{bitrate}=( $self->{endaudio}-$self->{startaudio} )*8/$info->{seconds} if $info && $info->{seconds};
55		return;
56	}
57	elsif ($buf=~m/^MP\+/)	#SV7, SV7.1 or SV8? (I've found doc describing SV8 format like that (MP+ instead of MPCK), but not sure such files exist)
58	{	my ($v,$nbframes,$pf)=unpack 'x3CVxxC',$buf;
59		$info{version}=($v & 0x0f).'.'.($v>>4);
60		if (($v & 0x0f)>8) { warn "Version of mpc not supported\n";return; }
61		$info{frames}=$nbframes;
62		$info{profile}=$profiles[$pf >> 4];
63		$info{rate}=$freq[$pf & 0b11];
64	}
65	else #SV 4 5 or 6
66	{	my ($dword,$nbframes)=unpack 'VV',$buf;
67		$info{version}=my $v=($dword >> 11) & 0x3ff;
68		return if $v<4 && $v>6;
69		$nbframes>>=16 if $v==4;
70		$info{frames}=$nbframes;
71		$info{rate}=44100;
72	}
73	$info{seconds}=$info{frames}*1152/$info{rate};
74	$info{bitrate}=( $self->{endaudio}-$self->{startaudio} )*8/$info{seconds};
75#	warn "$_=$info{$_}\n" for keys %info;
76	$self->{info}=\%info;
77}
78
79sub readV8packets
80{	my $self=shift;
81	my $fh=$self->{fileHandle};
82	my %info;
83
84	eval { # in eval block to avoid error in case of invalid BER value in unpack
85	  while (my $read=read($fh,my$buf,12))
86	  {	last if $read<3;
87		my ($id,$size,$notheader)=unpack 'A2wa*',$buf; #size is BER compressed integer
88		$notheader=length $notheader; #number of bytes read that are not from the header
89		if ($id!~m/^[A-Z][A-Z]$/) { warn "mpcV8: invalid packet id ".unpack("H*",$id)."\n"; return }
90		warn "mpcV8 packet=$id size=$size\n" if $::debug;
91
92		if ($id eq 'AP') { return } # currently stop when the first audio packet is found
93		#FIXME very unlikely to happen, especially with audio files, but $size could be too big to be kept as an integer, max possible value is 2**70-1
94		# not sure if a too big value would cause problem with seek/read
95		# ok for now as it should only affect audio packets, and we stop at the first one
96
97		return if $id eq 'SE'; #stream end packet
98		$size-= $read-$notheader; # $size is now size of packet without header
99		seek $fh,-$notheader,1; #position at end of packet header
100		if ($id eq 'SH' || $id eq 'RG')
101		{	my $read=read $fh,$buf,$size;
102			if ($read!=$size) { warn "mpcv8: packet $id too short\n"; return }
103			if ($id eq 'SH') # stream header packet
104			{	my ($crc,$version,$samples,$silence,$freq_bands,$chan_MS_frames)= unpack 'NCwwCC',$buf; # count and silence are BER compressed integer
105				# $crc is ignored for now
106				warn "mpcV8: unknown bitstream version $version\n" if $version!=8;
107				my $freq= $freq_bands>>5;
108				$info{rate}= $freq<4 ? $freq[$freq] : 0; #freq can be 0 to 7, but only defined up to 3
109				$info{channels}= 1+($chan_MS_frames>>4);
110				$info{max_bands}= $chan_MS_frames & 0b11111;
111				$info{mid_side_stereo}= $chan_MS_frames & 0b1000 ? 1 : 0;
112				$info{frames_per_audio_packet}= 4**($chan_MS_frames & 0b111);
113				$info{samples}=$samples;
114				$info{silence_samples}=$silence;
115				$info{version}=$version;
116				$info{seconds}= $info{rate} ? ($samples-$silence)/$info{rate} : 0;
117				$self->{info}=\%info;
118			}
119			elsif ($id eq 'RG') # replaygain packet
120			{	my ($version,$tgain,$tpeak,$again,$apeak)= unpack 'Cs>4',$buf; # "s>": signed big-endian 16bit
121				$info{replaygain_version}=$version;
122				$info{track_gain}= (10 ** ($tgain/256/20) / 65535) if $tgain;#formula taken from mutagen
123				$info{album_gain}= (10 ** ($again/256/20) / 65535) if $again;
124				$info{track_peak}= 64.82-$tpeak/256 if $tpeak;#formula taken from mutagen
125				$info{album_peak}= 64.82-$apeak/256 if $apeak;
126				#ignored for now
127			}
128		}
129		else { seek $fh,$size,1 } #skip
130	  }
131	};
132}
133
1341;
135