# @(#)$Id: Config.pm 248 2013-02-13 23:17:39Z pjf $

package Class::Usul::Config;

use version; our $VERSION = qv( sprintf '0.12.%d', q$Rev: 248 $ =~ /\d+/gmx );

use Class::Usul::File;
use Class::Usul::Moose;
use Class::Usul::Constants;
use Class::Usul::Functions       qw(app_prefix class2appdir home2appldir
                                    is_arrayref split_on__ split_on_dash
                                    untaint_path);
use Config;
use English                      qw(-no_match_vars);
use File::Basename               qw(basename dirname);
use File::DataClass::Constraints qw(Directory File Path);
use File::Gettext::Constants;
use File::Spec::Functions        qw(canonpath catdir catfile rel2abs rootdir
                                    tmpdir);

has 'appclass'        => is => 'ro',   isa => NonEmptySimpleStr,
   required           => TRUE;

has 'encoding'        => is => 'ro',   isa => EncodingType, coerce => TRUE,
   default            => DEFAULT_ENCODING;

has 'home'            => is => 'ro',   isa => Directory, coerce => TRUE,
   documentation      => 'Directory containing the config file',
   required           => TRUE;

has 'l10n_attributes' => is => 'ro',   isa => HashRef, default => sub { {} };

has 'lock_attributes' => is => 'ro',   isa => HashRef, default => sub { {} };

has 'log_attributes'  => is => 'ro',   isa => HashRef, default => sub { {} };

has 'no_thrash'       => is => 'ro',   isa => PositiveInt, default => 3;


has 'appldir'         => is => 'lazy', isa => Directory, coerce => TRUE;

has 'binsdir'         => is => 'lazy', isa => Path,      coerce => TRUE;

has 'ctlfile'         => is => 'lazy', isa => Path,      coerce => TRUE;

has 'ctrldir'         => is => 'lazy', isa => Path,      coerce => TRUE;

has 'dbasedir'        => is => 'lazy', isa => Path,      coerce => TRUE;

has 'localedir'       => is => 'lazy', isa => Directory, coerce => TRUE;

has 'logfile'         => is => 'lazy', isa => Path,      coerce => TRUE;

has 'logsdir'         => is => 'lazy', isa => Directory, coerce => TRUE;

has 'pathname'        => is => 'lazy', isa => File,      coerce => TRUE;

has 'root'            => is => 'lazy', isa => Path,      coerce => TRUE;

has 'rundir'          => is => 'lazy', isa => Path,      coerce => TRUE;

has 'sessdir'         => is => 'lazy', isa => Path,      coerce => TRUE;

has 'shell'           => is => 'lazy', isa => File,      coerce => TRUE;

has 'suid'            => is => 'lazy', isa => Path,      coerce => TRUE;

has 'tempdir'         => is => 'lazy', isa => Directory, coerce => TRUE;

has 'vardir'          => is => 'lazy', isa => Path,      coerce => TRUE;


has 'extension'       => is => 'lazy', isa => NonEmptySimpleStr;

has 'name'            => is => 'lazy', isa => NonEmptySimpleStr;

has 'phase'           => is => 'lazy', isa => PositiveInt;

has 'prefix'          => is => 'lazy', isa => NonEmptySimpleStr;

has 'salt'            => is => 'lazy', isa => NonEmptySimpleStr;

