MP3::Tag::Cue - Module for parsing F<.cue> files.

  my $db = MP3::Tag::Cue->new($filename, $track);	# Name of audio file
  my $db = MP3::Tag::Cue->new_from($record, $track); # Contents of .cue file

  ($title, $artist, $album, $year, $comment, $track) = $db->parse();

   Foo/bar.cue
   Foo/bar/04.wav

package MP3::Tag::Cue;

use strict;
use File::Basename;
#use File::Spec;
use vars qw /$VERSION @ISA/;

$VERSION="1.00";
@ISA = 'MP3::Tag::__hasparent';

# Constructor

sub new_from {
    my ($class, $data, $track) = @_;
    bless {data => [split /\n/, $data], track => $track}, $class;
}

sub matches($$$) {
  my ($f1, $f, $case) =  (shift, shift, shift);
  substr($f1, -4, 4) = '';
  return $f1 eq substr $f, 0, length $f1 if $case;
  return lc $f1 eq lc substr $f, 0, length $f1;
}

sub find_cue ($$) {
  my ($f, $d, %seen) = (shift, shift);
  require File::Glob;			# "usual" glob() fails on spaces...
  my @cue = (File::Glob::bsd_glob("$d/*.cue"), File::Glob::bsd_glob('$d/*.CUE'));
  @seen{@cue} = (1) x @cue;		    # remove duplicates:
  @cue = keys %seen;
  my $c = @cue;
  @cue = grep matches($_, $f, 0), @cue if @cue > 1;
  @cue = grep matches($_, $f, 1), @cue if @cue > 1;
  ($c, @cue)
}

sub new_with_parent {
    my ($class, $f, $p, $e, %seen, @cue) = (shift, shift, shift);
    $f = $f->filename if ref $f;
    $f = MP3::Tag->rel2abs($f);
    if ($f =~ /\.cue$/i and -f $f) {
      @cue = $f;
    } else {
      my $d = dirname($f);
      (my $c, @cue) = find_cue($f, $d);
      unless ($c) {
	my $d1 = dirname($d);
        (my $c, @cue) = find_cue($d, $d1);
      }
    }
    return unless @cue == 1;
    local *F;
    open F, "< $cue[0]" or die "Can't open `$cue[0]': $!";
    if ($e = ($p or 'MP3::Tag')->get_config1('decode_encoding_cue_file')) {
      eval "binmode F, ':encoding($e->[0])'"; # old binmode won't compile...
    }
    my @data = <F>;
    close F or die "Error closing `$cue[0]': $!";
    bless {filename => $cue[0], data => \@data, track => shift,
	   parent => $p}, $class;
}

sub new {
    my ($class, $f) = (shift, shift);
    $class->new_with_parent($f, undef, @_);
}

# Destructor

sub DESTROY {}

sub return_parsed {
    my ($self,$what) = @_;
    if (defined $what) {
	return $self->{parsed}{collection_performer}  if $what =~/^artist_collection/i;
	return $self->{parsed}{album}  if $what =~/^al/i;
	return $self->{parsed}{performer} if $what =~/^a/i;
	return $self->{parsed}{songwriter} if $what =~/^songwriter/i;
	return $self->{parsed}{track}  if $what =~/^tr/i;
	return $self->{parsed}{date}   if $what =~/^y/i;
	return $self->{parsed}{comment}if $what =~/^c/i;
	return $self->{parsed}{genre}  if $what =~/^g/i;
	return $self->{parsed}{title};
    }
    
    return $self->{parsed} unless wantarray;
    return map $self->{parsed}{$_} , qw(title artist album year comment track);
}

my %r = ( 'n' => "\n", 't' => "\t", '\\' => "\\"  );

sub parse_lines {
    my ($self) = @_;
#    return if $self->{fields};
    my $track_seen = '';
    my $track = $self->track;
    $track = -1e100 unless $track or length $track;
    for my $l (@{$self->{data}}) {
	# http://digitalx.org/cuesheetsyntax.php
	# http://wiki.hydrogenaudio.org/index.php?title=Cuesheet
	# What about http://cue2toc.sourceforge.net/ ?  Can it deal with .toc of cdrecord?
	# http://www.willwap.co.uk/Programs/vbrfix.php - may inspect gap info???
	next unless $l =~ /^\s*(REM\s+)?
			    			    (GENRE|DATE|DISCID|COMMENT|PERFORMER|TITLE
			     			     |ISRC|POSTGAP|PREGAP|SONGWRITER
			     			     |FILE|INDEX|TRACK|CATALOG|CDTEXTFILE|FLAGS)\s+(.*)/x;
	my $field = lc $2;
	my $val = $3;
	$val =~ s/^\"(.*)\"/$1/;	# Ignore trailing fields after TRACK, FILE
	$track_seen = $1 if $field eq 'track' and $val =~ /^0?(\d+)/;
	next if length $track_seen and $track_seen != $track;

	$self->{fields}{$field} = $val;	# unless exists $self->{fields}{$field};
	next if length $track_seen;
	$self->{fields}{album} = $val if $field eq 'title';
	$self->{fields}{collection_performer} = $val if $field eq 'performer';
    }    
}

sub parse {
    my ($self,$what) = @_;
    return $self->return_parsed($what)	if exists $self->{parsed};
    $self->parse_lines;
    $self->{parsed} = { %{$self->{fields}} };	# Make a copy
    $self->return_parsed($what);
}

# *song = \&title;

sub title {
    return shift->parse("title");
}

sub artist {
    return shift->parse("artist");
}

sub track {
  my $self = shift;
  return $self->{track} if defined $self->{track};
  return if $self->{recursive} or not $self->parent_ok;
  local $self->{recursive} = 1;
  return $self->{parent}->track1;
}

sub year {
    return shift->parse("year");
}

sub album {
    return shift->parse("album");
}

sub comment {
    return shift->parse("comment");
}

sub genre {
    return shift->parse("genre");
}

for my $elt ( qw( artist_collection songwriter ) ) {
  no strict 'refs';
  *$elt = sub (;$) {
    return shift->parse($elt);
  }
}

1;