view release on metacpan or  search on metacpan

lib/MP3/Tag/Cue.pm  view on Meta::CPAN

package MP3::Tag::Cue;

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

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

=pod

=head1 NAME

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

=head1 SYNOPSIS

  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();

see L<MP3::Tag>

=head1 DESCRIPTION

MP3::Tag::Cue is designed to be called from the MP3::Tag module.

It parses the content of a F<.cue> file.

The F<.cue> file is looked for in the same directory as audio file; one of the
following conditions must be satisfied:

=over 4

=item *

The "audio" file is specified is actually a F<.cue> file;

=item *

There is exactly one F<.cue> file in the directory of audio file;

=item *

There is exactly one F<.cue> file in the directory of audio file
with basename which is a beginning of the name of audio file.

=item *

There is exactly one F<.cue> file in the directory of audio file
with basename which matches (case-insensitive) a beginning of the
name of audio file.

=back

If no F<.cue> file is found in the directory of audio file, the same process
is repeated once one directory uplevel, with the name of the file's directory
used instead of the file name.  E.g., with the files like this

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

audio file F<Foo/bar/04.wav> will be associated with F<Foo/bar.cue>.

=cut


# 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 {}

=over 4

=item parse()

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

parse_filename() extracts information about artist, title, track number,
album and year from the F<.cue> file.  $what is optional; it maybe title,
track, artist, album, year, genre or comment. If $what is defined parse() will return
only this element.

Additionally, $what can take values C<artist_collection> (returns the value of
artist in the whole-disk-info field C<PERFORMER>, C<songwriter>.

=cut

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;