around 'BUILDARGS' => sub {
   my ($next, $class, @args) = @_; my $attr = $class->$next( @args ); my $paths;

   if ($paths = delete $attr->{cfgfiles} and $paths->[ 0 ]) {
      my $loaded = Class::Usul::File->data_load( paths => $paths );

      $attr = { %{ $loaded || {} }, %{ $attr } };
   }

   for my $attr_name (keys %{ $attr }) {
      defined $attr->{ $attr_name }
          and $attr->{ $attr_name } =~ m{ \A __([^\(]+?)__ \z }mx
          and $attr->{ $attr_name } = $class->_inflate_symbol( $attr, $1 );
   }

   for my $attr_name (keys %{ $attr }) {
      defined $attr->{ $attr_name }
          and $attr->{ $attr_name } =~ m{ \A __(.+?)\((.+?)\)__ \z }mx
          and $attr->{ $attr_name } = $class->_inflate_path( $attr, $1, $2 );
   }

   return $attr;
};

sub canonicalise {
   my ($self, $base, $relpath) = @_;

   my @base = ((is_arrayref $base) ? @{ $base } : $base);
   my @rest = split m{ / }mx, $relpath;
   my $path = canonpath( untaint_path catdir( @base, @rest ) );

   -d $path and return $path;

   return canonpath( untaint_path catfile( @base, @rest ) );
}

# Private methods

sub _build_appldir {
   my ($self, $appclass, $home) = __unpack( @_ ); my $dir = home2appldir $home;

   ($dir and -d catdir( $dir, q(bin) ))
      or $dir = catdir( NUL, q(var), (class2appdir $appclass) );

   -d $dir or $dir = $home;

   return rel2abs( untaint_path ($dir || rootdir) );
}

sub _build_binsdir {
   my $dir = $_[ 0 ]->_inflate_path( $_[ 1 ], qw(appldir bin) );

   return -d $dir ? $dir : untaint_path $Config{installsitescript};
}

sub _build_ctlfile {
   my $name      = $_[ 0 ]->_inflate_symbol( $_[ 1 ], q(name)      );
   my $extension = $_[ 0 ]->_inflate_symbol( $_[ 1 ], q(extension) );

   return $_[ 0 ]->_inflate_path( $_[ 1 ], q(ctrldir), $name.$extension );
}

sub _build_ctrldir {
   my $dir = $_[ 0 ]->_inflate_path( $_[ 1 ], qw(vardir etc) );

   return -d $dir ? $dir : $_[ 0 ]->_inflate_path( $_[ 1 ], qw(appldir etc) );
}

sub _build_dbasedir {
   my $dir =  $_[ 0 ]->_inflate_path( $_[ 1 ], qw(vardir db) );

   return -d $dir ? $dir : $_[ 0 ]->_inflate_path( $_[ 1 ], q(vardir) );
}

sub _build_extension {
   return CONFIG_EXTN;
}

sub _build_localedir {
   my $dir = $_[ 0 ]->_inflate_path( $_[ 1 ], qw(vardir locale) );

   -d $dir and return $dir;

   for (map { catdir( @{ $_ } ) } @{ DIRECTORIES() } ) { -d $_ and return $_ }

   return $_[ 0 ]->_inflate_path( $_[ 1 ], qw(tempdir) );
}

sub _build_logfile {
   my $name = $_[ 0 ]->_inflate_symbol( $_[ 1 ], q(name) );

   return $_[ 0 ]->_inflate_path( $_[ 1 ], q(logsdir), "${name}.log" );
}

sub _build_logsdir {
   my $dir = $_[ 0 ]->_inflate_path( $_[ 1 ], qw(vardir logs) );

   return -d $dir ? $dir : $_[ 0 ]->_inflate_path( $_[ 1 ], qw(tempdir) );
}

sub _build_name {
   my $name = basename( $_[ 0 ]->_inflate_path( $_[ 1 ], q(pathname) ), EXTNS );

   return (split_on__ $name, 1) || (split_on_dash $name, 1) || $name;
}

sub _build_pathname {
   return rel2abs( (q(-) eq substr $PROGRAM_NAME, 0, 1) ? $EXECUTABLE_NAME
                                                        : $PROGRAM_NAME );
}

sub _build_path_to {
   my ($self, $appclass, $home) = __unpack( @_ ); return $home;
}

sub _build_phase {
   my $verdir  = basename( $_[ 0 ]->_inflate_path( $_[ 1 ], q(appldir) ) );
   my ($phase) = $verdir =~ m{ \A v \d+ \. \d+ p (\d+) \z }msx;

   return defined $phase ? $phase : PHASE;
}

sub _build_prefix {
   my $appclass = $_[ 0 ]->_inflate_symbol( $_[ 1 ], q(appclass) );

   return (split m{ :: }mx, lc $appclass)[ -1 ];
}

sub _build_root {
   my $dir = $_[ 0 ]->_inflate_path( $_[ 1 ], qw(vardir root) );

   return -d $dir ? $dir : $_[ 0 ]->_inflate_path( $_[ 1 ], q(vardir) );
}

sub _build_rundir {
   my $dir = $_[ 0 ]->_inflate_path( $_[ 1 ], qw(vardir run) );

   return -d $dir ? $dir : $_[ 0 ]->_inflate_path( $_[ 1 ], q(vardir) );
}

sub _build_salt {
   return $_[ 0 ]->_inflate_symbol( $_[ 1 ], q(prefix) );
}

sub _build_sessdir {
   my $dir = $_[ 0 ]->_inflate_path( $_[ 1 ], qw(vardir hist) );

   return -d $dir ? $dir : $_[ 0 ]->inflate_path( $_[ 1 ], q(vardir) );
}

sub _build_shell {
   my $file = catfile( NUL, qw(bin ksh) ); -f $file and return $file;

   $file = $ENV{SHELL}; -f $file and return $file;

   return catfile( NUL, qw(bin sh) );
}

sub _build_suid {
   my $prefix = $_[ 0 ]->_inflate_symbol( $_[ 1 ], q(prefix) );

   return $_[ 0 ]->_inflate_path( $_[ 1 ], q(binsdir), "${prefix}_admin" );
}

sub _build_tempdir {
   my $dir = $_[ 0 ]->_inflate_path( $_[ 1 ], qw(vardir tmp) );

   return -d $dir ? $dir : untaint_path tmpdir;
}

sub _build_vardir {
   my $dir = $_[ 0 ]->_inflate_path( $_[ 1 ], qw(appldir var) );

   return -d $dir ? $dir : $_[ 0 ]->_inflate_path( $_[ 1 ], q(appldir) );
}

sub _inflate_path {
   my ($self, $attr, $symbol, $relpath) = @_; $attr ||= {};

   my $inflated = $self->_inflate_symbol( $attr, $symbol );

   $relpath or return canonpath( untaint_path $inflated );

   return $self->canonicalise( $inflated, $relpath );
}

sub _inflate_symbol {
   my ($self, $attr, $symbol) = @_; $attr ||= {};

   my $attr_name = lc $symbol; my $method = q(_build_).$attr_name;

   return blessed $self                      ? $self->$attr_name()
        : __is_inflated( $attr, $attr_name ) ? $attr->{ $attr_name }
                                             : $self->$method( $attr );
}

# Private functions

sub __is_inflated {
   my ($attr, $attr_name) = @_;

   return exists $attr->{ $attr_name } && defined $attr->{ $attr_name }
       && $attr->{ $attr_name } !~ m{ \A __ }mx ? TRUE : FALSE;
}

sub __unpack {
   my ($self, $attr) = @_; $attr ||= {};

   blessed $self and return ($self, $self->{appclass}, $self->{home});

   return ($self, $attr->{appclass}, $attr->{home});
}

__PACKAGE__->meta->make_immutable;

1;

__END__

=pod

=head1 Name

Class::Usul::Config - Inflate config values

=head1 Version

Describes Class::Usul::Config version 0.12.$Revision: 248 $

=head1 Synopsis

=head1 Description

Defines the following list of attributes

=over 3

=item C<appclass>

Required string. The classname of the application for which this is the
configuration class

=item C<appldir>

Directory. Defaults to the application's install directory

=item C<binsdir>

Directory. Defaults to the application's I<bin> directory

=item C<ctlfile>

File in the C<ctrldir> directory that contains this programs control data

=item C<ctrldir>

Directory containing the per program configuration files

=item C<dbasedir>

Directory containing the data file used to create the applications database

=item C<encoding>

String default to the constant I<DEFAULT_ENCODING>

=item C<extension>

String defaults to the constant I<CONFIG_EXTN>

=item C<home>

Directory containing the config file. Required

=item C<l10n_attributes>

Hash ref of attributes used to construct a L<Class::Usul::L10N> object

=item C<localedir>

Directory containing the GNU Gettext portable object files used to translate
messages into different languages

=item C<lock_attributes>

Hash ref of attributes used to construct an L<IPC::SRLock> object

=item C<log_attributes>

Hash ref of attributes used to construct a L<Class::Usul::Log> object

=item C<logfile>

File in the C<logsdir> to which this program will log

=item C<logsdir>

Directory containing the application log files

=item C<name>

String. Name of the program

=item C<no_thrash>

Integer default to 3. Number of seconds to sleep in a polling loop to
avoid processor thrash

=item C<pathname>

File defaults to the absolute path to the I<PROGRAM_NAME> system constant

=item C<phase>

Integer. Phase number indicates the type of install, e.g. 1 live, 2 test,
3 development

=item C<prefix>

String. Program prefix

=item C<root>

Directory. Path to the web applications document root

=item C<rundir>

Directory. Contains a running programs PID file

=item C<salt>

String. This applications salt for passwords as set by the administrators . It
is used to perturb the encryption methods. Defaults to the I<prefix>
attribute value

=item C<sessdir>

Directory. The session directory

=item C<shell>

File. The default shell used to create new OS users

=item C<suid>

File. Name of the setuid root program in the I<bin> directory. Defaults to
the I<prefix>_admin

=item C<tempdir>

Directory. It is the location of any temporary files created by the
application. Defaults to the L<File::Spec> tempdir

=item C<vardir>

Directory. Contains all of the non program code directories

=back

=head1 Subroutines/Methods

=head2 BUILDARGS

Loads the configuration files if specified. Calls L</inflate_symbol>
and L</inflate_path>

=head2 canonicalise

   $untainted_canonpath = $self->canonicalise( $base, $relpath );

Appends C<$relpath> to C<$base> using L<File::Spec::Functions>. The C<$base>
argument can be an array ref or a scalar. The C<$relpath> argument must be
separated by slashes. The return path is untainted and canonicalised

=head2 _inflate_path

Inflates the I<__symbol( relative_path )__> values to their actual runtime
values

=head2 _inflate_symbol

Inflates the I<__SYMBOL__> values to their actual runtime values

=head1 Configuration and Environment

None

=head1 Diagnostics

None

=head1 Dependencies

=over 3

=item L<Class::Usul::File>

=item L<Class::Usul::Moose>

=back

=head1 Incompatibilities

There are no known incompatibilities in this module

=head1 Bugs and Limitations

There are no known bugs in this module.
Please report problems to the address below.
Patches are welcome

=head1 Author

Peter Flanigan, C<< <Support at RoxSoft.co.uk> >>

=head1 License and Copyright

Copyright (c) 2013 Peter Flanigan. All rights reserved

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself. See L<perlartistic>

This program is distributed in the hope that it will be useful,
but WITHOUT WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE

=cut

# Local Variables:
# mode: perl
# tab-width: 3
# End: