# $Id: Format.pm,v 1.12 2003/12/14 09:45:00 ianb Exp $
package MP3::Archive::Format;

use strict;
use warnings;

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

=head1 NAME

MP3::Archive::Format - Helper class for MP3::Archive

=head1 SYNOPSIS

    use MP3::Archive::Format;
    my $f=MP3::Archive::Format->new;
    if($f->validate($file,$format) {
        print("Track num: ",$f->tracknum($file,$format),
              "Artist: ",$f->($file,$format),
              "Album: ",$f->($file,$format),
              "Track: ",$f->($file,$format),
              "Ext: ",$f->($file,$format),"\n");
    }
    print("Correct path: ",
          $f->makepathname($fromfile,$artist,$album,$format),"/",
          $f->makefilename($fromfile,$tracknum,$artist,$album,$track,$ext,$format),"\n");

=head1 DESCRIPTION

MP3::Archive::Format is a helper class for MP3::Archive. Many of the
methods in it are essentially duplicates of ones in
L<MP3::Archive(3)>, but with the formats specified explicitly rather
than inferred from configuration. These are used internally, but can
also be useful if you need more control from your application.

=head1 METHODS

=cut

=head2 new

Creates an instance of MP3::Archive::Format

=cut

sub new
{
	my $proto=shift;
	my $class=ref($proto) || $proto;
	my $self={};
	bless($self,$class);

	@{$self->{taglist}}=qw(TRKNUM ARTIST ALBUM TRACK EXT);
	@{$self->{dirtaglist}}=qw(ARTIST ALBUM);

	return $self;
}

=head2 tracknum, artist, album, track, ext, validate, makefilename, makepathname

These methods are essentially the same as their counterparts in
MP3::Archive, with the exception that they expect a format as well as
a filename (eg C<artist($file, $format)>, and do not take an optional
tracktype. A format is a reference to an array of strings containing
regular expressions. See L<MP3::Archive::Config(3)> for details on
formats.

=cut

sub tracknum
{
	my ($self,$file,$formats)=(@_);
	my @num=$self->parse($file,$formats,"TRKNUM");
	if((!@num) || (!defined($num[0])) || ($num[0] !~ /^\d+$/))
	{
		return undef;
	}
	return((wantarray)?(@num):($num[0]));
}

sub artist
{
	my ($self,$file,$formats)=(@_);
	return $self->parse($file,$formats,"ARTIST");
}

sub album
{
	my ($self,$file,$formats)=(@_);
	return $self->parse($file,$formats,"ALBUM");
}

sub track
{
	my ($self,$file,$formats)=(@_);
	return $self->parse($file,$formats,"TRACK");
}

sub ext
{
	my ($self,$file,$formats)=(@_);
	return $self->parse($file,$formats,"EXT");
}

sub validate
{
	my ($self,$file,$formats)=@_;
	return $self->parse($file,$formats,""); 
}


sub makefilename
{
	my($self,$tracknum,$artist,$album,$track,$ext,$format)=@_;
	my $filename=$format;
	$filename=$self->replace($filename,$tracknum,"TRKNUM");
	$filename=$self->replace($filename,$artist,"ARTIST");
	$filename=$self->replace($filename,$album,"ALBUM");
	$filename=$self->replace($filename,$track,"TRACK");
	$filename=$self->replace($filename,$ext,"EXT");
	
	return $filename;
}

sub makepathname
{
	my($self,$pathstart,$artist,$album,$format)=@_;
	my $path=$format;
	$path=$self->replace($path,$artist,"ARTIST");
	$path=$self->replace($path,$album,"ALBUM");
	$path=$pathstart ."/" . $path;
	$path=~s,/+,/,g; # remove duplicate slashes
	return $path;
}

=head1 INTERNAL METHODS

=head2 replace($format,$var,$tag)

Replaces $tag with $var in $format.  $tag can be one of C<TRKNUM>,
C<ARTIST>, C<ALBUM>, or C<TRACK>.

=cut	

sub replace
{
	my ($self,$format,$var,$tag)=@_;

	$var='' unless defined($var);
	$tag=uc($tag);

	# skip unless it mentions the tag we are searching for
	return($format) unless($format=~/$tag/);

	$format=~s/$tag/$var/g;
	return $format;
}

=head2 parse($file,$format,$tag)

Parse formats. $tag is the tag (eg "ARTIST") we are interested in.
Returns the matching data. If called in array context, also
returns the offset of the start of that data.

=cut	

sub parse
{
	my ($self,$file,$formats,$tag)=@_;

	$tag=uc($tag);
	foreach my $format (@{$formats})
	{
#		print "FORMAT: $tag: $format: $file\n";
		my $re="(.*?$format";
		# skip format unless it mentions the tag we are searching for
		next unless($format=~/$tag/);

		# kludge so validate works
		if($tag eq "") { $re .= ")"; }
#	print "0: $re\n"; my $count=1;

		for my $search (@{$self->{taglist}})
		{
#		print "S: $search\n";
			my $replace="[^\/]+";
			if($search eq "TRKNUM")
			{
				$replace='\d+';
			}
			if($search eq $tag)
			{
				$replace=")($replace)";
			}
			$re=~s/$search/$replace/i;
#		print $count++,": $re\n";
		}
		#$file=~s/(?:.*\/)?(.*)/$1/;
#		print "re: $re   file: $file\n";
		if($file=~/$re/)
		{
#			print "MATCH";
			my $length=0;
			$length=length($1) if defined($1);
			if(defined($2))
			{
				if(wantarray)
				{
					return($2,$length);
				}
				else
				{
					return($2);
				}
			}
#			print "(undef)\n";
			return 1;
		}
	}
	return undef;
}

=head1 BUGS

None known. Please report any found to ianb@nessie.mcc.ac.uk	

=head1 SEE ALSO    

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

=head1 AUTHOR

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

=cut

1;
