note

	status: "See notice at end of class.";
	Date: "$Date$";
	Revision: "$Revision$";
	Product: "Environment Converter"

class EC_DESCRIPTOR inherit

	EC_TYPES;

	EXT_INTERNAL

create -- Creation procedure

	make

feature  -- Initilization

	make
		do
			create ecd_fields.make (10);
			ecd_clear
		end;

feature -- Status report

	ecd_error: BOOLEAN

	ecd_message: detachable STRING

	field_separator: CHARACTER

	ecd_fields: ARRAYED_LIST [EC_FIELD]

	ecd_index: INTEGER
			-- Index of the current field
		do
			Result := ecd_fields.index
		end

	ecd_min_index: INTEGER
			-- Index of the first field

	ecd_max_index: INTEGER
			-- Index of the last field

	ecd_reference_name: detachable STRING

	ecd_reference: detachable ANY

feature -- Status setting

	set_field_separator (fs: CHARACTER)
			-- Set field separator with `fs'.
		do
			field_separator := fs
		ensure
			field_separator = fs
		end;

	ecd_clear
		do
			ecd_fields.wipe_out
			ecd_initialized := False
			ecd_max_index := 0
			field_separator := ';'
		end;

	set_field (n: STRING; type: INTEGER)
			-- Set `ecd_index'-th field with type `type' and name `n'.
		local
			f: EC_FIELD
		do
			ecd_initialized := True;
			create f.make (type, n)
			ecd_fields.extend (f)
			if ecd_fields.count > ecd_max_index then
				ecd_max_index := ecd_fields.count
			end;
		end;

	set_delimiters (ld, rd: CHARACTER)
			-- Set field value delimiters with `ld' and `rd'.
		require
			current_field_exists: not ecd_fields.is_empty
		do
			ecd_fields.last.set_value_delimiters (ld, rd)
		end;

	set_label_separator (ls: CHARACTER)
			-- Set label separator with `ls'.
		require
			current_field_exists: not ecd_fields.is_empty
		do
			ecd_fields.last.set_label_separator (ls)
		end;

	set_use_label (b: BOOLEAN)
			-- Set `use_label' with `b'.
		require
			current_field_exists: not ecd_fields.is_empty
		do
			ecd_fields.last.set_use_label (b)
		end;

	check_conformity (ref: ANY)
			-- Check if current desciptor conforms to `ref'.
			-- The conformity is true if and only if for each
			-- field of the current descriptor, there is a
			-- corresponding field in the Eiffel object with
			-- the same field_name and the same field_type.
		require
			reference_exists: ref /= Void
		local
			i, j, nb_fields: INTEGER;
			tmps: STRING;
			ra, da: ARRAY [BOOLEAN]  -- Referenced and Declared array
			l_field: EC_FIELD
		do
			ecd_error := False;
			create tmps.make(0);
			nb_fields := field_count (ref);
			if ecd_fields.is_empty then
				tmps.wipe_out;
				tmps.append ("Type conformity error, No field can be indexed with ");
				tmps.append_integer (nb_fields)
				tmps.append (".%N");
				set_ecd_error (tmps)
			end;
			if not ecd_error and then ecd_fields.count /= nb_fields then
				tmps.wipe_out;
				tmps.append ("Type conformity error, Last field `");
				tmps.append (ecd_fields.last.field_name);
				tmps.append("' cannot be indexed with ");
				tmps.append_integer (nb_fields);
				tmps.append (".%N");
				set_ecd_error(tmps)
			end
			if not ecd_error then
				create ra.make_filled (False, 1, nb_fields);
				create da.make_filled (False, 1, nb_fields);
				from
					i:=1
				until
					i > nb_fields or ecd_error
				loop
					from
						j:=1
					until
						j > nb_fields or ecd_error
					loop
						l_field := ecd_fields.i_th (j)
						if field_conforms (i, ref, l_field) then
							if ra.item (i) then
								tmps.wipe_out;
								tmps.append("Type conformity error, Field ");
								tmps.append(j.out);
								tmps.append(":`");
								tmps.append(l_field.field_name);
								tmps.append("' cannot be declared twice.%N");
								set_ecd_error(tmps)
							elseif da.item(j) then
								tmps.wipe_out;
								tmps.append("Type conformity fatal error: Referenced object has two identical fields%N");
								set_ecd_error(tmps)
							else
								ra.force(True,i);
								da.force(True,j);
								l_field.set_rank(i)
							end
						end
						j := j + 1
					end;
					i := i + 1
				end;
				if not ecd_error then
					from
						i := 1
					until
						i > nb_fields
					loop
						if not da.item(i) then
							tmps.append("Type conformity error, Field ");
							tmps.append(i.out);
							tmps.append(":`");
							tmps.append(ecd_fields.i_th (i).field_name)
							tmps.append("' does not match any reference field.%N");
							set_ecd_error(tmps)
						end;
						i := i + 1
					end
				end;
				if not ecd_error then
					ecd_reference_name := ref.generator;
					ecd_reference := ref
				end
			end
		end;

	make_conform (ref: ANY)
			-- Make current description conform to `ref'.
			-- (Using eiffel Standards).
		require
			reference_exists: ref /= Void
		local
			i, nb_fields: INTEGER;
			tmps:STRING
			l_f_name: like f_name
		do
			ecd_error := False;
			create tmps.make(5);
			nb_fields := field_count (ref);
			ecd_clear;
			from
				i:=1
			until
				i > nb_fields or ecd_error
			loop
				f_type := field_type (i, ref);
				l_f_name := field_name (i, ref);
				f_name := l_f_name
				inspect f_type
				when BOOLEAN_TYPE then
					set_field (l_f_name, Boolean_ttype)
				when REAL_TYPE then
					set_field (l_f_name, Real_ttype)
				when INTEGER_TYPE then
					set_field (l_f_name, Integer_ttype)
				else
					set_field (l_f_name, String_ttype);
				end;
				ecd_fields.i_th (i).set_rank (i)
				i := i + 1
			end;
			if not ecd_error then
				ecd_reference_name := ref.generator;
				ecd_reference := ref
			end
		end

feature {NONE} -- Status report

	ecd_initialized: BOOLEAN;

	f_type: INTEGER;

	f_name: detachable STRING;

feature {NONE} -- Status setting

	set_ecd_error (s: STRING)
			-- Set error flag and error message with `s'.
		require
			s_not_void: s /= Void
		do
			ecd_error := True;
			ecd_message := s.twin
		end;

	field_conforms (i: INTEGER; o: ANY; f: EC_FIELD): BOOLEAN
			-- Checks for fields confomity.
			-- (names and types)
		require
			reference_object_exists: o /= Void
			f_exists: f /= Void
		local
			tmps:STRING;
			tmpb:BOOLEAN
		do
			create tmps.make(5);
			f_type := field_type (i, o);
			f_name := field_name (i, o);
			if f.field_name ~ f_name then
				inspect f.field_type
				when Boolean_ttype then
					tmpb := (f_type = BOOLEAN_TYPE)
				when Integer_ttype then
					tmpb := (f_type = INTEGER_TYPE)
				when Real_ttype then
					tmpb := (f_type = REAL_TYPE)
				when String_ttype then
					tmpb := (f_type = REFERENCE_TYPE)
				else
					tmpb := False;
					tmps.append ("Type conformity error, Unknown declared type for field `");
					tmps.append(f.field_name);
					tmps.append("'.%N");
					set_ecd_error(tmps)
				end;
				if not tmpb and not ecd_error then
					tmps.append ("Type conformity error, Invalid declared type for field `");
					tmps.append(f.field_name);
					tmps.append("'.%N");
					set_ecd_error(tmps)
				end;
				Result := tmpb
			else
				Result := False
			end
		end

note
	copyright:	"Copyright (c) 1984-2014, Eiffel Software and others"
	license:	"Eiffel Forum License v2 (see http://www.eiffel.com/licensing/forum.txt)"
	source: "[
			Eiffel Software
			5949 Hollister Ave., Goleta, CA 93117 USA
			Telephone 805-685-1006, Fax 805-685-6869
			Website http://www.eiffel.com
			Customer support http://support.eiffel.com
		]"

end -- class EC_DESCRIPTOR