#!/usr/bin/perl -Tw
################################################################################
package WWW::Yahoo::Credentials::File;
# $Id: File.pm,v 1.1 2003/09/24 18:20:10 ken Exp $

=pod

=head1 NAME

WWW::Yahoo::Credentials::File - object specifying location of credentials file

=head1 SYNOPSIS

  require WWW::Yahoo::Credentials::File;
  my $file = new WWW::Yahoo::Credentials::File; # use default location
  my $file = WWW::Yahoo::Credentials::File->new( $newfile );

=head1 DESCRIPTION

This class provides different ways of specifying the location of a
credentials file, with acceptable defaults.

Errors are thrown using the Exception::Class module for problems
determining the home directory or for invalid or incorrect usage of
method parameters.

=head1 METHODS

=cut

################################################################################
use 5.006;
use strict;
use warnings;
require WWW::Yahoo::Credentials::Exceptions;
use overload '""' => sub { $_[0]->file },
  'cmp' => sub { "$_[0]" cmp "$_[1]" };

our $VERSION = '0.80';
our $AUTOLOAD;
my $autoload = { map { $_ => 1 }
		  qw( file filename dir subdir home name uid ) };
eval "sub $_" for keys %$autoload; # "forward declare" auto-loaded subs

################################################################################

=pod

=head1 new

This creates a new object representing the location of the credentials
file.  The default location of this file is
"~/.yahoo/credentials.xml", but the location can be specified using
the various options described below.

=over 4

=item file

This specifies the full path to the credentials file.  If set, no
other option is considered.  For example,

  my $file =
    WWW::Yahoo::Credentials::File->new( file =>
					'/home/user/.yahoo/credentials.xml' );

It is not necessary to name this option when it is the only option used:

  my $file =
    WWW::Yahoo::Credentials::File->new( '/home/user/.yahoo/credentials.xml' );

=item filename

This specifies the filename.  The default is 'credentials.xml'.  The
directory location of this file can be specified with the following
options.

=item dir

This specifies the full path to the directory containing the
credentials file.  If set, none of the remaining options are
considered.  For example,

  my $file =
    WWW::Yahoo::Credentials::File->new( dir => '/home/user/.yahoo',
					filename => 'credentials.xml' );

=item subdir

This specifies the subdirectory under the home directory that will be
used.  The default is '.yahoo'.  The home directory can be specified
with the following options.

=item home

This specifies the home directory to use.  For example,

  my $file =
    WWW::Yahoo::Credentials::File->new( home => '/home/user',
					subdir => '.yahoo',
					filename => 'credentials.xml' );

=item name

This specifies the uid to use when looking up the home directory via
the perl function getpwnam.  For example,

  my $file =
    WWW::Yahoo::Credentials::File->new( name => 'user',
					subdir => '.yahoo',
					filename => 'credentials.xml' );
  my $file =
    WWW::Yahoo::Credentials::File->new( name => 'user',
					subdir => '.yahoo',
					filename => 'credentials.xml' );

=item uid

This specifies the uid to use when looking up the home directory via
the perl function getpwuid.  For example,

  my $file =
    WWW::Yahoo::Credentials::File->new( uid => 1000,
					subdir => '.yahoo',
					filename => 'credentials.xml' );
  my $file =
    WWW::Yahoo::Credentials::File->new( uid => $<,
					subdir => '.yahoo',
					filename => 'credentials.xml' );

=back

If the directory of the file is not specified using the above options,
then the default home directory will be used.  The environment
variables HOME and LOGDIR are checked in turn for the home directory.
If neither of these are defined, then getpwuid($<) is used to look up
the home directory.  If you would like to skip over the checking of
HOME and LOGDIR and move straight to getpwuid($<) for the home
directory, then specify $< as the uid, for example,

  my $file = WWW::Yahoo::Credentials::File->new( uid => $< );

The tilde character can be used in the conventional manner to specify
a home directory, for example,

  my $file =
    WWW::Yahoo::Credentials::File->new( file => '~/.yahoo/credentials.xml' );
  my $file =
    WWW::Yahoo::Credentials::File->new( '~user/.yahoo/credentials.xml' );
  my $file =
    WWW::Yahoo::Credentials::File->new( dir => '~/.yahoo',
					filename => 'credentials.xml' );
  my $file =
    WWW::Yahoo::Credentials::File->new( home => '~user',
					subdir => '.yahoo',
					filename => 'credentials.xml' );
  my $file =
    WWW::Yahoo::Credentials::File->new( dir => '~/.yahoo',
					filename => 'credentials.xml' );
  my $file =
    WWW::Yahoo::Credentials::File->new( home => '~user',
					subdir => '.yahoo',
					filename => 'credentials.xml' );

The value for each option can be later retrieved via an accessor
method, for example:

  my $dir = $file->dir;
  my $filename = $file->filename;

To get the full filename including path, simply use the object in a
string context or use the "file" accessor method:

  my $path = "$file";
  my $path = $file->file;

If a tilde character was specified for an option, then all the options
are rewritten to make use of the "name" option to hold the username
(if one was supplied).  In this case, the accessor methods will return
the rewritten values instead of the originally supplied values.

Here is a summary, in order of priority, of how the location of the
credentials file is determined from the given options and/or the
defaults:

  1. file
  2. dir / filename
  3. home(name) / subdir / filename
  4. home(uid)  / subdir / filename
  5. home       / subdir / filename

=cut

#-------------------------------------------------------------------------------
sub new {
    my $class = shift;

    my $self = bless {}, $class;
    if ( @_ == 1 ) {
	$self->{file} = shift;
    }
    else {
	%$self = @_;
	foreach my $name ( keys %$self ) {
	    next if $autoload->{$name};
	    my $error = "invalid '$name' field in class $class";
	    WWW::Yahoo::Credentials::Exception::Usage->throw( $error );
	}
    }

    # Parse options.
    if ( defined $self->{file} ) {
	if ( $self->{file} =~ s!^~([^/]*)/?!! ) {
	    $self->{file} = $self->_home( $1 ) . "/$self->{file}";
	}
    }
    else {
	$self->{filename} = 'credentials.xml' unless defined $self->{filename};
	my( $dir, $home );
	if ( defined $self->{dir} ) {
	    if ( $self->{dir} =~ s!^~([^/]*)/?!! ) {
		$self->{dir} = $self->_home( $1 ) . "/$self->{dir}";
	    }
	    $dir = $self->{dir};
	}
	else {
	    $self->{subdir} = '.yahoo' unless defined $self->{subdir};
	    if ( defined $self->{home} ) {
		if ( $self->{home} =~ s!^~([^/]*)/?!! ) {
		    $self->{home} = $self->_home( $1 ) . "/$self->{home}";
		}
		$home = $self->{home};
	    }
	    elsif ( defined $self->{uid} ) {
		$home = $self->_home( undef, $self->{uid} );
	    }
	    else {
		$home = $self->_home( $self->{name} );
	    }
	    $home .= '/' unless substr( $home, -1 ) eq '/';
	    $dir = "$home$self->{subdir}";
	}
	$dir .= '/' unless substr( $dir, -1 ) eq '/';
	$self->{file} = "$dir$self->{filename}";
    }

    $self;
}

#-------------------------------------------------------------------------------
sub _home {
    my $self = shift;
    my( $user, $uid ) = @_;

    my $home;
    if ( defined $uid and $uid ne '' ) {
	$home = (getpwuid($uid))[7];
	unless ( defined $home ) {
	    my $error = "could not determine home directory for uid '$uid'";
	    WWW::Yahoo::Credentials::Exception::Directory->throw( $error );
	}
    }
    elsif ( defined $user and $user ne '' ) {
	$home = (getpwnam($user))[7];
	unless ( defined $home ) {
	    my $error = "could not determine home directory for user '$user'";
	    WWW::Yahoo::Credentials::Exception::Directory->throw( $error );
	}
    }
    elsif ( defined $ENV{HOME} and $ENV{HOME} ne '' ) {
	$home = $ENV{HOME};
    }
    elsif ( defined $ENV{LOGDIR} and $ENV{LOGDIR} ne '' ) {
	$home = $ENV{LOGDIR};
    }
    else {
	$home = (getpwuid($<))[7];
    }
    unless ( defined $home ) {
	my $error = "could not determine home directory";
	WWW::Yahoo::Credentials::Exception::Directory->throw( $error );
    }
    unless ( -e $home ) {
	my $error = "home directory does not exist: $home";
	WWW::Yahoo::Credentials::Exception::Directory->throw( $error );
    }
    unless ( -d $home ) {
	my $error = "home is not a directory: $home";
	WWW::Yahoo::Credentials::Exception::Directory->throw( $error );
    }
    unless ( -r $home ) {
	my $error = "home directory cannot be read: $home";
	WWW::Yahoo::Credentials::Exception::Directory->throw( $error );
    }
    $home;
}

#-------------------------------------------------------------------------------
sub AUTOLOAD {
    my $self = shift;
    my $class = ref( $self );
    unless ( $class ) {
	my $error = "$self is not an object";
	WWW::Yahoo::Credentials::Exception::Usage->throw( $error );
    }
    my $name = $AUTOLOAD;
    { $name =~ s!.*:!! };
    unless ( $autoload->{$name} ) {
	my $error = "can't access '$name' field in class $class";
	WWW::Yahoo::Credentials::Exception::Usage->throw( $error );
    }
    if ( @_ ) {
	my $error = "can't change read-only '$name' field in class $class";
	WWW::Yahoo::Credentials::Exception::Usage->throw( $error );
    }
    $self->{$name};
}
sub DESTROY {};

################################################################################

=pod

=head1 file

  my $fullname = $file->file;
  my $fullname = "$file";

=head1 filename

  my $filename = $file->filename;

=head1 dir

  my $dir = $file->dir;

=head1 subdir

  my $dir = $file->subdir;

=head1 home

  my $home = $file->home;

=head1 name

  my $name = $file->name;

=head1 uid

  my $uid = $file->uid;

=cut

#-------------------------------------------------------------------------------

################################################################################

=pod

=head1 SEE ALSO

L<WWW::Yahoo::Credentials::File|WWW::Yahoo::Credentials::File>,
L<Exception::Class|Exception::Class>

=head1 AUTHOR

Ken Neighbors, Ph.D.
ken@nsds.com

=head1 COPYRIGHT AND LICENSE

Copyright 2003 by Ken Neighbors

This module is free software; you can redistribute it and/or modify it
under the same terms as Perl itself, either Perl version 5.000 or (at
your option) any later version of Perl.  That is, you can redistribute
this module and/or modify it under the terms of either:

  a) the GNU General Public License as published by the Free Software
     Foundation; either version 1, or (at your option) any later version,
     or

  b) the "Artistic License" which comes with Perl, or

  c) the license terms of Perl versions later than 5.000

=cut

1;
