indexing
	namespace: "candidate"
	cluster: "configuration"
	description: "Integrate command line, config files and help message."
	original_author: "Justin Finnerty"
	original_date: "Aug 2005"
	current_date: "$Date: 2005/09/28 13:36:57 $"
	current_author: "$Author: finnerty $"
	revision: "$Revision: 1.4 $"
	--  $Log: configuration_manager.ge,v $
	--  Revision 1.4  2005/09/28 13:36:57  finnerty
	--  Updated to work with ISE (which HAS_AGENT but no `for_all` features)
	--
	--  Revision 1.3  2005/09/27 06:10:51  finnerty
	--  Updated to use GOBO and work with SE and VE
	--
	--  Revision 1.2  2005/09/03 11:06:11  finnerty
	--  Updated to conform to cursors/containers in the GOBO library and
	--  test programs compile with SE and VE.
	--
	--  Revision 1.1  2005/09/02 07:12:32  finnerty
	--  Renamed configuration_manager.e to configuration_manager.ge for gepp
	--
	--  Revision 2.0  2005/08/26 23:20:16  finnerty
	--  == alpha version ==
	--
	--  Revision 1.4  2005/08/24 11:55:42  finnerty
	--  Modified "help"/"help_short" to use new "tab_label" attribute of options to
	--  preform option grouping.
	--
	--  Revision 1.3  2005/08/21 11:53:35  finnerty
	--  Alpha 1 version
	--
	--  Revision 1.2  2005/08/16 12:10:05  finnerty
	--  Modified design; options are now derived from OBSERVABLE. Added ability
	--  to create single letter options as aliases for other options. Finished (alpha)
	--  coding of all features except read_file and read_environment.
	--
	--  Revision 1.1  2005/08/12 07:05:51  finnerty
	--  *** empty log message ***
	--
class CONFIGURATION_MANAGER
	-- Integrate command line, config files and help
	-- message. Interested objects registering their options with
	-- manager, allowing decentralised option management. The manager
	-- object then processes the configuration information informs the
	-- registered user objects.

	-- Configuration file format is XML with general syntax <configuration
	-- name='appname'><option name='optionname' bool='False'
	-- arg-required='False' allow-override='True'><help
	-- language='en'>...</help><help language='other'>... </help><short
	-- language='en'>...</short> <default>...</default> <value>...</value>
	-- </option>... </config>

	-- Note: Using `set_value' calls the option object's `notify'
	-- method to update any OBSERVERS. This includes setting the value
	-- via the configuration file. To set a boolean option from the
	-- configuration file use a value of "True". Once an option has
	-- `allow_no_override' at `True' it won't call `notify' as
	-- `set_value' can not be called. If `allow_no_override' is in the
	-- configuration file any accompanying value is set before
	-- `allow_no_override' is changed.

inherit
	DS_HASH_TABLE[CONFIGURATION_OPTION,STRING]
		rename
			make as make_table_size,
			make_default as make_table
#ifndef SE
		select
			is_equal,
			copy
#endif
		end
	OBSERVER[CONFIGURATION_OPTION]
		rename
			copy as copy_obs,
			is_equal as is_equal_obs
		end
#ifdef SE
insert
#endif
   KL_SHARED_ARGUMENTS
		rename
			copy as copy_arg,
			is_equal as is_equal_arg
		end
	CONFIGURATION_STATUS
		rename
			copy as copy_conf,
			is_equal as is_equal_conf
		end
	KL_SHARED_STANDARD_FILES
		rename
			copy as copy_file,
			is_equal as is_equal_file
		end
			
creation {ANY}
	make

feature {ANY}
	-- queries
	env_prefix: STRING
			-- [env_prefix + '_' + option.name] is alias for
			-- [option.name] in environment variables.

			-- This should be the application name

	has_observer (a_name: STRING; an_obs: OBSERVER[CONFIGURATION_OPTION]): BOOLEAN is
			-- Remove an observer to the option represented by a_name
		require
			has (a_name)
		do
			Result := item (a_name).has (an_obs)
		end

	help (a_stream: KL_STDOUT_FILE) is
			-- Put formatted help on `a_stream'. Will be language specific
			-- if available.

			-- If an option has `help' or `help_short' as `Void' then no
			-- help will be displayed for that option.
		local
			l_tabs: DS_HASH_TABLE[DS_HASH_SET[CONFIGURATION_OPTION],STRING]
			l_new_set: DS_HASH_SET[CONFIGURATION_OPTION]
		do
			help_short (a_stream)
			a_stream.put_character ('%N')
			a_stream.put_string (help_text)
			a_stream.put_character ('%N')
			a_stream.put_character ('%N')
			-- Put options into l_tabs
			!!l_tabs.make_default
			from
				start
			until
				off
			loop
				if not l_tabs.has (item_for_iteration.tab_label) then
					!!l_new_set.make_default
					l_tabs.force (l_new_set, item_for_iteration.tab_label)
				end
				l_tabs.item (item_for_iteration.tab_label).force (item_for_iteration)
				forth
			end
			start
			from
				l_tabs.start
			until
				l_tabs.off
			loop
				a_stream.put_string (l_tabs.key_for_iteration + " options:")
				a_stream.put_character ('%N')
				a_stream.put_character ('%N')
				l_new_set := l_tabs.item_for_iteration
				from
					l_new_set.start
				until
					l_new_set.off
				loop
					if
						l_new_set.item_for_iteration.help /= Void and then
						l_new_set.item_for_iteration.help_short /= Void
					 then
						a_stream.put_string (" -")
						a_stream.put_string (l_new_set.item_for_iteration.name)
						help_alias (l_new_set.item_for_iteration.name, a_stream)
						if not l_new_set.item_for_iteration.is_boolean then
							if l_new_set.item_for_iteration.default_value = Void then
								a_stream.put_string (" <required arg>")
							else
								a_stream.put_string (" [optional arg*]")
							end
						end
						a_stream.put_character ('%N')
						a_stream.put_string (l_new_set.item_for_iteration.help)
						a_stream.put_character ('%N')
						if not l_new_set.item_for_iteration.is_boolean then
							if l_new_set.item_for_iteration.default_value /= Void then
								a_stream.put_string (" *If no argument is given a default of [")
								a_stream.put_string (l_new_set.item_for_iteration.default_value)
								a_stream.put_string ("] will be used.")
							end
						end
						a_stream.put_character ('%N')
					end
					l_new_set.forth
				end
				l_tabs.forth
			end
		end

	help_alias (a_name: STRING; a_stream: KL_STDOUT_FILE) is
			-- Output any single letter aliases of `a_name'
		do
			from
				m_letter_options.start
			until
				m_letter_options.off
			loop
				if m_letter_options.item_for_iteration.is_equal(a_name) then
					a_stream.put_string ("|-")
					a_stream.put_character(m_letter_options.key_for_iteration)
				end
				m_letter_options.forth
			end
		end

	help_short (a_stream: KL_STDOUT_FILE) is
			-- Put brief help on `a_stream'. Will be language specific if
			-- available.

			-- If an option has `help' or `help_short' as `Void' then no
			-- help will be displayed for that option.
		local
			l_tabs: DS_HASH_TABLE[DS_HASH_SET[CONFIGURATION_OPTION],STRING]
			l_new_set: DS_HASH_SET[CONFIGURATION_OPTION]
		do
			a_stream.put_string ("Usage:")
			a_stream.put_character ('%N')
			a_stream.put_string ("%T")
			a_stream.put_string (Arguments.argument (0))
			-- Put options into l_tabs
			!!l_tabs.make_default
			from
				start
			until
				off
			loop
				if not l_tabs.has (item_for_iteration.tab_label) then
					!!l_new_set.make_default
					l_tabs.force (l_new_set, item_for_iteration.tab_label)
				end
				l_tabs.item (item_for_iteration.tab_label).force (item_for_iteration)
				forth
			end

			from
				l_tabs.start
			until
				l_tabs.off
			loop
				l_new_set := l_tabs.item_for_iteration
				from
					l_new_set.start
				until
					l_new_set.off
				loop
					if l_new_set.item_for_iteration.help /= Void and then
						l_new_set.item_for_iteration.help_short /= Void	 then
						a_stream.put_string (" [-")
						a_stream.put_string (l_new_set.item_for_iteration.name)
						help_alias (l_new_set.item_for_iteration.name, a_stream)
						if not l_new_set.item_for_iteration.is_boolean then
							if l_new_set.item_for_iteration.default_value = Void then
								a_stream.put_string (" <arg>")
							else
								a_stream.put_string (" [arg]")
							end
							a_stream.put_string ("]")
						else
							a_stream.put_string ("]")
						end
					end
					l_new_set.forth
				end
				l_tabs.forth
			end
			a_stream.put_character ('%N')
			a_stream.put_string (help_short_text)
			a_stream.put_character ('%N')
			from
				l_tabs.start
			until
				l_tabs.off
			loop
				
				l_new_set := l_tabs.item_for_iteration
				from
					l_new_set.start
				until
					l_new_set.off
				loop
					if
						l_new_set.item_for_iteration.help /= Void and then
						l_new_set.item_for_iteration.help_short /= Void
					 then
						a_stream.put_string (" -")
						a_stream.put_string (l_new_set.item_for_iteration.name)
						help_alias (l_new_set.item_for_iteration.name, a_stream)
						a_stream.put_string ("%T")
						a_stream.put_string (l_new_set.item_for_iteration.help_short)
						a_stream.put_character ('%N')
					end
					l_new_set.forth
				end
				l_tabs.forth
			end
		end

	help_text: STRING
			-- Application overview help text. This is used by the `help'
			-- procedure.

	help_short_text: STRING
			-- Application overview help text. This is used by the `help_short'
			-- procedure.

	status: INTEGER 
			-- Current processing state. Must be one of the constants 
			-- defined above.

	write (a_stream: KL_STDOUT_FILE) is
			-- Write registered options with current values to
			-- `a_stream'. This can be used to get a default
			-- configuration file.
		do
			a_stream.put_string ("<?xml version='1.0' encoding='utf8'>")
			a_stream.put_character ('%N')
			a_stream.put_string ("<configuration version='1.0'>")
			a_stream.put_character ('%N')
			a_stream.put_string ("<application")
			if env_prefix /= Void and then not env_prefix.is_empty then
				a_stream.put_string (" name='")
				a_stream.put_string (env_prefix.as_lower)
				a_stream.put_string ("'")
			end
			a_stream.put_string (">")
			a_stream.put_character ('%N')
			if help_text /= Void and then not help_text.is_empty then
				-- help tag
				a_stream.put_string ("<help language='en'>")
				a_stream.put_string (help_text)
				a_stream.put_string ("</help>")
				a_stream.put_character ('%N')
			end
			if help_short_text /= Void and then not help_short_text.is_empty then
				-- short(help) tag
				a_stream.put_string ("<short language='en'>")
				a_stream.put_string (help_short_text)
				a_stream.put_string ("</short>")
				a_stream.put_character ('%N')
			end
			from
				start
			until
				off
			loop
				item_for_iteration.write_to (a_stream)
				forth
			end
			a_stream.put_string ("</application>")
			a_stream.put_character ('%N')
			a_stream.put_string ("</configuration>")
		end
	
feature {ANY}
	-- procedures
	add_observer (a_name: STRING; an_obs: OBSERVER[CONFIGURATION_OPTION]) is
			-- Add an observer to the option represented by a_name
		require
			has (a_name)
		do
			item (a_name).add (an_obs)
		end

	add_single_letter_option (a_char: CHARACTER; a_name: STRING) is
			-- make "-a_char" an alias for "-a_name"
		do
			m_letter_options.force (a_name, a_char)
		end

	add_std_help is
			-- Add '-help' to print long help and '-h'/'-?' to print 
			-- short help (and die).
		local
			l_conf_option: CONFIGURATION_OPTION
		do
			!!l_conf_option.make("help"
										, "Print an extended help message to terminal"
										, "Display help")
			l_conf_option.add (Current)
			l_conf_option.set_is_death
			l_conf_option.set_is_boolean
			l_conf_option.set_tab_label ("Help")
			force (l_conf_option, l_conf_option.name)
			!!l_conf_option.make("h"
										, "Print usage message to terminal"
										, "Display usage")
			l_conf_option.add (Current)
			l_conf_option.set_is_death
			l_conf_option.set_is_boolean
			l_conf_option.set_tab_label ("Help")
			force (l_conf_option, l_conf_option.name)
			add_single_letter_option ('?', "h")
		end
	
	add_std_conf is
			-- Add '-conf' option to output configuration (and die).
		local
			l_conf_option: CONFIGURATION_OPTION
		do
			!!l_conf_option.make("conf"
										, "Print current configuration to terminal"
										, "Print configuration")
			l_conf_option.add (Current)
			l_conf_option.set_is_death
			l_conf_option.set_is_boolean
			l_conf_option.set_tab_label ("Configuration")
			force (l_conf_option, l_conf_option.name)
		end
	
	add_filename (a_filename: STRING) is
			-- Builds a set of configuration filenames to be checked
			-- during `process'. These are check in the order entered.
		require
			Filename: a_filename /= Void and not a_filename.is_empty
