prompt Package Body: jrm_val

create or replace package body jrm_val is
------------------------------------------------
-- Package : Private data/methods
------------------------------------------------
  SHAREABLE_ELEMENT CONSTANT NUMBER := 4968;



---------------------------------------------------------------------
-- Function : isValidHierarchyName
---------------------------------------------------------------------
--
-- Look for duplicate attribute names in class hierarchy. Display as a warning.
--    
function  isValidHierarchyName(product_name VARCHAR2) return BOOLEAN is
  supers NUMBER := 0;
  valid BOOLEAN := TRUE;
begin
  select count(supertypes) into supers from rm_element_types where product = product_name;
  -- Have we any supertypes?
  if supers <> 0 then
    -- yes then we had better check for a possible duplicate name in the hierachy
    for element in (select id,name from rm_element_types where product = product_name and supertypes = SHAREABLE_ELEMENT) loop
      for duplicate in (select name,count(name) from rm_properties where defined_against in 
        (select id from rm_element_types connect by prior id=supertypes start with id = element.id)
        group by name having count(name) > 1) loop
        jr_reg_io.put_line('Warning: Hierachy problem. Element ' || element.name || ' could duplicate attribute ' || duplicate.name);
        valid := FALSE;
      end loop;
    end loop;
  end if;
  return valid;
end isValidHierarchyName;

---------------------------------------------------------------------
-- Function : isValidAssocName
---------------------------------------------------------------------
--
-- Look for associations between the same classifiers that have the same name. Display as a warning.
--
-- types == 16 => association
function isValidAssocName(product_name VARCHAR2) return BOOLEAN is
  valid BOOLEAN := TRUE;
begin
  for element in (select id,name from rm_element_types where product = product_name) loop
    for duplicate in (select name,count(name) from rm_link_properties where defined_against = element.id and types = 16
                      group by name having count(name) > 1) loop
      jr_reg_io.put_line('Warning: Duplicate association name: ' || duplicate.name || ' on element ' || element.name);
      valid := FALSE;
    end loop;
  end loop;
  return valid;
end isValidAssocName;


---------------------------------------------------------------------
-- Function : isValidAssocAttribName
---------------------------------------------------------------------
--
-- Look for associations between classifiers that will have an attribute named the same other end of
-- an association. Display as a warning.
--
function isValidAssocAttribName(product_name VARCHAR2) return BOOLEAN is
  this_element_name rm_element_types.name%TYPE;
  other_element_name rm_element_types.name%TYPE;
  valid BOOLEAN := TRUE;
begin
  for link in (select id from rm_link_types where product = product_name) loop
    for this_end in (select defined_against,name from rm_link_properties where link_type = link.id) loop
      select name into this_element_name from rm_element_types where id = this_end.defined_against;
      -- dbms_output.put('Element ' || this_element_name || ' -> ');
      for other_end in (select defined_against,name from rm_link_properties where link_type = link.id and defined_against <> this_end.defined_against) loop
        select name into other_element_name from rm_element_types where id = other_end.defined_against;
        -- jr_reg_io.put_line(other_element_name);
        for attribute in (select name from rm_properties where defined_against = other_end.defined_against) loop
          if attribute.name = this_end.name then
            jr_reg_io.put_line('Warning: Name clash on ' || attribute.name || ' in ' || this_element_name || ' and association ' || this_end.name || ' on element ' || other_element_name);
            valid := FALSE;
          end if;
        end loop;
      end loop;
    end loop;
  end loop;
  return valid;
end isValidAssocAttribName;

---------------------------------------------------------------------
-- Function : hasNoManyToMany
---------------------------------------------------------------------
--
-- Look for many to many associations. Display as a warning.
--
function hasNoManyToMany(product_name VARCHAR2) return BOOLEAN is
  this_element_name rm_element_types.name%TYPE;
  other_element_name rm_element_types.name%TYPE;
  valid BOOLEAN := TRUE;
begin
  for link in (select id from rm_link_types where product = product_name) loop
    for this_end in (select max_cardinality,defined_against from rm_link_properties where link_type = link.id) loop
      select name into this_element_name from rm_element_types where id = this_end.defined_against;
      for other_end in (select max_cardinality,defined_against from rm_link_properties where link_type = link.id and defined_against <> this_end.defined_against) loop
        select name into other_element_name from rm_element_types where id = other_end.defined_against;
        if this_end.max_cardinality = -1 and other_end.max_cardinality = -1 then
          jr_reg_io.put_line('Warning: many to many between ' || this_element_name || ' and ' || other_element_name );
          valid := FALSE;
        end if;
      end loop;
    end loop;
  end loop;
  return valid;
end hasNoManyToMany;
---------------------------------------------------------------------
-- Function : hasIntfcExtendingIntfc
---------------------------------------------------------------------
--
-- Interfaces can only extend interfaces. Look for interface extending a non-interface. 
-- Display as a warning.
--
function hasIntfcExtendingIntfc(product_name VARCHAR2) return BOOLEAN is
  valid BOOLEAN := TRUE;
begin
  for interface in (select name,supertypes from rm_element_types where interface_flag = 'Y' and product = product_name) loop
    for supertype in (select name,interface_flag from rm_element_types where id = interface.supertypes) loop
      if supertype.interface_flag = 'N' then
        jr_reg_io.put_line('Warning: Interface ' || interface.name || ' extends non-interface ' || supertype.name);
        valid := FALSE;
      end if;
    end loop;
  end loop;
  return valid;
end hasIntfcExtendingIntfc;



---------------------------------------------------------------------
-- Procedure : dump ( a product)
---------------------------------------------------------------------
procedure dump(product_name VARCHAR2) is

procedure doTabs(tab_count NUMBER) is
space VARCHAR2(1) := '.';
begin
  for i in 0..tab_count loop
    dbms_output.put( space );
  end loop;
end doTabs;

procedure printChildren( parent NUMBER ) is
tabs NUMBER := 0; 
begin 
  for child in (select id,name from rm_element_types where supertypes = parent) loop
    doTabs( tabs );
    jr_reg_io.put_line( '|' );
    doTabs( tabs );
    dbms_output.put( '+-' );
    jr_reg_io.put_line( child.name );
    tabs := tabs + 1;
    printChildren( child.id );
    tabs := tabs - 1;
  end loop;
end printChildren;


begin
  for root_element in (select id,name from rm_element_types where product = product_name and supertypes = SHAREABLE_ELEMENT) loop
    jr_reg_io.put_line( root_element.name );
    printChildren( root_element.id );
  end loop;
end dump;

---------------------------------------------------------------------
-- Function : isValid
---------------------------------------------------------------------

function isValid( product_name VARCHAR2, server VARCHAR2 default null, file VARCHAR2 default null ) return BOOLEAN is
valid BOOLEAN := FALSE;
begin
  if server is not null and file is not null then
    jr_reg_io.init_log_file( server , file );
  end if;
  
  valid := (isValidHierarchyName(product_name) and
          isValidAssocName(product_name) and
          isValidAssocAttribName(product_name) and
          hasNoManyToMany(product_name) and
          hasIntfcExtendingIntfc(product_name));
  
  if server is not null and file is not null then
    jr_reg_io.close_log_file( 'verify.log' );          
  end if;
  
  return valid;
  
end isValid;

end jrm_val;
/