# $Id: Archive.pm,v 1.13 2003/12/09 23:59:51 ianb Exp $
package MP3::Archive;

use strict;
use warnings;

use MP3::Archive::Format;
use MP3::Archive::Config;
use Cwd;

use vars qw($VERSION);
$VERSION = '0.9';

use vars qw($ALBUM $TRACK $GUESS);
$ALBUM=0;
$TRACK=1;
$GUESS=2;

require Exporter;
use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK);
@ISA = qw(Exporter);

%EXPORT_TAGS = ( 'all' => [ qw(
	$ALBUM $TRACK $GUESS
) ] );

@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

=head1 NAME

MP3::Archive - Parse filenames in a music archive

=head1 SYNOPSIS

    use MP3::Archive qw(:all);
    my $archive=MP3::Archive->new([$config]);

    if($archive->validate($file)) { ... }
    if($archive->isalbum($file))  { ... }
    if($archive->istrack($file))  { ... }
    print("File: $file",
          "\nTracknum: ",  $archive->tracknum($file),
          "\nArtist: ",    $archive->artist($file),
          "\nDirartist: ", $archive->dirartist($file),
          "\nAlbum: ",     $archive->album($file),
          "\nDiralbum: ",  $archive->diralbum($file),
          "\nTrack: ",     $archive->track($file),
          "\nExtension",   $archive->ext($file),"\n");
    print("Correct path: ",
          $archive->makepathname($fromfile,$artist,$album,$GUESS),"/",
          $archive->makefilename($fromfile,$tracknum,$artist,$album,$track,$ext),"\n");
    my $delim=$archive->delim($file,$ALBUM);
    my $fileformat=$archive->getfileformat($file);
    my $dirformat=$archive->getdirformat($file);
    my $m3uformat=$archive->getm3uformat($file);

=head1 DESCRIPTION

MP3::Archive is a module to encapsulate the parsing and creation of
filenames containing music metadata (artist, album, etc).

For instance, with the default setup, it would be
able to parse the metadata out of the pathname:

F<music/albums/Beck/Mutations/01 - Beck - Mutations - Cold Brains.mp3>	

It uses I<formats> to describe the allowed filename patterns, defined
in the config files B</etc/mp3archiverc> and B<$HOME/.mp3archiverc>,
and/or application-specific config files.

See L<MP3::Archive::Config(3)> for details.

=head1 PUBLIC METHODS

Many of these methods take the optional argument $tracktype. This
specifies whether to treat the track as an album track, non album
track, or try to guess it from the pathname of $file. If $tracktype is
not supplied, it defaults to guessing the track type.

Possible values for $tracktype are C<$ALBUM>, C<$TRACK>,
C<$GUESS>. These constants are all defined in MP3::Archive. They can
be accessed either as eg C<$MP3::Archive::ALBUM> or exported either
individually or all together with:

C<use MP3::Archive ':all';>

=cut

=head2 new

Creates an instance of MP3::Archive

Takes one optional argument, a reference to a C<MP3::Archive::Config>
object. If this is not supplied, a default Config instance is created.

This enables you to pass a subclass of C<MP3::Archive::Config> to
allow for your own applications configuration. See L<mp3lint(1)> for
an example.

=cut

sub new
{
	my $proto=shift;
	my $class=ref($proto) || $proto;
	my $self={};
	bless($self,$class);
	$self->{config}=(shift || (new MP3::Archive::Config));

	$self->{format}=new MP3::Archive::Format;
	
	$self->{lastfile}="";
	$self->{lastformat_file}=undef;
	$self->{lastformat_dir}=undef;
	
	return $self;
}