#ifdef SE
			File_exists: file_exists(a_filename)
#endif
		do
			m_files_set.put_last (a_filename)
		end

	process is
			-- Read and process configuration
		require
			Valid_state: status = Unprocessed
			Has_options: count > 0
		do
			if not m_files_set.is_empty then
				from
					m_files_set.start
				until
					m_files_set.off
				loop
					read_file (m_files_set.item_for_iteration)
					m_files_set.forth
				end
			end
			if status = Unprocessed then
				read_environment
			end
			if status = Unprocessed and then Arguments.argument_count > 0 then
				read_arguments
			end
			if status = Unprocessed then
				status := Continue
			end
		ensure
			Valid_state: status = Bad_option or status = Die or status = Continue
		end

	remove_observer (a_name: STRING; an_obs: OBSERVER[CONFIGURATION_OPTION]) is
			-- Remove an observer to the option represented by a_name
		require
			has (a_name) and then item (a_name).has (an_obs)
		do
			item (a_name).remove (an_obs)
		end

	set_application_name (a_prefix: STRING) is
			-- set env prefix to app name
		do
#ifdef SE
			env_prefix := a_prefix.twin
#else
			!!env_prefix.make_from_string (a_prefix)
#endif
		end

	set_help (a_help: STRING) is
			-- set long help message
		do
