# freedb_cache - read the freedb.org entry for an audio CD in your drive
# (see end of file for documentation and cpoyright)

package freedb_cache;

use 5.008;
use strict;
use warnings;

require Exporter;
our $VERSION = "2.0.1";
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(
  get_cddb
  get_discids
);

use Encode qw(decode);
use Fcntl;
use File::Find;
use IO::Socket;
use Data::Dumper qw(Dumper);


# set default configuration
my $CDDB_HOST = "freedb.freedb.org";
my $CDDB_PORT = 8880;
my $CDDB_MODE = "cddbp";
my $CDDB_CLIENT  = "anonymous nowhere.test " . __PACKAGE__ . " $VERSION";
#my $CACHE_DIR = "/usr/share/cddb/";
my $CACHE_DIR = $ENV{"HOME"} . "/public_data/cddb/";
my $CACHE_SEARCH_LINKS = 0;
my $USE_CACHE = 1;
my $USE_NET = 1;

# hardware setup for linux, solaris x86, solaris sparc
# (don't know about  *BSD)
my $OS=`uname -s`;
my $MACHINE=`uname -m`;
chomp $OS;
chomp $MACHINE;
# endian check
my $BIG_ENDIAN = unpack("h*", pack("s", 1)) =~ /01/;

# cdrom IOCTL magic (from c headers)
# linux x86 is default (from /usr/include/linux/cdrom.h)
my $CDROM_MSF=0x02;
my $CDROMREADTOCHDR=0x5305;
my $CDROMREADTOCENTRY=0x5306;
my $CD_DEVICE = "/dev/cdrom";
if($OS eq "SunOS") {
    # /usr/include/sys/cdio.h
    $CDROMREADTOCHDR=0x49b;	# 1179
    $CDROMREADTOCENTRY=0x49c;	# 1180
    if(-e "/vol/dev/aliases/cdrom0") {
	$CD_DEVICE="/vol/dev/aliases/cdrom0";
    } else {
	if($MACHINE =~ /^sun/) {  
	    # on sparc and old suns
	    $CD_DEVICE="/dev/rdsk/c0t6d0s0";
	} else {
	    # on intel 
	    $CD_DEVICE="/dev/rdsk/c1t0d0p0";
	}
    }
} elsif($OS =~ /BSD/i) {  
    # works for netbsd, infos for other bsds welcome
    # /usr/include/sys/cdio.h
    $CDROMREADTOCHDR=0x40046304;
    $CDROMREADTOCENTRY=0xc0086305;
    $CD_DEVICE="/dev/cd0a";
    if($OS eq "OpenBSD") {
	$CD_DEVICE="/dev/cd0c";
    }
}


sub read_toc {
  my $device=shift;
  my $tochdr="";

  sysopen (CD,$device, O_RDONLY | O_NONBLOCK) or 
      die "cannot open cdrom [$!] [$device]";
  ioctl(CD, $CDROMREADTOCHDR, $tochdr) or 
      die "cannot read toc [$!] [$device]";
  my ($start,$end);
  if($OS =~ /BSD/) {
    ($start,$end)=unpack "CC",(substr $tochdr,2,2);
  } else {
    ($start,$end)=unpack "CC",$tochdr;
  }

  my @tracks=();

  for (my $i=$start; $i<=$end;$i++) {
    push @tracks,$i;
  }
  push @tracks,0xAA;

  my @r=();
  my $tocentry;
  my $toc="";
  my $size=0;
  for(@tracks) {
    $toc.="        ";
    $size+=8;
  }
 
  if($OS =~ /BSD/) { 
    my $size_hi=int($size / 256);
    my $size_lo=$size & 255;      

    if($BIG_ENDIAN) {
      $tocentry=pack "CCCCP8l", $CDROM_MSF,0,$size_hi,$size_lo,$toc; 
    } else {
      $tocentry=pack "CCCCP8l", $CDROM_MSF,0,$size_lo,$size_hi,$toc; 
    }
    ioctl(CD, $CDROMREADTOCENTRY, $tocentry) or 
	die "cannot read track info [$!] [$device]";
  }

  my $count=0;
  foreach my $i (@tracks) {
    my ($min,$sec,$frame);
    unless($OS =~ /BSD/) {
      $tocentry=pack "CCC", $i,0,$CDROM_MSF;
      ioctl(CD, $CDROMREADTOCENTRY, $tocentry) or 
	  die "cannot read track $i info [$!] [$device]";
      ($min,$sec,$frame)=unpack "CCCC", substr($tocentry,4,4);
    } else {
      ($min,$sec,$frame)=unpack "CCC", substr($toc,$count+5,3);
    } 
    $count+=8;

    my %cdtoc=();
 
    $cdtoc{min}=$min;
    $cdtoc{sec}=$sec;
    $cdtoc{frame}=$frame;
    $cdtoc{frames}=int($frame+$sec*75+$min*60*75);

    my $data = unpack("C",substr($tocentry,1,1)); 
    $cdtoc{data} = 0;
    if($data & 0x40) {
      $cdtoc{data} = 1;
    } 

    push @r,\%cdtoc;
  }   
  close(CD);
 
  return @r;
}                                      

sub cddb_sum {
  my $n=shift;
  my $ret=0;

  while ($n > 0) {
    $ret += ($n % 10);
    $n = int $n / 10;
  }
  return $ret;
}                       

