package TKL::Settings;

## $Id: Settings.pm,v 1.1 2003/10/08 11:47:48 sondberg Exp $

use XML::LibXML;
use Exporter;
use strict;
use Getopt::Long;
use Carp;

## Define module's interface to the world

my @tkl_config = qw(tkl_read_config tkl_set_config);

our @ISA = qw(Exporter);
our @EXPORT_OK = @tkl_config;
our %EXPORT_TAGS = (
			tkl_config => [@tkl_config]
		   );

## Internal stuff

my %settings = ();
my $file_cache = {};
my $args_cache;
my $libxml = new XML::LibXML;


sub tkl_set_config {
    my ($args) = {
			debug		=> 0,
			doc_elem	=> 'config',
			setting		=> 'setting',
			path		=> [\&cmdline, \&local, \&portal, \&env],
			root		=> '{root}',
			assign		=> [], 
			@_
    		 };

    %settings = %$args;

    if ($settings{'root'} =~ /^\{(.+?)\}$/) {
	my $root_arg = $1;
	read_args();
	$settings{'root'} = $args_cache->{$root_arg} or usage();
    }
}


sub tkl_read_config {
    my ($name, @args) = @_;
    my $path = $settings{'path'};

    foreach my $code_ref (@$path) {
	my $setting = &$code_ref($name, @args);
	if (defined($setting)) {
	    return $setting;
	}
    }

    return undef;
}


sub local {
    my ($name) = @_;
    my $file = $settings{'local'};

    if ($settings{debug}) {
	print STDERR "local: Reading setting '$name'\n";
    }

    return unless defined $file;

    $file = $settings{'root'} . "/$file";
    
    return unless defined $file;

    if (-f $file) {
	return parse_xml_config($file, $name);
    } else {
	return undef;
    }
}


sub read_args {
    GetOptions ($args_cache = {}, @{$settings{'assign'}}) or usage();
}
    

sub cmdline {
    my ($name) = @_;
    
    if ($settings{debug}) {
	print STDERR "cmdline: Reading setting '$name'\n";
    }

    read_args() unless defined($args_cache);

    return $args_cache->{$name};
}


sub env {
    my ($name) = @_;
    
    if ($settings{debug}) {
	print STDERR "env: Reading setting '$name'\n";
    }

    return $ENV{$name};
}


sub portal {
    my ($name) = @_;
    my $file = $settings{'root'} . "/tkl.config";

    if ($settings{debug}) {
	print STDERR "portal: Reading setting '$name'\n";
    }
    
    return unless -f $file;
    
    return parse_xml_config ($file, $name);
}


sub usage {
    if (defined(my $usage = $settings{usage})) {
	&$usage;
    } else {
	print STDERR "Usage: $0 ???\n\n";
	exit(1);
    }
}


sub parse_xml_config {
    my ($file, $name) = @_;
    my $doc;

    if (defined($file_cache->{$file})) {
	if ($settings{'debug'}) {
	    print STDERR "parse_xml_config: Using cached version of file '$file'\n";
	}
	$doc = $file_cache->{$file};
    } else {
	if ($settings{'debug'}) {
	    print STDERR "parse_xml_config: Parsing file '$file' from scratch\n";
	}
	$doc = $libxml->parse_file($file);
	$file_cache->{$file} = $doc;
    }

    if ($doc) {
	my $root = $doc->documentElement;
	my $nodename = $settings{'setting'};
	if ($root->nodeName eq $settings{'doc_elem'}) {
	    
	    my $xpath = $nodename . "[\@name='$name']";
	    print STDERR "Extracting nodes with XPATH=$xpath\n" if $settings{debug};
	    
	    my ($node) = $root->findnodes($xpath);
	    
	    if ($node) {
		if (defined(my $value = $node->getAttribute('value'))) {
		    return $value;
		} else {
		    my $xml = $node->toString();
		    if ($xml =~ /<$nodename.*?>(.*)<\/$nodename>/s) {
			return $1;
		    } else {
			return 1;
		    }
		}
	    } else {
		print STDERR "Didn't find name '$name'\n" if $settings{debug};
		return undef;
	    }
	}
    } else {
	croak "$0: Unable to parse config file '$file'";
    }
}
	

1;

__END__

=head1 NAME

TKL::Settings - Tools to handle configuration of TKL components.

=head1 SYNOPSIS

  use TKL::Settings qw(:tkl_config);

  tkl_set_config(
  			assign	=> ['root:s', 'path:s', 'debug'],
			root	=> '/tkl/portal/root',
			usage	=> \&my_usage
		);

  my $root = tkl_read_config('root');
  my $path = tkl_read_config('path');

=head1 DESCRIPTION

This is a package which handles configuration of various TKL components. The
idea is that one wants to keep configuration in different layers: Configuration
close to the script should over-rule more general settings. This package handles
4 levels of configuration information, here listed in prioritized order:

 - Command-line arguments
 - Local configuration file
 - Global configuration file
 - Environment settings

If one wants a different order of priority or needs to store configuration
information differently, this is possible as well.

=head2 Exported subroutines

=head3 tkl_set_config

This subroutine should be called to register configuration parameters, origins,
document root (if relevant) and other settings. It should be called this way:

  tkl_set_config (
  			assign		=> ['param1', 'param2', ... ],
			debug		=> 0,
			doc_elem	=> 'config',
			local		=> 'local_config_file',
			path		=> [\&cmdline, \&local, \&portal, \&env],
			root		=> '/tkl/portal/root',
			setting		=> 'setting'
		 );

where 'assign' is a referenced list of variable arguments, use the same conventions
as in the Perl module Getopt::Long. For instance, arg1=s means a mandatory string
which can be reached as 'arg1', while arg2:s means an optional string which you
can access as 'arg2'. The parameter 'debug' as just a boolean, which defaults to 0,
i.e. debug messages. 'doc_elem' and 'setting' should in principle not be modified,
since they refer the the document element name and element name of the relevant
nodes to look for in the XML config files. The 'path' argument is a list of
handlers capable of extracting configuration settings from various origins.
This list should only be modified if you wish to change the order of precedence
of various configuration information. Leaving this alone, will look for a setting
as described above. The 'root' member can either be a path to the TKL portal root,
or have the following format {arg}, where arg is the command line setting from
which the root path is taken. The default setting for this parameter is {root},
i.e. the TKL portal root is expected to be passed to the script as -r xxx or
--root=xxx.
Passing the argument 'local' sets a local config file for script specific settings.


=head3 tkl_read_config

This subroutine fetches a configuration setting from the first place available in
the search path. Call this routine this way:

  my $value = tkl_read_config('name_of_setting');

=head1 AUTHOR

Anders Sønderberg Mortensen <sondberg@indexdata.dk>
Indexdata, Copenhagen, Denmark.
2003/09/30

=head1 SEE-ALSO

Man-pages of Getopt::Long and perl(1).

=cut