#ifdef SE
			help_text := a_help.twin
#else
			!!help_text.make_from_string (a_help)
#endif
		end

	set_help_short (a_short: STRING) is
			-- set short help message
		do
#ifdef SE
			help_short_text := a_short.twin
#else
			!!help_short_text.make_from_string (a_short)
#endif
		end
feature {CONFIGURATION_MANAGER}
	-- heirarchy implementation

	read_file (a_filename: STRING) is
			-- Process configuration info from `a_filename'
		require
			Filename: a_filename /= Void and not a_filename.is_empty
#ifdef SE
			File_exists: file_exists(a_filename)
#endif
		do
			-- for each named config file pass values to option. This may 
			-- modify an options' `default' and `allow_no_override' as 
			-- well as `value'.
			
			-- When discovering the help message(s), the language ids
			-- from the help definitions are tested against
			-- `m_language'. If an exact math is found the corresponding
			-- help text will will be used. If a close match is found it
			-- will be used if no exact match has been found. In all
			-- cases the first close or exact match will take precedence
			-- over later definitions. If no language match is found the
			-- very first definition will be used.
		end

	read_arguments is
			-- Process configuration from arguments
		require
			Arguments.argument_count > 0
		local
			l_index, l_cursor: INTEGER
			l_option: CONFIGURATION_OPTION
			l_arg: STRING
		do
			debug
				std.output.put_string("Number of arguments = ")
				std.output.put_integer(Arguments.argument_count)
				std.output.put_character ('%N')
			end
			from
				l_index := 1
			variant
				Arguments.argument_count - l_index + 1
			until
				Arguments.argument_count < l_index or
					status = Bad_option or
					status = Die
			loop
				debug
					std.output.put_string ("looking at argument: " + Arguments.argument (l_index))
					std.output.put_character ('%N')
				end
				l_arg := get_option_name (Arguments.argument (l_index))
				debug
					std.output.put_string ("derived name is: " + l_arg)
					std.output.put_character ('%N')
				end
				if not l_arg.is_empty then
					l_option := item (l_arg)
					l_option.set_is_set
					if l_option.is_boolean then
						set_option_value (l_option, "True")
					else
						if next_arg_is_value (l_index) then
							set_option_value (l_option, Arguments.argument (l_index + 1))
							l_index := l_index + 1
						else
							set_option_value (l_option, Void)
						end
					end
				elseif is_single_character_options (Arguments.argument (l_index)) then
					l_arg := Arguments.argument (l_index)
				
#ifdef SE
					l_arg.remove_all_occurrences ('-')
#else
					l_arg.prune_all('-')
#endif
					from
#ifdef SE
						l_cursor := l_arg.lower
#else
						l_cursor := 1
#endif
					variant
#ifdef SE
						l_arg.upper - l_cursor + 1
#else
						l_arg.count - l_cursor
#endif
					until
#ifdef SE
						l_cursor > l_arg.upper
#else
						l_cursor >= l_arg.count
#endif
					loop
						l_option := item (m_letter_options.item (l_arg.item (l_cursor)))
						if l_option.is_boolean then
							set_option_value (l_option, "True")
						else
							if next_arg_is_value (l_index) then
								set_option_value (l_option, Arguments.argument (l_index + 1))
								l_index := l_index + 1
							else
								set_option_value (l_option, Void)
							end
						end
						l_cursor := l_cursor + 1
					end
				else
					status := Bad_option
				end
				l_index := l_index + 1
			end
		end

	read_environment is
			-- Process configuration from environment variables
		require
			count > 0
		do
			-- for each option attempt to find an env variable.
			-- from start until end or status = 
			-- BadOption or status = Die loop
			-- if option.allow_from_environment then
			-- if env.has(option.name) then
			--    set_option_value(option,env.at(option.name))
			-- elsif not option.no_prefix and then 
			-- env.has(prefix+'_'+option.name) then
			--    set_option_value(option,env.at(prefix+'_'+option.name))
			-- end
		end

feature {OBSERVABLE}
	-- Make us an observer
	update (an_opt: CONFIGURATION_OPTION) is
			-- Respond to an option
		do
			if an_opt.name.is_equal ("help") then
				help (std.output)
			elseif an_opt.name.is_equal ("conf") then
				write (std.output)
			elseif an_opt.name.is_equal ("h") then
				help_short (std.output)
			end
			-- ignore unknown options!
		end

feature {NONE}
	-- private implementation
	get_option_name (a_string: STRING): STRING is
			-- Test if string is a valid option name. This could involve 
			-- removing any leading '-'s. Normalise to lower case.
		do
#ifdef SE
			Result := a_string.twin
#else
			!!Result.make_from_string (a_string)
#endif
			if not Result.is_empty then
				Result.to_lower
#ifdef SE
				if Result.first = '-' then
					Result.remove_head (1)
					if Result.first = '-' then
						Result.remove_head (1)
					end
				end
#else
				if Result.item (1) = '-' then
					Result.remove_head (1)
				   if Result.item (1) = '-' then
						Result.remove_head (1)
					end
				end
#endif
				if not has (Result) then
#ifdef SE
					Result.clear_count_and_capacity
#else
					Result.wipe_out
#endif
				end
			end
			debug
				std.output.put_string ("Start = " + a_string)
				std.output.put_character ('%N')
				std.output.put_string ("Result = " + Result)
				std.output.put_character ('%N')
			end
		ensure
			not Result.is_empty implies has (Result)
		end

	is_single_character_options (a_string: STRING): BOOLEAN is
			-- Test if string is a made up of valid single-character
			-- options.
		local
			l_arg: STRING
#ifndef SE 
         l_index: INTEGER
#endif
		do
			if not a_string.is_empty then
#ifdef SE
            l_arg := a_string.twin
				if l_arg.first = '-' then
					l_arg.remove_head (1)
					if l_arg.first = '-' then
						l_arg.remove_head (1)
					end
				end
#else
			   !!l_arg.make_from_string (a_string)
				if l_arg.item (1) = '-' then
					l_arg.remove_head (1)
				   if l_arg.item (1) = '-' then
						l_arg.remove_head (1)
					end
				end
#endif
#ifdef SE
            Result := l_arg.for_all (agent m_letter_options.has)
#else
            Result := True
				from
					l_index := 1
				variant
					l_arg.count - l_index
				until
					not Result or else
					l_arg.count <= l_index
				loop
					Result := m_letter_options.has (l_arg.item (l_index))
					l_index := l_index + 1
				end
#endif
			end
		ensure
			-- Result implies all elements of string are single 
			-- character options
		end

	language_match (a_lang_id: STRING): INTEGER is
			-- Does the given language id conform to `m_language'.

			-- NEEDS MORE WORK: We may need to create a class (or get 
			-- from ePOSIX)
		require
			a_lang_id /= Void and then not a_lang_id.is_empty
		local
			l_index: INTEGER
		do
			from
				l_index := 1
			variant
				m_language.count - l_index
			until
				m_language.count = l_index or
					a_lang_id.count = l_index or else
				a_lang_id.item (l_index) /= m_language.item (l_index)
			loop
				l_index := l_index + 1
			end
			if
				l_index > 1 and then
				m_language.count = l_index or
					a_lang_id.count = l_index or else
				m_language.item (l_index - 1) = '_' or
					m_language.item (l_index - 1) = '.' then
					Result := l_index
			end
		end

	language_exact_match (a_lang_id: STRING): BOOLEAN is
			-- Does the given language id exactly match `m_language'.

			-- NEEDS MORE WORK: We may need to create a class (or get 
			-- from ePOSIX)
		do
			Result := a_lang_id.is_equal(m_language)
		end

	make is
			-- Create a manager
		do
			status := Unprocessed
			make_table
			!DS_LINKED_LIST[STRING]!m_files_set.make
			!DS_HASH_TABLE[STRING,CHARACTER]!m_letter_options.make_default
			set_language
		end

	next_arg_is_value (a_index: INTEGER): BOOLEAN is
			-- Could the next argument be a value rather than option?
		local
			l_arg: STRING
		do
			if a_index /= Arguments.argument_count then
				l_arg := get_option_name (Arguments.argument (a_index+1))
				if l_arg.is_empty then
					Result := True
				end
			end
		end

	set_language is
			-- Attempt to set the language value. This is used by 
			-- read_file to retrieve appropriate help texts.
		do
		end

	set_option_value (an_option: CONFIGURATION_OPTION; a_value: STRING) is
			-- Attempt to set value of option
		do
			if not an_option.allow_no_override then
				if a_value /= Void then
					if an_option.is_valid (a_value) then
						an_option.set_value (a_value)
					else
						status := Bad_option
					end
				else
					if an_option.default_value /= Void and then
						an_option.is_valid (an_option.default_value) then
						an_option.set_to_default
					else
						status := Bad_option
					end
				end
				if status /= Bad_option and then an_option.is_death then
					status := Die
				end
			end
		end

	as_environment_variable (a_string: STRING): STRING is
			-- Convert input string into a environment variable
		do
			Result := a_string.as_upper
		end

	m_files_set: DS_LIST[STRING]
			-- Set of configuration files

	m_letter_options: DS_SPARSE_TABLE[STRING,CHARACTER]
			-- Set of single letter options

	m_language: STRING
			-- Language identifier
	
invariant
	Valid_state: status = Bad_option xor status = Die xor status = Continue xor status = Unprocessed
end -- class CONFIGURATION_MANAGER

