# -*-perl-*-
# Creation date: 2003-10-30 23:03:11
# Authors: Don
# Change log:
# $Id: Config.pm,v 1.7 2004/02/01 09:44:52 don Exp $

=pod

=head1 NAME

 Class::Config - Methods From Config Files

=head1 SYNOPSIS

 use Class::Config;
 my $conf = Class::Config->new;
 my $obj = $conf->load(\@files, $inherit_from, $filters);

=head1 DESCRIPTION

 This module generates unique namespaces for new classes that
 contain methods created from the key/value pairs from hashes in
 configuration files.  This is useful for reusing code, such as
 modules and scripts for an entire website, but changing certain
 parameters based on an environment variable, for instance.

 Method names are generated by capitalizing the first letter and
 the first letter after each underscore, then adding 'get' in
 front. For example, if one of the files in @files contains the
 following:

     $info = { field1 => 'value1',
               field2 => [ 'element1', 'element2' ],
               longer_field_name => 'longer value',
             };

 the methods getField1(), getField2(), and getLongerFieldName()
 will be available via the object returned by Class::Config.

 The files are loaded and the methods are set up in an
 inheritance hierarchy in the same order they are passed to the
 load() method - the entries in the 2nd file are placed into a
 class that inherits from the class generated by the entries in
 the first file, the entries in the third file inherit from those
 in the 2nd file, and so on.

 The $inherit_from parameter passed to the load() method
 indicates what class, if any, the class generated by the 1st
 file should inhert from.

 The $filters parameter is an optional set of filters to be run
 on each value before being returned.  See the documentation on
 the load() method below for details.

 The configuration files should not contain a package name.  The
 contents of each file is eval'd in the scope of a unique
 package.  The package global $info must be set to the hash
 reference that you wish to be used for setting up the methods.
 Since the configuration files are eval'd, you may write your own
 subroutines in the configuration files to make them available as
 methods in the package generated.  However, they will be
 overridden by and methods generated with the same name from the
 entries in the $info hash.

 This module has been tested on unix only.  It currently depends
 on device and inode numbers to generate unique namespaces, so it
 may not work on non-unix platforms.

=head1 METHODS

=cut

use strict;

{   package Class::Config;

    use vars qw($VERSION);

    BEGIN {
        $VERSION = '0.01'; # also change below in POD!
    }
    
    use Class::Config::File;

=pod

=head2 new()

 Creates a Class::Config object.

=cut
    sub new {
        my ($proto) = @_;
        my $self = bless {}, ref($proto) || $proto;
        return $self;
    }

    sub _getSubNameSpace {
        my ($self, $file) = @_;
        my @stat_info = CORE::stat($file);
        my ($dev, $ino) = @stat_info[0,1];
        return join('_', map { sprintf("%x", $_) } ($dev, $ino));
    }

    sub loadFile {
        my ($self, $file) = @_;
        my $name = $self->_getSubNameSpace($file);
        my $name_space = "Class::Config::Confs::$name";
        my $obj = Class::Config::File->new($file, { name_space => $name_space, path => $file });
        $obj->load;
        return $obj;
    }

=pod

=head2 load($file, $inherit_from, $filters)

 Loads the file given by $file and generates a unique package for
 the file, converting entries in the hash reference $info into
 methods.  If $file is a reference to an array, each file name in
 the array will be loaded in sequence, each on inheriting from
 the file processed before it.  The $inherit_from parameter, if
 specified, will be used to set up the inheritance for the first
 file specified.

 The $filters parameter is an optional array of filters to be run
 on each value before being returned.  Each element of the array
 can be specified in one of three ways.  For example,

     my $filters = [ [ $obj, $method_name, @args ],
                     [ \&sub_ref, @args],
                     [ \&sub_ref ]
                   ];

 The first filter will result in the method $method_name being
 called on the object $obj and passed the value from the
 configuration file, and then the arguments in @args, i.e.,

     my $cur_val = $obj->$method_name($val, @args);

 The second filter will result in the subroutine sub_ref() being
 called with the value as its first argument, and @args as the
 rest of the arguments, i.e.,

     my $cur_val = $sub_ref->($val, @args);

 The third filter will result in the subroutine sub_ref() being
 called with just the value as its argument, i.e.,

     my $cur_val = $sub_ref->();

=cut
    sub load {
        my ($self, $file, $inherit_from, $filters) = @_;
        my $file_list;
        if (ref($file) eq 'ARRAY') {
            $file_list = $file;
        } else {
            $file_list = [ $file ];
        }

        return $self->_loadMultiple($file_list, $inherit_from, $filters);
    }

    sub _loadMultiple {
        my ($self, $file_list, $inherit_from, $filters) = @_;
        my $obj_list = [];
        foreach my $file (@$file_list) {
            my $obj = $self->loadFile($file);
            push @$obj_list, $obj;
        }

        return $self->setupMethodsAndInheritance($obj_list, $inherit_from, $filters);
    }

    sub setupMethodsAndInheritance {
        my ($self, $file_obj_list, $inherit_from, $filters) = @_;

        my $first = 1;
        my $cur_name = '';
        foreach my $file_obj (@$file_obj_list) {
            my $params = $file_obj->getParams;
            my $file = $$params{path};
            my $name = $self->_getSubNameSpace($file);

            if ($first) {
                $name = "Class::Config::Confs::$name";
            } else {
                $name = $cur_name . '_' . $name;
            }

            my $file_path = $file_obj->getFilePath;
            my $obj = Class::Config::File->new($file_path, { name_space => $name, path => $file });
            $obj->load;

            $obj->exportMethodsToPackage($name, $filters);
            if ($first) {
                if ($inherit_from) {
                    my $pkg = ref($inherit_from) || $inherit_from;
                    eval qq{\@${name}::ISA = '$pkg'};
                }
            } else {
                eval qq{\@${name}::ISA = '$cur_name'};
            }

            $cur_name = $name;

            $first = undef;
        }

        return bless {}, $cur_name;
    }

    sub setupInheritance {
        my ($self, $parent_obj_or_pkg, $child_obj_or_pkg) = @_;
        my $child_pkg = ref($child_obj_or_pkg) ? ref($child_obj_or_pkg) : $child_obj_or_pkg;
        my $parent_pkg = ref($parent_obj_or_pkg) ? ref($parent_obj_or_pkg) : $parent_obj_or_pkg;
        no strict 'refs';
        
        my $isa = \@{"${child_pkg}::ISA"};
        unless (scalar(@$isa) and $$isa[$#{$isa}] eq $parent_pkg) {
            push @$isa, $parent_pkg;
        }
        return 1;
    }

    sub interpolate {
        my ($self, $value) = @_;

        if (ref($value) eq '') {
            $value =~ s/\[\[(\S+)\]\]/$self->$1()/eg;
        }
        
        return $value;
    }
    
}

1;

__END__

=pod

=head1 AUTHOR

 Don Owens <don@owensnet.com>

=head1 COPYRIGHT

 Copyright (c) 2003 Don Owens

 All rights reserved. This program is free software; you can
 redistribute it and/or modify it under the same terms as Perl
 itself.

=head1 VERSION

 0.01

=cut