=head2 tracknum($file[,$tracktype)

Parses and returns the track number from a file. If called in list
context, also returns the offset of the tracknumber in $file.

=cut	

sub tracknum
{
	my ($self,$file,$tracktype)=@_;
	my $format;
	if($format=$self->getfileformat($file,$tracktype))
	{
		my $filepart=$self->filepart($file);
		my $prelen=length($file)-length($filepart);
		my($tracknum,$offset)=$self->format->tracknum($filepart,$format);
		unless(defined($tracknum)) { return undef; }
		
		if(wantarray)
		{
			return($tracknum,$prelen+$offset);
		}
		return $tracknum;
	}
	return undef;
}


=head2 artist($file[,$tracktype])

Parses and returns the artist name from a file. If called in list
context, also returns the offset of the artist in $file.

=cut	

sub artist 
{
	my ($self,$file,$tracktype)=@_;
	my $format;
	if($format=$self->getfileformat($file,$tracktype))
	{
		my $filepart=$self->filepart($file);
		my $prelen=length($file)-length($filepart);
		my($artist,$offset)=$self->format->artist($filepart,$format);
		unless(defined($artist)) { return undef; }
		
		if(wantarray)
		{
			return($artist,$prelen+$offset);
		}
		return $artist;
	}
	return undef;
}

=head2 dirartist($file[,$tracktype])

Parses and returns the artist name from the pathname to a file (not
the filename itself).

=cut	

sub dirartist 
{
	my ($self,$file,$tracktype)=@_;
	my $format;
	if($format=$self->getdirformat($file))
	{
		return $self->format->artist($file,$format);
	}
	return undef;
}

=head2 album($file[,$tracktype])

Parses and returns the album name from a file. If called in list
context, also returns the offset of the album in $file.

=cut	

sub album 
{
	my ($self,$file,$tracktype)=@_;
	my $format;
	if($format=$self->getfileformat($file,$tracktype))
	{
		my $filepart=$self->filepart($file);
		my $prelen=length($file)-length($filepart);
		my($album,$offset)=$self->format->album($filepart,$format);
		unless(defined($album)) { return undef; }
		
		if(wantarray)
		{
			return($album,$prelen+$offset);
		}
		return $album;
	}
	return undef;
}

=head2 diralbum($file[,$tracktype])

Parses and returns the album name from the pathname to a file (not
the filename itself).

=cut	

sub diralbum 
{
	my ($self,$file,$tracktype)=@_;
	my $format;
	if($format=$self->getdirformat($file,$tracktype))
	{
		return $self->format->album($file,$format);
	}
	return undef;
}

=head2 track($file[,$tracktype])

Parses and returns the track name (song title) from $file. If called
in list context, also returns the offset of the track name in $file.

=cut	

sub track 
{
	my ($self,$file,$tracktype)=@_;
	my $format;
	if($format=$self->getfileformat($file,$tracktype))
	{
		my $filepart=$self->filepart($file);
		my $prelen=length($file)-length($filepart);
		my($track,$offset)=$self->format->track($filepart,$format);
		unless(defined($track)) { return undef; }
		
		if(wantarray)
		{
			return($track,$prelen+$offset);
		}
		return $track;
	}
	return undef;
}

=head2 ext($file[,$tracktype])

Returns extension of $file.

=cut

sub ext 
{
	my ($self,$file,$tracktype)=@_;
	my $format;
	if($format=$self->getfileformat($file,$tracktype))
	{
		return $self->format->ext($self->filepart($file),$format);
	}
	return undef;
}

=head2 validate($file[,$tracktype])

Returns 1 if the filename of $file successfully matches one of its
acceptable formats.

Also returns 1 if the file/path has no defined formats to test against.

=cut	

sub validate 
{
	my ($self,$file,$tracktype)=@_;
	my $format;
	if($format=$self->getfileformat($file,$tracktype))
	{
		return $self->format->validate($self->filepart($file),$format);
	}
	return 1; # pretend it matched if no format defined for path
}

=head2 isalbum($file)

Returns 1 if $file is an album track, 0 otherwise.
Does not use $format_default.

=cut	

sub isalbum
{
	my ($self,$file)=@_;
	if($self->arraymatch($file,$self->config->get("paths_album")))
	{
		return 1;
	}
	return 0;
}

=head2 istrack($file)

Returns 1 if $file is a non-album track, 0 otherwise.
Does not use $format_default.

=cut	

sub istrack
{
	my ($self,$file)=@_;
	if($self->arraymatch($file,$self->config->get("paths_track")))
	{
		return 1;
	}
	return 0;
}

=head2 format

Returns a reference to the associated C<MP3::Archive::Format>
object;

=cut

sub format { return shift->{format}; }

=head2 config

Returns a reference to the associated C<MP3::Archive::Config>
object;

=cut

sub config { return shift->{config}; }

=head2 getfileformat($file[,$tracktype])

Returns the format appropriate for a file of this type and location.

=cut

sub getfileformat
{
	my ($self,$file,$tracktype)=@_;
	if($file=~/\.m3u$/i)
	{
		return $self->getformat($file,"m3u",$tracktype);
	}
	return $self->getformat($file,"file",$tracktype);
}

=head2 getdirformat($file[,$tracktype])

Returns the format for the directory portion of a file of this type
and location.

=cut	

sub getdirformat
{
	my ($self,$file,$tracktype)=@_;
	return $self->getformat($file,"dir",$tracktype);
}

=head2 getm3uformat($file[,$tracktype])

Returns the format for a playlist (m3u) file in the specified
location.

=cut

sub getm3uformat
{
	my($self,$file,$tracktype)=@_;
	return $self->getformat($file,"m3u",$tracktype);
}


=head2 makefilename($file,$tracknum,$artist,$album,$track,$ext[,$tracktype])

Returns a correctly formatted filename with the fields filled in.

=cut	

sub makefilename
{
	my($self,$filepath,$tracknum,$artist,$album,$track,$ext,$tracktype)=@_;
	unless(defined($tracknum)) { $tracknum = ''; }
	unless(defined($artist))   { $artist   = ''; }
	unless(defined($album))    { $album    = ''; }
	unless(defined($track))    { $track    = ''; }
	unless(defined($ext))      { $ext      = ''; }

	my $default=$self->config->get("format_default");
	my $format;

	# screwed config
	unless(defined($default)) { $default="album"; }

	if(((defined($tracktype)) && ($tracktype==$ALBUM)) ||
	   ((defined($tracktype)) && ($tracktype==$GUESS) &&
		(($self->isalbum($filepath)) || ($default !~ /track/i))))
	{
		$format=$self->config->get("format_write_album");
	}
	else
	{
		$format=$self->config->get("format_write_track");
	}

	return($self->format->makefilename($tracknum,$artist,$album,$track,$ext,$format));
}

=head2 makepathname($fromfile,$artist,$album[,$tracktype])

Returns the pathname (without filename) that $fromfile belongs in.

=cut	

sub makepathname
{
	my($self,$fromfile,$artist,$album,$tracktype)=@_;

	my $fullpath;
	if($fromfile=~/^(.*\/)(.*)/)
	{
		$fullpath=Cwd::abs_path($1) . "/" . $2;
	}
	else
	{
		$fullpath=Cwd::getcwd . "/" . $fromfile;
	}
   
	my $writeformat;
	my $formats;
	my $pathstart;

	my $albumwriteformat=$self->config->get("format_write_album_dir");
	my $trackwriteformat=$self->config->get("format_write_track_dir");

	my $default=$self->config->get("format_default");
	my $albumpathstart=$self->config->get("path_write_album");
	my $trackpathstart=$self->config->get("path_write_track");

	# screwed config
	unless(defined($default)) { $default="album"; }

	if($tracktype==$ALBUM)
	{
		$writeformat=$albumwriteformat;
		$pathstart=$albumpathstart;
	}
	elsif($tracktype==$TRACK)
	{
		$writeformat=$trackwriteformat;
		$pathstart=$trackpathstart;
	}
	else # guess
	{
		if(($self->isalbum($fullpath)) || ($default !~ /track/i))
		{
			$writeformat=$albumwriteformat;
			$pathstart=$albumpathstart;
		}
		else
		{
			$writeformat=$trackwriteformat;
			$pathstart=$trackpathstart;
		}
	}
	if(($writeformat=~/ALBUM/) && (!(defined($album))))
	{
#		warn("$me: $fromfile: cannot extract album name\n");
		return undef;
	}
	if(($writeformat=~/ARTIST/) && (!(defined($artist))))
	{
#		warn("$me: $fromfile: cannot extract artist name\n");
		return undef;
	}

	return($self->format->makepathname($pathstart,$artist,$album,$writeformat));
}

=head1 delim($file[,$tracktype])

Returns the correct field delimiter for this type of file.

=cut

sub delim
{
	my($self,$file,$tracktype)=@_;
	my $delim;
	if(((defined($tracktype)) && ($tracktype==$ALBUM)) ||
	   ((defined($tracktype)) && ($tracktype==$GUESS) &&
		(($self->isalbum($file)) || ($self->config->get("format_default") !~ /track/i))))
	{
		$delim=$self->config->get("format_delimiter_album");
	}
	else
	{
		$delim=$self->config->get("format_delimiter_track");
	}
	unless(defined($delim)) { $delim=" - "; } # default
	return $delim;
}

=head1 INTERNAL METHODS

=head2 filepart($file)

Returns the filename with the path stripped off. Can be called as a
static method.

=cut

sub filepart
{
	my $file=shift;
	if(ref($file)) # method call
	{
		$file=shift;
	}
	$file=~s/^.*\///;
	return $file;
}

=head2 getformat($file,$type[,$tracktype])

Returns the appropriate format for the specified file and type.

Accepted types are C<file>, C<dir>, and C<m3u>.

This is a helper method for the above get.*format methods.

=cut

sub getformat
{
	my ($self,$file,$type,$tracktype)=@_;
	if((defined($self->{lastformat_file})) &&
	   (defined($self->{lastformat_m3u}))  &&
	   (defined($self->{lastformat_dir}))  &&
	   (defined($tracktype)) && ($tracktype eq $self->{lasttracktype}) &&
	   ($file eq $self->{lastfile}))
	{
		return $self->{"lastformat_".$type};
	}
	$self->{lastfile}=$file;

	if(defined($tracktype) && ($tracktype==$ALBUM))
	{
		$self->{lastformat_file}=$self->config->get("formats_album");
		$self->{lastformat_dir}=$self->config->get("formats_album_dir");
		$self->{lastformat_m3u}=$self->config->get("formats_album_m3u");
	}
	elsif(defined($tracktype) && ($tracktype==$TRACK))
	{
		$self->{lastformat_file}=$self->config->get("formats_track");
		$self->{lastformat_dir}=$self->config->get("formats_track_dir");
		$self->{lastformat_m3u}=$self->config->get("formats_track_m3u");
	}
	else # $GUESS or not specified
	{
		if(($self->isalbum($file)) ||
		   ($self->config->get("format_default") eq "album"))
		{
			$self->{lastformat_file}=$self->config->get("formats_album");
			$self->{lastformat_dir}=$self->config->get("formats_album_dir");
			$self->{lastformat_m3u}=$self->config->get("formats_album_m3u");
		}
		elsif(($self->istrack($file)) ||
			  ($self->config->get("format_default") eq "track"))
		{
			$self->{lastformat_file}=$self->config->get("formats_track");
			$self->{lastformat_dir}=$self->config->get("formats_track_dir");
			$self->{lastformat_m3u}=$self->config->get("formats_track_m3u");
		}
		else
		{
			$self->{lastformat_file}=undef;
			$self->{lastformat_dir}=undef;
			$self->{lastformat_m3u}=undef;
		}
	}
	$self->{lasttracktype}=$tracktype;
	return $self->{"lastformat_".$type};
}

=head2 arraymatch($file,$array)

Canonicalises $file path, then does a regexp match on each element of
$array.  Returns 1 if match, else 0

=cut

sub arraymatch
{
	my($self,$file,$array)=@_;
	my $path=$file;
	
	if(-d $file)
	{
		$path=Cwd::abs_path($file);
	}
	else
	{
		if($file=~/(.*\/).*/)
		{
			$path=Cwd::abs_path($1);
		}
		else
		{
			$path=getcwd;
		}
	}		
		
	for my $match (@{$array})
	{
		if(($file=~/$match/) ||
		   ($path=~/$match/))
		{
			return 1;
		}
	}
	return 0;
}

1;

__END__

=head1 BUGS

Formats may not be general enough, I would be interested in feedback
from people with other file naming conventions.

=head1 SEE ALSO    

L<MP3::Archive::Config(3)>, L<MP3::Archive::Format(3)>, L<mp3lint(1)>,
L<mp3-archive-tools(1)>

=head1 AUTHOR

Ian Beckwith <ianb@nessie.mcc.ac.uk>

=head1 AVAILABILITY

The latest version can be found at:

 B<http://nessie.mcc.ac.uk/~ianb/projects/libmp3-archive-perl/>

=head1 COPYRIGHT

Copyright 2003 Ian Beckwith <ianb@nessie.mcc.ac.uk>

This module is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or (at
your option) any later version.

This module 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 the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

=cut
