# $Id: Config.pm,v 1.13 2003/12/06 17:36:56 ianb Exp $
package MP3::Archive::Config;

use strict;
use warnings;

use MP3::Archive;

use vars qw($VERSION $MP3ARCHIVERC $MP3ARCHIVEENV $MP3ARCHIVESYSRC);
$VERSION = '0.01';

$MP3ARCHIVEENV="MP3ARCHIVERC";
$MP3ARCHIVERC="$ENV{HOME}/.mp3archiverc";
$MP3ARCHIVESYSRC="/etc/mp3archiverc";

=head1 NAME

MP3::Archive::Config - Configuration handling for MP3::Archive

=head1 SYNOPSIS

    my $conf=MP3::Archive::Config->new([\%newopts]);
    my $opts=$conf->parseconfig($conf->readconfigfile($file);
    $conf->setopts($opts);
    my $value=$conf->get("conf_var_name");

=head1 DESCRIPTION

MP3::Archive::Config handles the configuration for MP3::Archive. By
default, it uses F</etc/mp3archiverc> and F<~/.mp3archiverc> (or
B<$ENV{MP3ARCHIVERC}> if defined) for configuration (as well as
reasonable defaults), but it can optionally use application-specific
config files as well as or instead of the defaults.

The config file format is a fragment of perl which sets the
configuration variables.

The user configuration file is automatically created the first time
B<new> is called. See L<METHODS/new> for details.

=head1 CONFIGURATION FILES

What files are consulted depends on the options passed to B<new>. See
L<METHODS/new> for more details. The order is as follows:

=over 4

=item 1 Internal defaults are set.

=item 2 Unless $apprconly is set in C<new()>, the default config files are loaded:

=over 6

=item 2.1 /etc/mp3archiverc is loaded.

=item 2.2 If $ENV{MP3ARCHIVERC} is defined and exists, it is loaded.

=item 2.3 Else, ~/.mp3archiverc is loaded.

=back

=item 3 If $sysrc is set in C<new()> it is loaded.

=item 4 If $rcenv is set in C<new()>, and $ENV{$rcenv} is defined and exists, it is loaded.

=item 5 Else, if $rcfile is set in C<new()> it is loaded.

=back

If you use L<mp3lint(1)>, and want to share the configuration, then
either create F<.mp3archiverc> as a symbolic link to F<.mp3lintrc>, with:

B< ~$ ln -sf ~E<sol>.mp3lintrc ~E<sol>.mp3archiverc>

or change F<.mp3archiverc> so it just says:

B<require "$ENV{HOME}E<sol>.mp3lintrc";>

which will effectively include F<.mp3lintrc> into F<.mp3archiverc>.
For this to work, the last line of F<.mp3lintrc> should be C<1;>,
or at least evaluate to true

=head1 FORMATS

Formats are used to specify valid filenames and to specify
where the artistname, albumname, etc are located.

Formats are regular expressions (see L<perlretut(1)> and
L<perlre(1)>), but with B<ARTIST>, B<ALBUM>, B<TRACK>, B<TRKNUM> and
B<EXT> as placeholders for the artist, album, track name (song title),
track number and extension respectively.

There are two types of formats.

Variables beginning with C<$formats_> are lists of permissible formats
for parsing a filename, each of which are regular expressions (see
L<perlretut(1)> and L<perlre(1)> for details). The formats are
references to arrays, which essentially means you can have as many as
you want, separated by commas, and they must start and end with B<[>
and B<]> respectively. The individual formats should be quoted with
single quotes (B<'>).

Variables beginning with C<$format_> are single formats that are
ordinary strings, not regular expressions, and are used when creating
filenames. They don't have B<[> and B<]> round them, but still should
be quoted with single quotes (B<'>), and there should be only one of
them, not a list.

=head2 Examples

These are from the default setup.

C<$formats_album=S<['TRKNUM - ARTIST - ALBUM - TRACK\.EXT'>,
			  S<'ARTIST - ALBUM - TRKNUM - TRACK\.EXT'];>>

This defines two acceptable formats for album tracks.
The first one would match eg:

F<S<01 - Talk Talk - Spirit Of Eden - The Rainbow.mp3>>

and the second one would match eg:

F<S<DJ Shadow - Endtroducing - 07 - Stem-Long Stem.mp3>>

C<S<$formats_track=['ARTIST - TRACK\.EXT'];>>

This defines one acceptable format for non-album tracks. This would
match eg:

F<S<Radiohead - Paranoid Android (Live at the 10 Spot).ogg>>

C<S<$format_write_album='TRKNUM - ARTIST - ALBUM - TRACK.EXT';>>

This can be though of as the reverse of $formats_album. It defines the
format to be used when creating a file, so in this example, given
TRKNUM "02", ARTIST "Dead Can Dance", ALBUM "Aion", TRACK
"Saltarello", and EXT "wav", it would produce the filename:

 02 - Dead Can Dance - Aion - Saltarello.wav

=head1 CONFIGURATION VARIABLES

=over 4

=item B<$formats_album>

This specifies acceptable formats for album tracks.

Default:

C<$formats_album= S<['TRKNUM - ARTIST - ALBUM - TRACK\.EXT'>, S<'ARTIST - ALBUM - TRKNUM - TRACK\.EXT'];>>

See above for details.

=item B<$formats_track>

This specifies acceptable formats for non-album tracks.

Default:

C<S<$formats_track=['ARTIST - TRACK\.EXT'];>>

See above for details.

=item B<$formats_album_dir>

This specifies how to extract info from the directory of an
album track.

Default:

C<$formats_album_dir= S<['ARTIST - ALBUM$','ARTIST\/ALBUM$'];>>

This would match

B<S</Spiritualised - Lazer Guided Melodies/>>

or

B<S</Spiritualised/Pure Phase/>>

both at the end of the pathname.

=item B<$formats_track_dir>

This specifies how to extract info from the directory of a non-album track.

Default:

C<$formats_track_dir= S<['ARTIST$'];>>

This specifies the last portion of the pathname is the artist.

=item B<$formats_album_m3u>, B<$formats_track_m3u>

Specifies the format of m3u playlist filenames for album and non-album
tracks.

Default:

C<$formats_album_m3u= S<['ARTIST - ALBUM\.EXT'];>>

C<$formats_track_m3u = S<['ARTIST\.EXT'];>>

=item B<$format_default>

How to treat tracks that are not in C<$paths_album> or
C<$paths_track>.  This can be B<album>, B<track>, or anything else,
which means don't test the files at all (eg B<skip>).

Default:

$format_default="skip";

=item B<$format_delimiter_album>, B<$format_delimiter_track>

These specify the delimiters for album and non-album tracks.  This
allows extra checks, eg to make sure there are the right number of
fields (eg, if the delimiter is `-' and you have a track named
I<S<Stem - Long Stem>>, so the file is called

F<S<07 - DJ Shadow - Entroducing - Stem - Long Stem.mp3>>

then the extra dash will cause you problems, but specifying a
delimiter will allow mp3lint to determine there are too many fields.

Default:

C<$format_delimiter_album= S<' - ';>>

C<$format_delimiter_track= S<' - ';>>

=item B<$paths_album>, B<$paths_track>

These are used to determine from its pathname whether a file should be
treated as part of an album. They are regular expressions, so the same
warnings about quoting apply as to formats. This also means that they
are substring matches, so the defaults below match any pathname that
contains a component called B<albums> or B<tracks>. Although there is
only one path each in the default, they can be lists of multiple paths
(or portions of paths) to match.

Default:

C<$paths_album=['album'];>

C<$paths_track=['track'];>

This means that any pathname containing F</albums> or F</tracks> will
be treated accordingly (eg F</music/groovy-albums/>).

=item B<$archive_root>

$archive_root is currently only used to define the $path_write_*
variables (below), but its use may be expanded in the future.

Default:

C<$archive_root="$ENV{HOME}/music";>

On any sane unix system, $ENV{HOME} expands to your home directory.

=item B<$path_write_album>, B<$path_write_track>

$path_write_album and $path_write_track are used to determine the
canonical pathname for files, for tools like L<movemusic(1)>.

The defaults are defined relative to $archive_root (see above).

Defaults:

C<S<$path_write_album="$archive_root/cut/albums/";>>
C<S<$path_write_track="$archive_root/tracks/";>>

=item B<$format_write_album>, B<$format_write_track>,
B<$format_write_album_m3u>, B<$format_write_track_m3u>,
B<$format_write_album_dir>, B<$format_write_track_dir>,

These variables are analogous to the $formats_* variables above, but
they are used for constructing filenames rather than parsing them to
extract information. They are not regular expressions, they are
ordinary strings, and there is only one of each rather than a list
(array). The same magic variables ("TRKNUM", "ARTIST", "ALBUM",
"TRACK") are used and are replaced with the actual data.

Defaults:

C<S<$format_write_album='TRKNUM - ARTIST - ALBUM - TRACK.EXT';>>

C<S<$format_write_track='ARTIST - TRACK.EXT';>>

C<S<$format_write_album_m3u='ARTIST - ALBUM.EXT';>>

C<S<$format_write_track_m3u='ARTIST.EXT';>>

C<S<$format_write_album_dir="/ARTIST/ALBUM/";>>

C<S<$format_write_track_dir="/ARTIST/";>>

=back

=head1 METHODS

=head2 new([$optshashref]);

Creates an instance of MP3::Archive::Config

Takes an optional reference to a hash of options:

=over 4

=item defaults

A scalar containing perl code for additional default options.

=item rcfile

An additional application-specific and user-specific config file.

=item rcenv

The name of an environment variable, which, if defined and exists, is
used instead of C<rcfile>.

=item sysrc

An additional system-wide (ie in F</etc> or F</usr/local/etc>)
application-specific config file.

=item apprconly

If non-zero, skips /etc/mp3archiverc and $HOME/.mp3archiverc, and
just uses the application-specific config files defined above.

=back

If it doesn't exist, the user config file is created, containing the
defaults. This file is either C<$ENV{$rcenv}>, C<$rcfile>, or
C<~/.mp3archiverc>, depending what is defined.

=cut

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

	$self->{me}=($0=~/(?:.*\/)?(.*)/)[0];
	
	$self->{userconfig}={};

	my $args=shift;
	my $argdefaults=undef;
	my $rcfile=undef;
	my $rcenv=undef;
	my $sysrc=undef;
	my $apprconly=0;
	if(defined($args))
	{
		if(exists($args->{defaults}))  { $argdefaults=$args->{defaults}; }
		if(exists($args->{rcfile}))    { $rcfile=$args->{rcfile};        }
		if(exists($args->{sysrc}))     { $sysrc=$args->{sysrc};          }
		if(exists($args->{rcenv}))     { $rcenv=$args->{rcenv};          }
		if(exists($args->{apprconly})) { $apprconly=$args->{apprconly};	 }
	}
	
	my $defaults=join('',<DATA>);
	if(defined($argdefaults))
	{
		$defaults .= $argdefaults;
	}

	$self->setopts($self->parseconfig($defaults));

	unless($apprconly)
	{
		# load mp3archiverc files
		if(-r $MP3ARCHIVESYSRC)
		{
			$self->setopts($self->parseconfig($self->readconfigfile($MP3ARCHIVESYSRC)));
		}
		if(exists($ENV{$MP3ARCHIVEENV}) && -r $ENV{$MP3ARCHIVEENV})
		{
			$self->setopts($self->parseconfig($self->readconfigfile($ENV{$MP3ARCHIVEENV})));
		}
		elsif(-r $MP3ARCHIVERC)
		{
			$self->setopts($self->parseconfig($self->readconfigfile($MP3ARCHIVERC)));
		}
	}

	# load app-specific rcs
	if(defined($sysrc) && -r $sysrc)
	{
		$self->setopts($self->parseconfig($self->readconfigfile($sysrc)));
	}
	if(defined($rcenv) && exists($ENV{$rcenv}) && -r $ENV{$rcenv})
	{
		$self->setopts($self->parseconfig($self->readconfigfile($ENV{$rcenv})));
	}
	elsif(defined($rcfile) && -r $rcfile)
	{
		$self->setopts($self->parseconfig($self->readconfigfile($rcfile)));
	}

	my $writefile=$rcfile;
	if(defined($rcenv) && exists($ENV{$rcenv}))
	{
		$writefile=$ENV{$rcenv};
	}
	unless(defined($writefile))
	{
		$writefile=$MP3ARCHIVERC;
	}
	unless(-e $writefile)
	{
		$self->writeconfigfile($writefile,$defaults);
	}

	return $self;
}


=head2 setopts($optshashref)

Sets options. Takes a hashref of options to set. Preserves any options
not mentioned.

=cut

sub setopts
{
	my($self,$opts)=@_;
	return unless defined($opts);
	while(my($key,$val)=each(%{$opts}))
	{
		$self->{userconfig}->{$key}=$val;
	}
}

=head2 get($item)

Returns the value of the configuration variable $item, or undef if it
is not defined.

=cut

sub get
{
	my $self=shift;
	my $item=shift;
	if(defined($self->{userconfig}->{$item}))
	{
		return $self->{userconfig}->{$item};
	}
		
	return undef;
}

=head2 readconfigfile($file)

Reads in $file and returns it as one long string. Returns undef on
failure.

Can be called as a static method
(eg C<$conf=MP3::Archive::Config::readconfigfile($file)>).

=cut

sub readconfigfile
{
	my $rc=shift;
	if(ref $rc)
	{
		# method call
		$rc=shift;
	}
	unless(open(CFG,$rc))
	{
		return undef;
	}
	
	my $text=join('',<CFG>);
	close(CFG);
	return $text;
}

=head2 parseconfig($code)

Parses the perl code in $code and returns a reference to a hash
containing the variables defined therein.

If there is a problem with the perl in $code, it sets 
$self->{parseerror} to the error message, and returns undef.

parseconfig works by eval-ing the perl code within the context of a
package with an empty symbol table, then reading the contents of that
symbol table.

=cut	

sub parseconfig
{
	my $self;
	my $code=shift;
	if(ref($code))
	{
		# method call
		$self=$code;
		$code=shift;
	}
	if(defined($self))
	{
		$self->{parseerror}="";
	}
	# expendable symbol table for the user to write into
	eval("package MP3::Archive::Config::__TMPSYMTAB__;\n".
		 "no warnings;no strict;\n".
		 $code);

	if($@ && ($@ ne ""))
	{
		if(defined($self))
		{
			$self->{parseerror}=$@;
			chomp($self->{parseerror});
		}
		return undef;
	}

	my %hash=();

	foreach my $key (keys(%MP3::Archive::Config::__TMPSYMTAB__::))
	{
		use vars qw($val);
		next if $key eq "BEGIN";
		local *val=$MP3::Archive::Config::__TMPSYMTAB__::{$key};
	    $hash{$key}=$val;
		delete($MP3::Archive::Config::__TMPSYMTAB__::{$key});
	}
    return(\%hash);
}

=head2 writeconfigfile($file,$config)

Writes the config data $config to $file.	

$config is expected to be a string of perl code.

Can be called as a static method
(eg C<MP3::Archive::Config::writeconfigfile($file,$config)>).

=cut

sub writeconfigfile
{
	my $file=shift;
	if(ref($file))
	{
		# method call
		$file=shift;
	}
	my $config=shift;
	$config=~s/^\#.*\n1\;\s*\n//gm;
	$config .= "# The last line of the config file should be \"1;\"\n1;\n";

	if(-e $file)
	{
		print("$0:cannot write config, file exists\n");
		return 1;
	}
	unless(open(F,">$file"))
	{
		print("$0:cannot open $file for writing: $!\n");
		return 1;
	}
	print F $config,"\n";
	close F;
}


=head1 ENVIRONMENT

=over 4

=item  B<$MP3ARCHIVERC>

If set, uses this instead of $HOME/.mp3archiverc

=item  B<$HOME>

Used to find .mp3archiverc

=back

=head1 BUGS

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

I am especially interested in how well the code for filename formats
works for other people's filenames.

=head1 SEE ALSO    

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

=head1 AUTHOR

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

=cut


1;


# Config defaults follow
__DATA__
# This file is a fragment of perl
# For information on configuring:
# mp3archiverc  see  MP3::Archive::Config(3)
# mp3lintrc     see  mp3lintrc(5)

$formats_album=['TRKNUM - ARTIST - ALBUM - TRACK\.EXT',
			   'ARTIST - ALBUM - TRKNUM - TRACK\.EXT'];
$formats_track=['ARTIST - TRACK\.EXT'];
$formats_album_dir  = ['ARTIST - ALBUM$','ARTIST\/ALBUM$'];
$formats_track_dir  = ['ARTIST$'];
$formats_album_m3u  = ['ARTIST - ALBUM\.EXT'];
$formats_track_m3u  = ['ARTIST\.EXT'];

$format_default="skip";

$format_delimiter_album=' - ';
$format_delimiter_track=' - ';

$paths_track=['track'];
$paths_album=['album'];

$archive_root="$ENV{HOME}/music";
$path_write_album="$archive_root/cut/albums/";
$path_write_track="$archive_root/tracks/";

$format_write_album='TRKNUM - ARTIST - ALBUM - TRACK.EXT';
$format_write_track='ARTIST - TRACK.EXT';
$format_write_album_m3u='ARTIST - ALBUM.EXT';
$format_write_track_m3u='ARTIST.EXT';
$format_write_album_dir="/ARTIST/ALBUM/";
$format_write_track_dir="/ARTIST/";

# The last line of the config file should be "1;"
1;