sub cddb_discid {
  my $total=shift;
  my $toc=shift;

  my $i=0;
  my $t=0;
  my $n=0;
  
  while ($i < $total) {
    $n = $n + cddb_sum(($toc->[$i]->{min} * 60) + $toc->[$i]->{sec});
    $i++;
  }
  $t = (($toc->[$total]->{min} * 60) + $toc->[$total]->{sec}) -
      (($toc->[0]->{min} * 60) + $toc->[0]->{sec});
  my $id = ((($n % 0xff) << 24) | ($t << 8) | $total);
  return sprintf("%08x", $id);
}


sub get_discids {
  my ($cd) =  @_;
  $CD_DEVICE = $cd if (defined($cd));

  my @toc = read_toc($CD_DEVICE);
  my $total = $#toc;

  my $id = cddb_discid($total,\@toc);

  return [$id,$total,\@toc];
}


sub get_cddb {
    my $config = shift;
    # disc identification
    my $disc_ident = shift;
    # this is the freedb discid, an 8-byte checksum to identify each disc
    my $discid;
    # number of tracks on the disc
    my $total;
    # TOC (table of contents) for the disc in question
    # this is an array with a hash for each track, that contains the 
    # track start as absolute position on the disc (in number of frames 
    # and min/sec/frame) and a flag that is only set for data tracks
    # There is an addition array entry for the end of the disc (used to 
    # compute track lengths)
    my $toc;
    # disc length in seconds
    my $length;
    # debug flag
    my $debug = 0;
    # some multiple used dynamic variables
    my @r;
    my $found = 0;
    my @list=();
    my $return;
    my $socket;
    
    # process user defined configuration settings
    $debug = 1 if (defined($config->{"debug"}) and $config->{"debug"});
    my $interactive = 1;
    $interactive = $config->{INTERACTIVE} if (exists($config->{INTERACTIVE}));
    my $multi = 0;
    $multi = $config->{MULTI} if (exists($config->{MULTI}));
    $interactive = 0 if $multi;
    my $HTTP_PROXY = $config->{HTTP_PROXY} if (defined($config->{HTTP_PROXY}));
    my $FW = 1 if (defined($config->{FW}));
    $CDDB_HOST = $config->{CDDB_HOST} if (defined($config->{CDDB_HOST}));
    $CDDB_PORT = $config->{CDDB_PORT} if (defined($config->{CDDB_PORT}));
    $CDDB_MODE = lc($config->{CDDB_MODE}) if (defined($config->{CDDB_MODE}));
    if (lc($CDDB_MODE) eq "cddb") {
	$CDDB_MODE= "cddbp";
    }
    $CD_DEVICE = $config->{CD_DEVICE} if (defined($config->{CD_DEVICE}));
    $CDDB_CLIENT  = $config->{CDDB_CLIENT} 
        if (defined($config->{CDDB_CLIENT}));
    $CACHE_DIR = $config->{CACHE_DIR} if (defined($config->{CACHE_DIR}));
    # some systems may have problems with doubled directory separators
    $CACHE_DIR =~ s/\/+$//;
    $CACHE_SEARCH_LINKS = $config->{CACHE_SEARCH_LINKS} 
        if (defined($config->{CACHE_SEARCH_LINKS}));
    $USE_NET = $config->{USE_NET} if (defined($config->{USE_NET}));
    $USE_CACHE = $config->{USE_CACHE} if (defined($config->{USE_CACHE}));
    if ($debug) {
	print STDERR __PACKAGE__ . ": debug level $debug\n";
	print STDERR __PACKAGE__ . ": detected $OS ($MACHINE) ";
	$BIG_ENDIAN ? 
	    print STDERR "[big endian]\n" :
	    print STDERR "[little endian]\n";
	print STDERR Data::Dumper->Dump([$config], [qw(*config)]);
    }

    # get disc characteristics
    if(defined($disc_ident)) {
	$discid = $disc_ident->[0];
	$total = $disc_ident->[1];
	$toc = $disc_ident->[2];
    } else {
	$disc_ident = get_discids($CD_DEVICE);
	$discid = $disc_ident->[0];
	$total = $disc_ident->[1];
	$toc = $disc_ident->[2];
    }
    # compute disc length (each second consists of 75 frames on disc)
    $length =  int(($toc->[$total]->{frames})/75);
    push @{$disc_ident}, $length;
    if ($debug) {
	print STDERR __PACKAGE__ . ": disc ID=$discid, total nr. of " . 
	    "tracks=$total, disc length in sec=$length,\n";
	print Data::Dumper->Dump([$toc], [qw(*TOC)]);
    }
    
    if ($USE_CACHE) {
	my @cd_sel;
	my @files = ();
	#find file with this disc ID
	find({ follow => 1, wanted => sub {
	           if (/^\Q$discid\E$/i) {
		       push @files, $File::Find::name;
		   } 
	       }
	   }, $CACHE_DIR);
	if ($CACHE_SEARCH_LINKS and 
	    ($#files == -1 or ($#files == 0 and $files[0] eq ""))) {
	    warn __PACKAGE__ . ": no file with id $discid found. ".
		"Searching for linked entries...\n";
	    find({ follow => 1, wanted => sub{
		if (`grep -E -i "^DISCID=.*$discid.*" $File::Find::name`) {
		    push @files, $File::Find::name;
		}
	    } 
	       }, $CACHE_DIR);
	}
	
	if ($#files == -1 or ($#files == 0 and $files[0] eq "")) {
	    warn __PACKAGE__ . ": no file found in cache.\n";
	} else {
	    FILEREAD: foreach my $file (@files) {
	        if (-r $file) {
		    open(FILE, "<", "$file") or do {
			warn __PACKAGE__ . ": ERROR opening $file\n";
			next FILEREAD;
		    };
		    my @raw_entry = ();
		    my $in;
		    while (defined($in = <FILE>)) {
			if (length($in) > 256) {
			    warn __PACKAGE__ . "invalid freedb entry " . 
				"(line too long)\n";
			    close(FILE);
			    next FILEREAD;
			}
			# remove all end of line characters
			$in = _chommp($in);
			# Enable the utf8 flag on all strings
			# The freedb database format requires all entries
			# to be in UTF-8, ISO-8859-1 or ASCII (subset of 
			# UTF-8) encoding
			$in = _is_valid_utf8($in) ? 
			    decode("utf8", $in) : decode("iso-8859-1", $in);
			push @raw_entry, $in;
			print STDERR "read line '$in'\n" if $debug;
		    }
		    close(FILE);
		    # Get category from directory name 
		    my $cat = $file;
		    $cat =~ s/\/\Q$discid\E.*$//i;
		    $cat =~ s/^.*\/([^\/]+)$/$1/i;

		    my %entry = parse_entry($cat, $disc_ident, \@raw_entry, 
					    $debug);
		    push @cd_sel, \%entry if (%entry);
		} else {
		    warn __PACKAGE__ . ": can't read file '$file'\n";
		}
	    }
	    if ($multi) {
		return @cd_sel;
	    } else {
		my $index;
		if($interactive and $#cd_sel >= 0) {
		    print "This CD could be:\n\n";
		    my $i=1;
		    foreach my $sel (@cd_sel) {
			print "$i: ". ${$sel}{"artist"} . " / " . 
			    ${$sel}{"title"} . "\n";
			$i++;
		    }
		    print "\n0: none of the above\n\nChoose: ";
		    my $n=<STDIN>;
		    $index=int($n);
		} else {
		    $index=1;
		}
		print "selected index: $index\n" if $debug;
		if ($index > 0 and $index <= $#cd_sel + 1) {
		    $found = 1;
		    return %{$cd_sel[$index-1]};
		}
	    }
	}
    }
    
    if ($USE_NET and not $found) {
	my $query = "cddb query $discid $total";
	for (my $i=0; $i<$total ;$i++) {
	    $query .= " " . $toc->[$i]->{frames};
	}
	$query .= " ". $length;
	print STDERR __PACKAGE__ . ": freedb query '$query'\n" if $debug;
	
	if ($CDDB_MODE eq "cddbp") {
	    print STDERR __PACKAGE__ . ": connecting to $CDDB_HOST:" . 
		"$CDDB_PORT\n" if $debug;
	    
	    $socket = IO::Socket::INET->new(PeerAddr=>$CDDB_HOST, 
					    PeerPort=>$CDDB_PORT,
					    Proto=>"tcp", 
					    Type=>SOCK_STREAM) 
		or do {
		    warn __PACKAGE__ . ": cannot connect to freedb server: ".
			"$CDDB_HOST:$CDDB_PORT [$@]\n";
		    return ();
		};
	    # expect data in UTF-8 encoding 
	    # (the default encoding since freedb protocol version 6)
	    binmode($socket, ":utf8");

	    $return = <$socket>;
	    unless ($return =~ /^2\d\d\s+/) {
		warn __PACKAGE__ . ": not welcome at freedb server\n";
		return ();
	    }
	    
	    print $socket "cddb hello $CDDB_CLIENT\n";
	    $return = <$socket>;
	    unless ($return =~ /^2\d\d\s+/) {
		warn __PACKAGE__ . ": handshake error with freedb server: ".
		    "$CDDB_HOST:$CDDB_PORT\n";
		return ();
	    }
	    
	    print $socket "proto 6\n";
	    $return = <$socket>;
	    # acceptable return codes:
	    # 201 = OK, protocol level now: 6
	    # 502 = Protocol level already 6
	    unless ($return =~ /^201\s+/ or $return =~ /^502\s+/) {
		warn __PACKAGE__ . ": protocol version 6 not supported by ".
		    "freedb server: $CDDB_HOST:$CDDB_PORT\n";
		return ();
	    }
	    	    
	    print STDERR __PACKAGE__ . ": sending '$query'\n" if $debug;
	    print $socket "$query\n";
	    
	    $return = <$socket>;
	    chomp $return;
	    
	    print STDERR __PACKAGE__ . ": result: $return\n" if $debug;
	} elsif ($CDDB_MODE eq "http") {
	    my $query2=$query;
	    $query2 =~ s/ /+/g;
	    my $id=$CDDB_CLIENT;
	    $id =~ s/ /+/g;
	    
	    my $url = "/~cddb/cddb.cgi?cmd=$query2&hello=$id&proto=6";
	    
	    my $host=$CDDB_HOST;
	    my $port=80;
	    
	    if($HTTP_PROXY) {
		if($HTTP_PROXY =~ /^(http:\/\/|)(.+?):(\d+)/) {
		    $host=$2;
		    $port=$3;
		    $url="http://$CDDB_HOST".$url." HTTP/1.0\n";
		}
	    }
	    
	    print STDERR __PACKAGE__ . ": connecting to $host:$port\n" 
		if $debug;
	    
	    $socket=IO::Socket::INET->new(PeerAddr=>$host, PeerPort=>$port,
					  Proto=>"tcp",Type=>SOCK_STREAM) 
		or do {
		    warn __PACKAGE__ . ": cannot connect to freedb " .
			"server: $host:$port [$!]\n";
			return ();
		};
	    # expect data in UTF-8 encoding 
	    # (the default encoding since freedb protocol version 6)
	    binmode($socket, ":utf8");

	    print STDERR __PACKAGE__ . ": sending 'GET $url'\n" if $debug;
	    print $socket "GET $url\n";
	    print $socket "\n" if $FW;
	    
	    if($HTTP_PROXY) {
		while(<$socket> =~ /^\S+/){};
	    }
	    
	    $return = <$socket>;
	    chomp $return;
	    
	    print STDERR __PACKAGE__ . ": http result: $return\n" if $debug;
	    if ($return !~ /^\d\d\d/) {
		my $fail = __PACKAGE__ . ": cannot connect to freedb " . 
		    "server $CDDB_HOST:$CDDB_PORT";
		$fail .= " via proxy $host:$port" if $HTTP_PROXY;
		warn $fail . "\n";
		return ();
	    }
	} else {
	    warn __PACKAGE__ . ": unkown protocol '$CDDB_MODE' for " . 
		"querying freedb\n";
	    return ();
	}
	
	$return =~ s/\r//g;
	
	my ($err) = $return =~ /^(\d\d\d)\s+/;
	unless ($err =~ /^2/) {
	    warn __PACKAGE__ . ": query error '$err' at freedb server: " . 
		"$CDDB_HOST:$CDDB_PORT\n";
	    return ();
	}
	
	if($err==202) {
	    warn __PACKAGE__ . ": no entry found on server.\n";
	    return ();
	} elsif($err==211) {
	    while(<$socket>) {
		last if(/^\./);
		push @list, $_;
		s/\r//g;
		warn __PACKAGE__ . ": received unexact match: $_\n";
	    } 
	} elsif($err==210) {
	    while(<$socket>) {
		last if(/^\./);
		push @list, $_;
		s/\r//g;
	    } 
	} elsif($err==200) {
	    $return =~ s/^200 //;
	    push @list, $return;
	} else {
	    warn __PACKAGE__ . ": unknown server response: '$return'\n";
	    return ();
	}
	
	my @to_get;
	
	unless($multi) {
	    if (@list) { 
		my $index;
		if($interactive) {
		    print "This CD could be:\n\n";
		    my $i=1;
		    for(@list) {
			my ($tit) = $_ =~ /^\S+\s+\S+\s+(.*)/;
			print "$i: $tit\n";
			$i++
			}
		    print "\n0: none of the above\n\nChoose: ";
		    my $n=<STDIN>;
		    $index=int($n);
		} else {
		    $index=1;
		} 
		
		if ($index == 0) {
		    return ();
		} else {
		    push @to_get,$list[$index-1];
		}
	    }
	} else {
	    push @to_get,@list;
	}
	
	my $i=0;
	NETREAD: for my $get (@to_get) {
	    #200 misc 0a01e802 Meredith Brooks / Bitch Single 
	    my ($cat,$id,$at) = $get =~ /^(\S+?)\s+(\S+?)\s+(.*)/;
	    
	    my $artist;
	    my $title;
	    
	    if($at =~ /\//) {
		($artist,$title)= $at =~ /^(.*?)\s\/\s(.*)/;
	    } else {
		$artist=$at;
		$title=$at;
	    }
	    
	    my %cd=();
	    $cd{artist}=$artist;
	    chomp $title;
	    $cd{title}=$title;
	    $cd{cat}=$cat;
	    $cd{id}=$id;
	    
	    my @lines;
	    
	    $query='cddb read "' . $cat . '" ' . $id;
	    
	    if ($CDDB_MODE eq "cddbp") {
		print STDERR __PACKAGE__ . ": sending query '$query'\n" 
		    if $debug;
		print $socket "$query\n";

		my $answer = <$socket>;
		if ($answer =~ /^2../) {
		    while(<$socket>) {
			last if(/^\./);
			if (length($_) > 256) {
			    warn __PACKAGE__ . "invalid freedb entry " . 
				"(line too long)\n";
			    close($socket);
			    next NETREAD;
			}
			push @lines, _chommp($_);
		    }
		} else {
		    print STDERR __PACKAGE__ . ": query error '$answer' ". 
			"at freedb server: $CDDB_HOST:$CDDB_PORT";
		}
		if(@to_get-1 == $i) {
		    print $socket "quit\n";
		    close $socket;
		}
		
	    } elsif ($CDDB_MODE eq "http") {
		close $socket;
		
		my $query2=$query;
		$query2 =~ s/ /+/g;
		my $id=$CDDB_CLIENT;
		$id =~ s/ /+/g;
		
		my $url = "/~cddb/cddb.cgi?cmd=$query2&hello=$id&proto=6";
		
		my $host=$CDDB_HOST;
		my $port=80;
		
		if($HTTP_PROXY) {
		    if($HTTP_PROXY =~ /^(http:\/\/|)(.+?):(\d+)/) {
			$host=$2;
			$port=$3;
			$url="http://$CDDB_HOST".$url." HTTP/1.0\n";
		    }
		}
		
		print STDERR __PACKAGE__ . ": connecting to $host:$port\n" 
		    if $debug;
		
		$socket=IO::Socket::INET->new(PeerAddr=>$host, 
					      PeerPort=>$port,
					      Proto=>"tcp",
					      Type=>SOCK_STREAM) 
		    or do {
			warn __PACKAGE__ . ": cannot connect to freedb " .
			    "server: $host:$port [$!]\n";
			next NETREAD;
		    };
		binmode($socket, ":utf8");

		print STDERR __PACKAGE__ . ": http send: GET $url\n" if $debug;
		print $socket "GET $url\n";
		print $socket "\n" if $FW;
		
		if($HTTP_PROXY) {
		    while(<$socket> =~ /^\S+/) {};
		}

		my $answer = <$socket>;
		if ($answer =~ /^2../) {
		    while(<$socket>) {
			last if(/^\./);
			if (length($_) > 256) {
			    warn __PACKAGE__ . "invalid freedb entry " . 
				"(line too long)\n";
			    close($socket);
			    next NETREAD;
			}
			push @lines, _chommp($_);
		    }
		} else {
		    print STDERR __PACKAGE__ . ": query error '$answer' ". 
			"at freedb server: $CDDB_HOST:$CDDB_PORT";
		}
		close $socket;

	    } else {
		warn __PACKAGE__ . ": unkown protocol '$CDDB_MODE' for " . 
		    "querying freedb\n";
		return ();
	    }
	    
	    if ($debug) {
		print STDERR __PACKAGE__ . ": received entry from server:\n";
		for(@lines) {
		    print STDERR $_, "\n";
		    last if(/^\./);
		}
	    }
	    my %entry = parse_entry($cat, $disc_ident, \@lines, $debug);
	    
	    return () unless (%entry);
	    

	    my $file = $CACHE_DIR ."/". $cd{cat} ."/". $cd{id};
	    if ($USE_CACHE and not -e $file) {
		print STDERR __PACKAGE__ . ": adding new entry to " . 
		    "local cache\n" if $debug;
		# create missing directories
		if (not -e $CACHE_DIR ."/". $cd{cat}) {
		    mkdir($CACHE_DIR ."/". $cd{cat});
		}
		# WARNING: UTF-8 conversion on output is done each time!
		# So it can only be used if files are not opened for 
		# writing more than once in :utf8 mode.
		if (open(FILE, ">:utf8", "$file")) {
		    foreach my $line (@lines) {
			last if( $line =~ /^\./);
			next if( $line =~ /^\d\d\d/);
			print FILE $line, "\n";
		    }
		    close(FILE);
		} else {
		    print STDERR __PACKAGE__ . ": failed to write " . 
			"local cache file '$file'\n";
		}
	    }
	    
	    return %entry unless($multi);
	    push @r,\%entry;
	    $i++;
	}
    } else {
	warn __PACKAGE__ . ": no freedb sources enabled or no disc " . 
	    "information found\n";
	return ();
    }
    
    return @r;
}


# Parse lines there were read from somewhere
# For valid entries it returns a hash structure that contains all 
# cddb information 
sub parse_entry {
    my %data = ();
    $data{"cat"} = $_[0];
    my @disc_ident = @{$_[1]};
    my @lines = @{$_[2]};
    my $debug = $_[3];

    my $id = $disc_ident[0];
    my $total = $disc_ident[1];
    my $toc = $disc_ident[2];
    my $length = $disc_ident[3];

    # True, if there are separate artists for each (or some) track
    my $compilation = 0;
    # Raw lines are returned back too
    foreach my $l (@lines) {
	push @{$data{raw}}, $l . "\n";
    }
    # insert discID from real disc
    $data{"id"} = $id;

    # Current line number
    my $i = 0;
    # Check for freedb database format header
    if ($lines[$i] !~ /^\# xmcd/) {
	warn __PACKAGE__ . ": parse error (missing or malformed first " . 
	    "line in freedb entry)\n";
	return ();
    }
    # Skip additional comment lines
    while ($lines[$i] =~ /^\#/ and 
	   $lines[$i] !~ /^\# Track frame offsets:/) {
	$i++;
    }
    # Read list of track frames
    if ($lines[$i] =~ /^\# Track frame offsets:/) {
	$i++;
	my $tr = 0;
	while ($lines[$i] =~ /^\#\s*(\d+)\s*$/) {
	    $data{"frames"}[$tr] = int($1);
	    $tr++;
	    $i++;
	}
	# Number of tracks = last tracknumber + 1 (because its 0-based)
	$data{"tno"} = $#{$data{"frames"}} + 1;
	# this is required to avoid skipping a line completely
	$i--;
    } else {
	warn __PACKAGE__ . ": parse error (missing " . 
	    "'Track frame offset' line)\n";
	return ();
    }

    # Set initial revision number (because it may be omitted in the entry)
    $data{"revision"} = 0;
    # Parse all remaining comment lines
    while ($lines[$i] =~ /^\#/) {
	if ($lines[$i] =~ /^\# Disc length: (\d+)/i) {
	    $data{"length"} = int($1);
	}
	elsif ($lines[$i] =~ /^\# Revision: (\d+)/i) {
	    $data{"revision"} = int($1);
	}
	elsif ($lines[$i] =~ /^\# Submitted via: (.+)/i) {
	    $data{"submitter"} = $1;
	}
	$i++;
    }
    if (not defined($data{"length"})) {
	warn __PACKAGE__ . ": parse error (missing 'Disc length' " . 
	    "line in freedb entry)\n";
	return ();
    }
    if (not defined($data{"submitter"})) {
        warn __PACKAGE__ . ": parse errror (missing 'Submitted via' " . 
            "line in freedb entry)\n";
	# Don't enforce this (because this line is not relevant here)
        #return ();
    }

    # The first non-comment line must be the DISCID line
    # (the order of all non-comment lines is fixed)
    if ($lines[$i] =~ /^DISCID=([0-9a-fA-F]{8}(,[0-9a-fA-F]{8})*)$/) {
	@{$data{"idlist"}} = split (/,/, $1);
    } else {
	warn __PACKAGE__ . ": parse error (missing or malformed DISCID " . 
	    "line in freedb entry)\n";
	print "DEBUG: line = '". $lines[$i]. "'\n" if $debug;
	return ();
    }
    $i++;

    my $dtitle;
    while ($lines[$i] =~ /^DTITLE=(.+)$/) {
	$dtitle .= $1;
	$i++;
    }
    if (not $dtitle) {
	warn __PACKAGE__ . ": parse error (missing or empty DTITLE " . 
	    "line in freedb entry)\n";
	return ();
    } else {
	if ($dtitle =~ /^(.*) \/ (.*)$/) {
	    $data{"artist"} = $1;
	    $data{"title"} = $2;
	} else {
	    $data{"artist"} = $dtitle;
	    $data{"title"} = $dtitle;
	}
    }

    # This line is treated as optional because it is not present in
    # older freedb versions
    if ($lines[$i] =~ /^DYEAR=(.*)$/) {
	my $dyear = $1;
	if (not defined($dyear) or $dyear eq "") {
	    $data{"year"} = "";
	    print STDERR __PACKAGE__ . ": empty DYEAR line in freedb entry\n"
		if $debug;
	} elsif ($dyear =~ /^\d{4}$/) {
	    $data{"year"} = int($dyear);
	} else {
	    warn __PACKAGE__ . ": parse error (malformed DYEAR " . 
		"line in freedb entry)\n";
	}
	$i++;
    }
    $data{"year"} = "" unless $data{"year"};
    
    # This line is treated as optional because it is not present in
    # older freedb versions
    if ($lines[$i] =~ /^DGENRE=(.*)$/) {
	$data{"genre"} = $1;
	$i++;
    }
    $data{"genre"} = "" unless $data{"genre"};

    if ($lines[$i] !~ /^TTITLE\d+=/) {
	warn __PACKAGE__ . ": parse error (missing TTITLE " . 
	    "line in freedb entry)\n";
	return ();
    }
    while ($lines[$i] =~ /^TTITLE(\d+)=(.*)$/) {
	my $tnr = $1;
	my $tt = $2;
	if ($tnr < 0 or $tnr >= $data{"tno"}) {
	    warn __PACKAGE__ . ": parse error (illegal track number $tnr " . 
		"in TTITLE line in freedb entry)\n";
	    return ();
	}
	# The track title may contain both title and artist.
	# These are extracted later
	$compilation = 1 if ($tt =~ / \/ /);
	if (defined($data{"track"}->[$tnr])) {
	    $data{"track"}->[$tnr] .= $tt;
	} else {
	    $data{"track"}->[$tnr] = $tt;
	}
	$data{"track"}->[$tnr] = "" unless $data{"track"}->[$tnr];
	$i++;
    }

    if ($lines[$i] !~ /^EXTD=/) {
	warn __PACKAGE__ . ": parse error (missing EXTD " . 
	    "line in freedb entry)\n";
	print "DEBUG: line = '". $lines[$i]. "'\n" if $debug;
	return ();
    }
    while ($lines[$i] =~ /^EXTD=(.*)$/) {
	if (defined($data{"extdisc"})) {
	    $data{"extdisc"} .= $1;
	} else {
	    $data{"extdisc"} = $1;
	}
	$i++;
    }
    $data{"extdisc"} = "" unless $data{"extdisc"};

    if ($lines[$i] !~ /^EXTT\d+=/) {
	warn __PACKAGE__ . ": parse error (missing EXTT " . 
	    "line in freedb entry)\n";
	return ();
    }
    while ($lines[$i] =~ /^EXTT(\d+)=(.*)$/) {
	my $tnr = $1;
	my $extt = $2;
	if ($tnr < 0 or $tnr >= $data{"tno"}) {
	    warn __PACKAGE__ . ": parse error (illegal track number in " . 
		"EXTT line in freedb entry)\n";
	    return ();
	}
	if (defined($data{"exttrack"}->[$tnr])) {
	    $data{"exttrack"}->[$tnr] .= $extt;
	} else {
	    $data{"exttrack"}->[$tnr] = $extt;
	}
	$data{"exttrack"}->[$tnr] = "" unless $data{"exttrack"}->[$tnr];
	$i++;
    }

    if ($lines[$i] =~ /^PLAYORDER=(\d+(,\d+)*)?$/) {
	if (defined($1)) {
	    @{$data{"playorder"}} = split (/,/, $1);
	    foreach my $tnr (@{$data{"playorder"}}) {
		if ($tnr < 0 or $tnr >= $data{"tno"}) {
		    warn __PACKAGE__ . ": parse error (playorder " . 
			"contains illegal track number in freedb entry)\n";
		    # No requirement to abort here, 
		    # just reset to empty list
		    @{$data{"playorder"}} = ();
		}
	    }
	}
	$i++;
    } else {
	warn __PACKAGE__ . ": parse error (missing or malformed " . 
	    "PLAYORDER line in freedb entry)\n";
    }
    @{$data{"playorder"}} = () unless (exists($data{"playorder"}));
    
    # Don't forget to look for remaining lines
    if ($i <= $#lines) {
	print STDERR __PACKAGE__ . ": ignoring additional lines at end " . 
	    "of entry\n";
    }
    
    if ($compilation) {
	for (my $tnr = 0; $tnr < $data{"tno"}; $tnr++) {
	    if ($data{"track"}->[$tnr] =~ /^(.*) \/ (.*)$/) {
		$data{"trackartist"}->[$tnr] = $1;
		$data{"tracktitle"}->[$tnr] = $2;
	    } else {
		$data{"trackartist"}->[$tnr] = $data{"artist"};
		$data{"tracktitle"}->[$tnr] = $data{"track"}->[$tnr];
	    }
	}
    }
    
    # Add offset for end of disc from real disc TOC
    $data{"frames"}[$data{"tno"}] = 
	$toc->[$data{"tno"}]->{"frames"};
    # Add flag for data tracks from real disc TOC
    for (my $nr = 0; $nr < $data{"tno"}; $nr++) {
	$data{"data"}[$nr] = $toc->[$nr]->{"data"};
    }

    # Check for exact match and abort for total mismatch
    my $found_id = 0;
    foreach my $i (@{$data{"idlist"}}) {
	$found_id = 1 if ($i eq $id);
    }
    if (not $found_id) {
        warn __PACKAGE__ . ": real disc id $id not found in " . 
	    "database entry\n";
	print Data::Dumper->Dump([%data], [qw(*data)]) if $debug;
	#return ();
    }

    my $found_total = 1;
    if ($data{"tno"} != $total) {
	$found_total = 0;
	warn __PACKAGE__ . ": number of tracks differ for disc " . 
	    $id . " (" . $data{"tno"} . "<->" . $total . ")\n";
	print Data::Dumper->Dump([%data], [qw(*data)]) if $debug;
	#return ();
    }

    my $found_length = 1;
    if ($data{"length"} != $length) {
	$found_length = 0;
	warn __PACKAGE__ . ": length differs for disc " . $id .
	    " (" . $data{"length"} . "<->" . $length . ")\n";
    }
    
    # This is a common case, as different drives may return slightly 
    # different track offsets. Therefore warnings are only printed
    # in debug mode and any differing track offsets in the freedb entry 
    # are discarded in favour of the given ones.
    my $found_toc = 1;
    for (my $nr = 0; $nr < $data{"tno"}; $nr++) {
	if ($data{"frames"}[$nr] != $toc->[$nr]->{"frames"}) {
	    $found_toc = 0;
	    warn __PACKAGE__ . ": frame offsets differ for track " .
		$nr . " on disc " . $id. " (" . $data{"frames"}[$nr] . 
		"<->" . $toc->[$nr]->{"frames"} . ")\n" if $debug;
	    # Only use the values of the real disc in the drive
	    $data{"frames"}[$nr] = $toc->[$nr]->{"frames"};
	}
    }
    
    print Data::Dumper->Dump([%data], [qw(*data)]) if $debug;
    return %data;
}


# Cut all end of line characters from end of the input string.
sub _chommp {
    my $in = $_[0];
    $in =~ s/[\n\r]*$//sg;
    return $in;
}


# Check whether the bytes of a given string form a valid UTF-8 
# sequence (see RFC 3629 for a definition)
sub _is_valid_utf8 {
    my $utf8 = shift;
    return ($utf8 =~ /^(([\0-\x7F])|([\xC2-\xDF][\x80-\xBF])|((([\xE0][\xA0-\xBF])|([\xE1-\xEC\xEE-\xEF][\x80-\xBF])|([\xED][\x80-\x9F]))[\x80-\xBF])|((([\xF0][\x90-\xBF])|([\xF1-\xF3][\x80-\xBF])|([\xF4][\x80-\x8F]))[\x80-\xBF][\x80-\xBF]))*$/);
}



1;
__END__
# Below is the documentation for this module

=head1 NAME

freedb_cache - Read the freedb entry for an audio CD in your drive

=head1 SYNOPSIS

 use freedb_cache qw( get_cddb get_discids);

 # Configuration options may be passed to the get_cddb function in form
 # of a hash as shown here. See below for a list of available options.
 my %config;

 my %cd = get_cddb(\%config);
 die "Error retrieving freedb entry" unless (%cd);

 print "artist: $cd{artist}\n";
 print "title: $cd{title}\n";
 print "genre: $cd{genre}\n";
 print "year: $cd{year}\n";
 print "number of tracks: $cd{tno}\n";
 print "category: $cd{cat}\n";
 print "freedb id: $cd{id}\n";

 my $n = 1;
 foreach my $i (@{$cd{track}}) {
   print "track $n: $i\n";
   $n++;
 }

=head1 DESCRIPTION

This module/script gets the freedb info for an audio CD. It first 
tries to find the freedb info in a local cache directory before 
contacting a freedb server. Entries fetched from a server will be 
written to the cache directory (although this may be disabled).
Freedb protocol level 6 is supported, so all disc information is 
encoded in UTF-8 .

This module works on Linux, Solaris (untested), BSD (untested) and
requires either a local freedb database (the cache directory), 
an active internet connection or both.

As freedb_cache is based on the CDDB_get module, it tries to be backward 
compatible. So valid input and output for CDDB_get.pm is compatible with
freedb_cache with the following exception:
CDDB_get returns 'undef' for some error conditions while this module
always returns an empty hash, if no valid freedb entry can be retrieved.


=head1 FUNCTIONS

=head2 get_discids($cddev)

    Reads table of contents (TOC) from audio cd in device $cddev
    and returns an array containing a freedb identifier for this disc. 
    freedb uses the discID, the total number of tracks and the frame 
    offset of each track for the identifier. The returned array contains 
    the discID, the number of tracks and a reference to another array 
    containing the frame offsets.

=head2 get_cddb(\%config, $discIdent)

    Retrieves entries matching the freedb identifier $discIdent from a 
    freedb server or a local cache using the configuration in %config. 
    The freedb identifier is optional. If missing it uses the 
    identification from the audio cd in the device given by 
    $config{CD_DEVICE}.

    On success it returns a hash with the disc data (or an array of hashes 
    if $config{MULTI} is set). Otherwise an emty hash is returned.
    For backward compatiblity the hash contains the same keys as the one 
    returned by CDDB_get:

       Key    -    Value
    --------------------------------------
     "artist"      Artist of audio cd
     "title"       Title of audio cd
     "cat"         Freedb category. This is basically the directory in 
                   the database and is not guaranteed to be a meaningful 
                   description of the music on the audio cd.
     "id"          Disc ID
     "tno"         Number of tracks on audio cd
     "frames"      This is a reference to an array that contains frame 
                   offsets for all tracks
     "data"        Reference to an array that contains the data flag for 
                   each track (i.e. if it's a music or non-music track)
     "track"       Reference to an array that contains the title of each 
                   track. Note that some entries contain a combined 
                   "artist / title" value here
     "raw"         Reference to an array that contains all raw lines of 
                   the freedb entry

    These additional keys are only present here but not in CDDB_get:
       Key    -    Value
    --------------------------------------
     "length"      Length of the complete audio cd in seconds
     "revision"    Revision number of the freedb entry
     "submitter"   Which client sumitted the freedb entry
     "ids"         Reference to an array that contains all disc IDs for 
                   this freedb entry (sometimes there are different 
                   editions and disc IDs for the same freedb entry)
     "year"        Year of Publication of this audio cd
     "genre"       Music genre (this may be equal to the category but is 
                   often complety different)
     "extdisc"     Extended information about this audio cd
     "exttrack"    Reference to an array that contains extended 
                   information for each track
     "playorder"   Playorder of the tracks on the audio cd (if there is 
                   one in the freedb entry)

     The last two keys exist only for audio cds that have individual 
     artist names included in each tracks "title" value (often found on 
     soundtracks and compilations):
     "tracktitle"  Reference to an array that contains (only) the artist 
                   name of each track
     "trackartist" Reference to an array that contains (only) the title 
                   of each track


=head1 OPTIONS

To configure settings, pass a hash reference with your settings to the 
get_cddb function. The following configuration keys need to be declared 
only if different from these defaults:

The name of the freedb server you want to use
  $config{CDDB_HOST} = "freedb.freedb.org";

Use this port on the freedb server.
  $config{CDDB_PORT} = 8880;

Which protocol should be used. Freedb servers typically offer their
services via "http" on port 80 and via "cddbp" on port 8880 or 888.
(the value "cddb" may also be used for backward compatibility)
  $config{CDDB_MODE} = "cddbp";

The freedb client identification (the format is defined in the 
freedb protocol)
  $config{CDDB_CLIENT} = "anonymous nowhere.test freedb_cache 1.16";

Set this to the name of your proxy server, if you're using one
  $config{HTTP_PROXY} = "";

Set this to a true value, if requests must pass a firewall
  $config{FW} = "";

The name of the device containing the audio cd
  $config{CD_DEVICE}="/dev/cdrom";

Your local freedb cache directory. This directory must contain a 
freedb database in UNIX format (you may of course start with an empty
directory).
  $config{CACHE_DIR}="/usr/share/cddb";

If this is true, the cache directory is queried first for freedb 
entries. Only if there is no matching entry, a connection to a freedb 
server is made. New entries retrieved from the server are saved in the 
cache directory.
  $config{USE_CACHE} = 1;

If you set this to a false value (0), only the local cache is searched
for entries (i.e. there are no network connection attempts)
  $config{USE_NET} = 1;

By default, the user is asked to select the correct entry if more than 
one entry was found. If this is set to a false value, there is no user
interaction and the first matching entry is always chosen.
  $config{INTERACTIVE} = 1;

Only one freedb entry is returned by default. Set this to a true value
to get all matching entries returned.
  $config{MULTI} = 0;

Search for the same entry under different disc IDs ?
The freedb format allows entries with multiple disc IDs. Although it 
requires such entries to be accessible by linked or copied files, some
programs only insert additional IDs without creating additional files.
By default only the filenames are used to find an entry. If you set this 
to a true value, the search will look in each file if it contains 
additional disc IDs. As this slows down the search significantly you 
should use this setting only if you know exactly what you're doing!
  $config->{CACHE_SEARCH_LINKS} = 0;


=head1 AUTHOR & COPYRIGHT

Coypright (C) 2004 Michel Messerschmidt <www(at)michel-messerschmidt(dot)de>

This library is based on CDDB_get.pm 
Copyright (C) 2002 Armin Obersteiner <armin(at)xos(dot)net>


This library is released under the same conditions as Perl, that
is, either of the following:

a) the GNU General Public License Version 2 as published by the 
Free Software Foundation,

b) the Artistic License.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See either
the GNU General Public License or the Artistic License for more details.

You should have received a copy of the Artistic License with this
Kit, in the file named "Artistic".  If not, I'll be glad to provide one.

You should also have received a copy of the GNU General Public License
along with this program, in the file names "Copying"; if not, write to 
the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, 
MA 02111-1307, USA.


=head1 SEE ALSO

perl(1), CDDB_get(3pm), Linux: <file:/usr/include/linux/cdrom.h>, 
Solaris: <file:/usr/include/sys/cdio.h>.

=cut