Index: openacs-4/packages/acs-object-management/acs-object-management.info =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/acs-object-management.info,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-object-management/acs-object-management.info 28 Jul 2009 23:35:08 -0000 1.1 @@ -0,0 +1,28 @@ + + + + + ACS Object Management + ACS Object Management + f + t + f + f + acs-object-management + + + Don Baccus + API to manage all things objecty + API and admin pages to create and edit object types. + 0 + + + + + + + + + + + Index: openacs-4/packages/acs-object-management/catalog/acs-object-management.en_US.ISO-8859-1.xml =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/catalog/acs-object-management.en_US.ISO-8859-1.xml,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-object-management/catalog/acs-object-management.en_US.ISO-8859-1.xml 28 Jul 2009 23:35:08 -0000 1.1 @@ -0,0 +1,67 @@ + + + ACS Object Types Management + Add + Add an attribute + Add a Form element + Add a Form + Add a Type + Add a View + Attribute + Add Attribute + Default Value + + Edit Attribute + Attribute Name + This name must be lower case, contain only letters and underscores, and contain no spaces. If not specified one will be generated for you. + Name of attribute displayed in forms. + Plural form of pretty name. + Attributes + Export code to recreate dynamic types and forms + Tcl code to recreate selected dynamic types and forms + Content + Create Type + Create View + delete + Delete + Datatype + + Dynamic Types + Edit Form Name + Chose the attrbiute for this widget. + Form elements + Export + Form Name + Form "%form_name%" + Forms + Inherited Attributes + you must supply either -multirow or -indexed_array + node 'element' must have either a 'name' attribute or an 'attribute' attribute. + Object Type + Object View + Parameter + Parameter "%param%" + Source + Tcl Function + Constant + DB Query + Type + List with multiple columns + List with one column + Single Value + Value + Parameters of "%attribute_name%" + Parameters + Pretty Name + Pretty Plural + Remove + Remove Element from Form + Required? + Supertype + unable to retrieve widget parameter %name% for attribute %attribute_id% - returning "" as parameter value + View + Views + Widget + -- Default Widget -- + Choose widget type + Index: openacs-4/packages/acs-object-management/sql/postgresql/acs-content-repository-changes-create.sql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/sql/postgresql/Attic/acs-content-repository-changes-create.sql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-object-management/sql/postgresql/acs-content-repository-changes-create.sql 28 Jul 2009 23:35:09 -0000 1.1 @@ -0,0 +1,105 @@ + +select define_function_args('content_type__create_type','content_type,supertype;content_revision,pretty_name,pretty_plural,table_name,id_column,name_method'); + +create or replace function content_type__create_type (varchar,varchar,varchar,varchar,varchar,varchar,varchar) +returns integer as ' +declare + create_type__content_type alias for $1; + create_type__supertype alias for $2; -- default ''content_revision'' + create_type__pretty_name alias for $3; + create_type__pretty_plural alias for $4; + create_type__table_name alias for $5; + create_type__id_column alias for $6; -- default ''XXX'' + create_type__name_method alias for $7; -- default null + v_temp_p boolean; + v_supertype_table acs_object_types.table_name%TYPE; + +begin + + if (create_type__supertype <> ''content_revision'') + and (create_type__content_type <> ''content_revision'') then + select count(*) > 0 into v_temp_p + from acs_object_type_supertype_map + where object_type = create_type__supertype + and ancestor_type = ''content_revision''; + + if not v_temp_p then + raise EXCEPTION ''-20000: supertype % must be a subtype of content_revision'', create_type__supertype; + end if; + end if; + + PERFORM acs_object_type__create_type ( + create_type__content_type, + create_type__pretty_name, + create_type__pretty_plural, + create_type__supertype, + create_type__table_name, + create_type__id_column, + null, + ''f'', + null, + create_type__name_method, + ''t'', + ''f'' + ); + + PERFORM content_type__refresh_view(create_type__content_type); + + return 0; +end;' language 'plpgsql'; + +select define_function_args('content_type__create_attribute','content_type,attribute_name,datatype,pretty_name,pretty_plural,sort_order,default_value,column_spec;text'); + +create or replace function content_type__create_attribute (varchar,varchar,varchar,varchar,varchar,integer,varchar,varchar) +returns integer as ' +declare + create_attribute__content_type alias for $1; + create_attribute__attribute_name alias for $2; + create_attribute__datatype alias for $3; + create_attribute__pretty_name alias for $4; + create_attribute__pretty_plural alias for $5; -- default null + create_attribute__sort_order alias for $6; -- default null + create_attribute__default_value alias for $7; -- default null + create_attribute__column_spec alias for $8; -- default ''text'' + v_attr_id acs_attributes.attribute_id%TYPE; + v_table_name acs_object_types.table_name%TYPE; + v_column_exists boolean; +begin + + -- add the appropriate column to the table + + select table_name into v_table_name from acs_object_types + where object_type = create_attribute__content_type; + + if NOT FOUND then + raise EXCEPTION ''-20000: Content type % does not exist in content_type.create_attribute'', create_attribute__content_type; + end if; + + v_attr_id := acs_attribute__create_attribute ( + create_attribute__content_type, + create_attribute__attribute_name, + create_attribute__datatype, + create_attribute__pretty_name, + create_attribute__pretty_plural, + null, + null, + create_attribute__default_value, + 1, + 1, + create_attribute__sort_order, + ''type_specific'', + ''f'', + ''t'', + null, + null, + null, + null, + null, + create_attribute__column_spec + ); + + PERFORM content_type__refresh_view(create_attribute__content_type); + + return v_attr_id; + +end;' language 'plpgsql'; Index: openacs-4/packages/acs-object-management/sql/postgresql/acs-kernel-changes-create.sql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/sql/postgresql/Attic/acs-kernel-changes-create.sql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-object-management/sql/postgresql/acs-kernel-changes-create.sql 28 Jul 2009 23:35:09 -0000 1.1 @@ -0,0 +1,876 @@ +alter table acs_datatypes add database_type text; +alter table acs_datatypes add column_size text; +alter table acs_datatypes add column_check_expr text; +alter table acs_datatypes add column_output_function text; + +-- Making user and person dynamic can lead to a broken web site, so +-- for now at least I won't do it. Code using these types have assumptions +-- about the existence of certain attributes, and of course deleting them +-- and their objects would destroy a site. + +-- Types probably should have a flag saying whether or not it can be deleted, and +-- perhaps attributes, too. Too much change for now. + +--update acs_object_types +--set dynamic_p = 't' +--where object_type = 'person'; + +--update acs_object_types +--set dynamic_p = 't' +--where object_type = 'user'; + +comment on table acs_datatypes is ' + Defines the set of available abstract datatypes for acs_attributes, along with + an optional default mapping to a database type, size, and constraint to use if the + attribute is created with create_attribute''s storage_type param set to "type_specific" + and the create_storage_p param is set to true. These defaults can be overwritten by + the caller. + + The set of pre-defined datatypes is inspired by XForms + (http://www.w3.org/TR/xforms-datamodel/). +'; + +comment on column acs_datatypes.database_type is ' + The base database type corresponding to the abstract datatype. For example "varchar" or + "integer". +'; + +comment on column acs_datatypes.column_size is ' + Optional default column size specification to append to the base database type. For + example "1000" for the "string" abstract datatype, or "10,2" for "number". +'; + +comment on column acs_datatypes.column_check_expr is ' + Optional check constraint expression to declare for the type_specific database column. +'; + +comment on column acs_datatypes.column_output_function is ' + Function to call for this datatype when building a select view. If not null, it will + be called with an attribute name and is expected to return an expression on that + attribute. Example: date attributes will be transformed to calls to "to_char()". +'; + +-- Though the PostgreSQL "text" type is a true variable length string implementation, we +-- implement most string types using "varchar" and a default size argument. This makes +-- it possible to write a high-level type specification that works in both Oracle and PG. + +-- DRB: add double bigint etc if Oracle supports them + +update acs_datatypes +set database_type = 'varchar', + column_size = '4000' +where datatype = 'string'; + +update acs_datatypes +set database_type = 'boolean' +where datatype = 'boolean'; + +update acs_datatypes +set database_type = 'numeric', + column_size = '10,2' +where datatype = 'number'; + +update acs_datatypes +set database_type = 'integer' +where datatype = 'integer'; + +update acs_datatypes +set database_type = 'money' +where datatype = 'money'; + +update acs_datatypes +set database_type = 'timestamp' +where datatype = 'date'; + +update acs_datatypes +set database_type = 'timestamp' +where datatype = 'timestamp'; + +update acs_datatypes +set database_type = 'timestamp' +where datatype = 'time_of_day'; + +update acs_datatypes +set database_type = 'varchar', + column_size = '100' +where datatype = 'enumeration'; + +update acs_datatypes +set database_type = 'varchar', + column_size = 200 +where datatype = 'email'; + +update acs_datatypes +set database_type = 'varchar', + column_size = 200 +where datatype = 'file'; + +update acs_datatypes +set database_type = 'text' +where datatype = 'text'; + +update acs_datatypes +set database_type = 'varchar', + column_size = 100 +where datatype = 'keyword'; + +update acs_datatypes +set column_output_function = 'acs_datatype__timestamp_output_function' +where datatype = 'date'; + +update acs_datatypes +set column_output_function = 'acs_datatype__timestamp_output_function' +where datatype = 'timestamp'; + +update acs_datatypes +set column_output_function = 'acs_datatype__timestamp_output_function' +where datatype = 'time_of_day'; + +create or replace function acs_datatype__timestamp_output_function(text) +returns text as ' +declare + p_attribute_name alias for $1; +begin + return ''to_char('' || p_attribute_name || '', ''''YYYY-MM-DD HH24:MI'''')''; +end;' language 'plpgsql'; + +-- New tables to model object-based views. Since view names must be unique in SQL +-- we force them to be unique in our datamodel, too (rather than only unique to the +-- object type). + +create table acs_object_views ( + object_view text + constraint acs_object_views__pk + primary key, + object_type text + constraint acs_object_views_object_type_fk + references acs_object_types + on delete cascade, + pretty_name text + constraint acs_object_views_pretty_name_nn + not null, + root_view_p boolean default 'f' + constraint acs_object_views_root_view_p_nn + not null +); + +comment on table acs_object_views is ' + Track information on object type-based views, including the initial view created for + an object type +'; + +comment on column acs_object_views.object_view is ' + The name of the view. The initial view for an object type is given the name + "object_type_name_v". If the object type the view references is deleted, the acs_view + will be dropped, too. +'; + +comment on column acs_object_views.object_type is ' + The object type this view is built from. +'; + +comment on column acs_object_views.pretty_name is ' + Pretty name for this view +'; + +create table acs_object_view_attributes ( + attribute_id integer + constraint acs_object_view_attributes_attribute_id_fk + references acs_attributes + on delete cascade, + col_name text, + object_view text + constraint acs_object_view_attributes_object_view_fk + references acs_object_views(object_view) + on delete cascade, + pretty_name text + constraint acs_object_views_pretty_name_nn + not null, + sort_order integer + constraint acs_object_views_sort_order + not null, + col_expr text + constraint acs_object_view_attributes_type_col_spec_nn + not null, + constraint acs_object_view_attributes_pk primary key (object_view, col_name) +); + +comment on table acs_object_view_attributes is ' + Track information on view attributes. This extends the acs_attributes table with + view-specific attribute information. If the view or object type attribute referenced + by the view attribute is deleted, the view attribute will be, too. +'; + +comment on column acs_object_view_attributes.attribute_id is ' + The acs_attributes row we are augmenting with view-specific information. This is not + used as the primary key because multiple views might use the same acs_attribute. +'; + +comment on column acs_object_view_attributes.col_name is ' + The name assigned to this column in the view. Usually it is the acs_attribute name, + but if multiple attributes have the same name, they are disambiguated with suffixes + of the form _N. +'; + +comment on column acs_object_view_attributes.object_view is ' + The name of the view this attribute is being declared for. +'; + +comment on column acs_object_view_attributes.pretty_name is ' + The pretty name of the view. +'; + +comment on column acs_object_view_attributes.sort_order is ' + The order of display when shown to a user. A bit odd to have it here, but + the original object attributes have a sort_order defined, so for consistency we will + do the same for view attributes. +'; + +comment on column acs_object_view_attributes.col_expr is ' + The expression used to build the column. Usually just the acs_attribute name, but certain + datatypes might call a function on the attribute value (i.e. "to_char()" for timestamp + types). +'; + +select define_function_args('acs_object_view__create_sql_view','object_view'); + +create or replace function acs_object_view__create_sql_view (varchar) +returns integer as ' +declare + p_view alias for $1; + v_cols varchar; + v_tabs varchar; + v_joins varchar; + v_first_p boolean; + v_join_rec record; + v_attr_rec record; + v_tree_sortkey_found_p boolean; +begin + + if length(p_view) > 64 then + raise exception ''View name "%" cannot be longer than 64 characters.'',p_type; + end if; + + if not exists (select 1 + from acs_object_views + where object_view = p_view) then + raise exception ''No object type named "%" exists'',p_view; + end if; + + v_tabs := ''''; + v_joins := ''''; + v_first_p := ''t''; + v_tree_sortkey_found_p := ''f''; + v_cols := ''acs_objects.object_id''; + + for v_join_rec in select ot2.object_type, ot2.table_name, ot2.id_column, + tree_level(ot2.tree_sortkey) as level + from acs_object_types ot1, acs_object_types ot2, acs_object_views ov + where ov.object_view = p_view + and ot1.object_type = ov.object_type + and ot1.tree_sortkey between ot2.tree_sortkey and tree_right(ot2.tree_sortkey) + order by ot2.tree_sortkey desc + loop + if v_join_rec.table_name is not null then + + if not v_tree_sortkey_found_p and column_exists(v_join_rec.table_name, ''tree_sortkey'') then + v_cols := v_cols || '','' || v_join_rec.table_name || ''.tree_sortkey''; + v_tree_sortkey_found_p := ''t''; + end if; + + if not v_first_p then + v_tabs := v_tabs || '', ''; + end if; + v_tabs := v_tabs || v_join_rec.table_name; + + + if v_join_rec.table_name <> ''acs_objects'' then + if not v_first_p then + v_joins := v_joins || '' and ''; + end if; + v_joins := v_joins || '' acs_objects.object_id = '' || v_join_rec.table_name || + ''.'' || v_join_rec.id_column; + end if; + + v_first_p := ''f''; + + end if; + end loop; + + for v_attr_rec in select col_name, col_expr + from acs_object_view_attributes + where object_view = p_view + order by sort_order + loop + v_cols := v_cols || '','' || v_attr_rec.col_expr || '' as '' || v_attr_rec.col_name; + end loop; + + if v_joins <> '''' then + v_joins := '' where '' || v_joins; + end if; + + if table_exists(p_view) then + execute ''drop view '' || p_view; + end if; + + execute ''create or replace view '' || p_view || '' as select '' || + v_cols || '' from '' || v_tabs || v_joins; + + return 0; +end;' language 'plpgsql'; + +-- Create the attributes select view for a type. The view is given the type's table +-- name appended with "v". The only id column returned is object_id, which avoids duplicate +-- column name issues. + +select define_function_args('acs_object_type__refresh_view','object_type'); + +-- Need to create the view and view attribute metadata ... + +create or replace function acs_object_type__refresh_view (varchar) +returns integer as ' +declare + p_type alias for $1; + v_attr_rec record; + v_type_rec record; + v_dupes integer; + v_col_name text; + v_col_expr text; + v_sort_order integer; + v_view text; +begin + + if not exists (select 1 + from acs_object_types + where object_type = p_type) then + raise exception ''No object type named "%" exists'',p_type; + end if; + + v_view := p_type || ''_v''; + + delete from acs_object_views where object_view = v_view; + + insert into acs_object_views + (object_view, object_type, pretty_name, root_view_p) + select v_view, p_type, pretty_name, ''t'' + from acs_object_types + where object_type = p_type; + + v_sort_order := 1; + + for v_type_rec in select ot2.object_type, ot2.table_name, ot2.id_column, + tree_level(ot2.tree_sortkey) as level + from acs_object_types ot1, acs_object_types ot2 + where ot1.object_type = p_type + and ot1.tree_sortkey between ot2.tree_sortkey and tree_right(ot2.tree_sortkey) + order by ot2.tree_sortkey desc + loop + + for v_attr_rec in select a.attribute_name, d.column_output_function, a.attribute_id, + a.pretty_name + from acs_attributes a, acs_datatypes d + where a.object_type = v_type_rec.object_type + and a.storage = ''type_specific'' + and a.table_name is null + and a.datatype = d.datatype + loop + + v_col_name := v_attr_rec.attribute_name; + v_col_expr := v_type_rec.table_name || ''.'' || v_col_name; + + if v_attr_rec.column_output_function is not null then + execute ''select '' || v_attr_rec.column_output_function || ''('''''' || v_col_expr || + '''''')'' into v_col_expr; + end if; + + -- The check for dupes could be rolled into the select above but it is far more + -- readable when broken out, I think. + + v_dupes := count(*) + from acs_attributes + where attribute_name = v_attr_rec.attribute_name + and object_type in (select ot2.object_type + from acs_object_types ot1, acs_object_types ot2 + where ot1.object_type = v_type_rec.object_type + and ot1.tree_sortkey + between tree_left(ot2.tree_sortkey) + and tree_right(ot2.tree_sortkey)); + if v_dupes > 0 then + v_col_name := v_col_name || ''_'' || substr(to_char(v_dupes, ''9''),2,1); + end if; + + insert into acs_object_view_attributes + (attribute_id, col_name, object_view, pretty_name, sort_order, col_expr) + values + (v_attr_rec.attribute_id, v_col_name, v_view, v_attr_rec.pretty_name, v_sort_order, + v_col_expr); + + v_sort_order := v_sort_order + 1; + + end loop; + end loop; + + perform acs_object_view__create_sql_view(p_type || ''_v''); + + -- Now fix all subtypes (really only necessary for the attributes view when an attribute + -- has been added or dropped, but there is no harm in doing it always). The supertype + -- not equal to object_type bit is again due to the fact that acs_object has itself + -- as its supertype rather than null. + + for v_type_rec in select object_type + from acs_object_types + where supertype = p_type + and supertype <> object_type + loop + perform acs_object_type__refresh_view(v_type_rec.object_type); + end loop; + + return 0; +end;' language 'plpgsql'; + + +select define_function_args('acs_object_type__create_type','object_type,pretty_name,pretty_plural,supertype,table_name,id_column,package_name,abstract_p;f,type_extension_table,name_method,create_table_p;f,dynamic_p;f'); + +create or replace function acs_object_type__create_type (varchar,varchar,varchar,varchar,varchar,varchar,varchar,boolean,varchar,varchar, boolean, boolean) +returns integer as ' +declare + p_object_type alias for $1; + p_pretty_name alias for $2; + p_pretty_plural alias for $3; + p_supertype alias for $4; + p_table_name alias for $5; -- default null + p_id_column alias for $6; -- default null + p_package_name alias for $7; -- default null + p_abstract_p alias for $8; -- default ''f'' + p_type_extension_table alias for $9; -- default null + p_name_method alias for $10; -- default null + p_create_table_p alias for $11; + p_dynamic_p alias for $12; + v_package_name acs_object_types.package_name%TYPE; + v_supertype acs_object_types.supertype%TYPE; + v_name_method varchar; + v_idx integer; + v_temp_p boolean; + v_supertype_table acs_object_types.table_name%TYPE; + v_id_column acs_object_types.id_column%TYPE; + v_table_name acs_object_types.table_name%TYPE; +begin + v_idx := position(''.'' in p_name_method); + if v_idx <> 0 then + v_name_method := substr(p_name_method,1,v_idx - 1) || + ''__'' || substr(p_name_method, v_idx + 1); + else + v_name_method := p_name_method; + end if; + + -- If we are asked to create the table, provide reasonable default values for the + -- table name and id column. Traditionally OpenACS uses the plural form of the type + -- name. This code appends "_t" (for "table") because the use of english plural rules + -- does not work well for all languages. + + if p_create_table_p and (p_table_name is null or p_table_name = '''') then + v_table_name := p_object_type || ''_t''; + else + v_table_name := p_table_name; + end if; + + if p_create_table_p and (p_id_column is null or p_id_column = '''') then + v_id_column := p_object_type || ''_id''; + else + v_id_column := p_id_column; + end if; + + if p_package_name is null or p_package_name = '''' then + v_package_name := p_object_type; + else + v_package_name := p_package_name; + end if; + + if p_supertype is null or p_supertype = '''' then + v_supertype := ''acs_object''; + else + v_supertype := p_supertype; + end if; + + insert into acs_object_types + (object_type, pretty_name, pretty_plural, supertype, table_name, + id_column, abstract_p, type_extension_table, package_name, + name_method, dynamic_p) + values + (p_object_type, p_pretty_name, + p_pretty_plural, v_supertype, + v_table_name, v_id_column, + p_abstract_p, p_type_extension_table, + v_package_name, v_name_method, p_dynamic_p); + + if p_create_table_p then + + if exists (select 1 + from pg_class + where relname = lower(v_table_name)) then + raise exception ''Table "%" already exists'', v_table_name; + end if; + + select table_name into v_supertype_table from acs_object_types + where object_type = p_supertype; + + execute ''create table '' || v_table_name || '' ('' || + v_id_column || '' integer constraint '' || v_table_name || + ''_pk primary key '' || '' constraint '' || v_table_name || + ''_fk references '' || v_supertype_table || '' on delete cascade)''; + end if; + + return 0; +end;' language 'plpgsql'; + +-- DRB: backwards compatibility version, don't allow for table creation. + +create or replace function acs_object_type__create_type (varchar,varchar,varchar,varchar,varchar,varchar,varchar,boolean,varchar,varchar) +returns integer as ' +declare + p_object_type alias for $1; + p_pretty_name alias for $2; + p_pretty_plural alias for $3; + p_supertype alias for $4; + p_table_name alias for $5; -- default null + p_id_column alias for $6; -- default null + p_package_name alias for $7; -- default null + p_abstract_p alias for $8; -- default ''f'' + p_type_extension_table alias for $9; -- default null + p_name_method alias for $10; -- default null +begin + return acs_object_type__create_type(p_object_type, p_pretty_name, + p_pretty_plural, p_supertype, p_table_name, + p_id_column, p_package_name, p_abstract_p, + p_type_extension_table, p_name_method,''f'',''f''); +end;' language 'plpgsql'; + +select define_function_args('acs_attribute__create_attribute','object_type,attribute_name,datatype,pretty_name,pretty_plural,table_name,column_name,default_value,min_n_values;1,max_n_values;1,sort_order,storage;type_specific,static_p;f,create_column_p;f,database_type,size,null_p;t,references,check_expr,column_spec'); + +create or replace function acs_attribute__create_attribute (varchar,varchar,varchar,varchar,varchar,varchar,varchar,varchar,integer,integer,integer,varchar,boolean,boolean,varchar,varchar,boolean,varchar,varchar,varchar) +returns integer as ' +declare + p_object_type alias for $1; + p_attribute_name alias for $2; + p_datatype alias for $3; + p_pretty_name alias for $4; + p_pretty_plural alias for $5; -- default null + p_table_name alias for $6; -- default null + p_column_name alias for $7; -- default null + p_default_value alias for $8; -- default null + p_min_n_values alias for $9; -- default 1 + p_max_n_values alias for $10; -- default 1 + p_sort_order alias for $11; -- default null + p_storage alias for $12; -- default ''type_specific'' + p_static_p alias for $13; -- default ''f'' + p_create_column_p alias for $14; + p_database_type alias for $15; + p_size alias for $16; + p_null_p alias for $17; + p_references alias for $18; + p_check_expr alias for $19; + p_column_spec alias for $20; + + v_sort_order acs_attributes.sort_order%TYPE; + v_attribute_id acs_attributes.attribute_id%TYPE; + v_column_spec text; + v_table_name text; + v_constraint_stub text; + v_column_name text; + v_datatype record; + +begin + + if not exists (select 1 + from acs_object_types + where object_type = p_object_type) then + raise exception ''Object type % does not exist'', p_object_type; + end if; + + if p_sort_order is null then + select coalesce(max(sort_order), 1) into v_sort_order + from acs_attributes + where object_type = p_object_type + and attribute_name = p_attribute_name; + else + v_sort_order := p_sort_order; + end if; + + select nextval(''t_acs_attribute_id_seq'') into v_attribute_id; + + insert into acs_attributes + (attribute_id, object_type, table_name, column_name, attribute_name, + pretty_name, pretty_plural, sort_order, datatype, default_value, + min_n_values, max_n_values, storage, static_p) + values + (v_attribute_id, p_object_type, + p_table_name, p_column_name, + p_attribute_name, p_pretty_name, + p_pretty_plural, v_sort_order, + p_datatype, p_default_value, + p_min_n_values, p_max_n_values, + p_storage, p_static_p); + + if p_create_column_p then + + select table_name into v_table_name from acs_object_types + where object_type = p_object_type; + + if not exists (select 1 + from pg_class + where relname = lower(v_table_name)) then + raise exception ''Table % for object type % does not exist'', v_table_name, p_object_type; + end if; + + -- Add the appropriate column to the table + + -- We can only create the table column if + -- 1. the attribute is declared type_specific (generic storage uses an auxillary table) + -- 2. the attribute is not declared static + -- 3. it does not already exist in the table + + if p_storage <> ''type_specific'' then + raise exception ''Attribute % for object type % must be declared with type_specific storage'', + p_attribute_name, p_object_type; + end if; + + if p_static_p then + raise exception ''Attribute % for object type % can not be declared static'', + p_attribute_name, p_object_type; + end if; + + if p_table_name is not null then + raise exception ''Attribute % for object type % can not specify a table for storage'', p_attribute_name, p_object_type; + end if; + + if exists (select 1 + from pg_class c, pg_attribute a + where c.relname::varchar = v_table_name + and c.oid = a.attrelid + and a.attname = lower(p_attribute_name)) then + raise exception ''Column % for object type % already exists'', + p_attribute_name, p_object_type; + end if; + + -- all conditions for creating this column have been met, now let''s see if the type + -- spec is OK + + if p_column_spec is not null then + if p_database_type is not null + or p_size is not null + or p_null_p is not null + or p_references is not null + or p_check_expr is not null then + raise exception ''Attribute % for object type % is being created with an explicit column_spec, but not all of the type modification fields are null'', + p_attribute_name, p_object_type; + end if; + v_column_spec := p_column_spec; + else + select coalesce(p_database_type, database_type) as database_type, + coalesce(p_size, column_size) as column_size, + coalesce(p_check_expr, column_check_expr) as check_expr + into v_datatype + from acs_datatypes + where datatype = p_datatype; + + v_column_spec := v_datatype.database_type; + + if v_datatype.column_size is not null then + v_column_spec := v_column_spec || ''('' || v_datatype.column_size || '')''; + end if; + + v_constraint_stub := '' constraint '' || p_object_type || ''_'' || + p_attribute_name || ''_''; + + if v_datatype.check_expr is not null then + v_column_spec := v_column_spec || v_constraint_stub || ''_ck check('' || + p_attribute_name || v_datatype.check_expr || '')''; + end if; + + if not p_null_p then + v_column_spec := v_column_spec || v_constraint_stub || ''_nn not null''; + end if; + + if p_references is not null then + v_column_spec := v_column_spec || v_constraint_stub || ''fk references '' || + p_references || '' on delete''; + if p_null_p then + v_column_spec := v_column_spec || '' set null''; + else + v_column_spec := v_column_spec || '' delete''; + end if; + end if; + + end if; + + execute ''alter table '' || v_table_name || '' add '' || p_attribute_name || '' '' || + v_column_spec; + + end if; + + return v_attribute_id; + +end;' language 'plpgsql'; + +create or replace function acs_attribute__create_attribute (varchar,varchar,varchar,varchar,varchar,varchar,varchar,varchar,integer,integer,integer,varchar,boolean) +returns integer as ' +declare + p_object_type alias for $1; + p_attribute_name alias for $2; + p_datatype alias for $3; + p_pretty_name alias for $4; + p_pretty_plural alias for $5; -- default null + p_table_name alias for $6; -- default null + p_column_name alias for $7; -- default null + p_default_value alias for $8; -- default null + p_min_n_values alias for $9; -- default 1 + p_max_n_values alias for $10; -- default 1 + p_sort_order alias for $11; -- default null + p_storage alias for $12; -- default ''type_specific'' + p_static_p alias for $13; -- default ''f'' +begin + return acs_attribute__create_attribute(p_object_type, + p_attribute_name, p_datatype, p_pretty_name, + p_pretty_plural, p_table_name, p_column_name, + p_default_value, p_min_n_values, + p_max_n_values, p_sort_order, p_storage, + p_static_p, ''f'', null, null, null, null, null, null); +end;' language 'plpgsql'; + +create or replace function acs_attribute__create_attribute (varchar,varchar,varchar,varchar,varchar,varchar,varchar,integer,integer,integer,integer,varchar,boolean) +returns integer as ' +begin + return acs_attribute__create_attribute ($1, $2, $3, $4, $5, $6, $7, cast ($8 as varchar), $9, $10, $11, $12, $13); +end;' language 'plpgsql'; + +-- "cascade_p" corresponds to the more logical "drop_objects_p" in the content repository +-- code. The name is being kept for backwards compatibilit. + +select define_function_args('acs_object_type__drop_type','object_type,cascade_p;f,drop_table_p;f,drop_children_p;f'); + +-- procedure drop_type +create or replace function acs_object_type__drop_type (varchar,boolean,boolean,boolean) +returns integer as ' +declare + p_object_type alias for $1; + p_drop_children_p alias for $2; + p_drop_table_p alias for $3; + p_cascade_p alias for $4; + row record; + object_row record; + v_table_name acs_object_types.table_name%TYPE; +begin + + -- drop children recursively + if p_drop_children_p then + for row in select object_type + from acs_object_types + where supertype = p_object_type + loop + perform acs_object_type__drop_type(row.object_type, p_cascade_p, p_drop_table_p, ''t''); + end loop; + end if; + + -- drop object rows + if p_cascade_p then + for object_row in select object_id + from acs_objects + where object_type = p_object_type + loop + perform acs_object__delete (object_row.object_id); + end loop; + end if; + + -- drop all the attributes associated with this type + for row in select attribute_name + from acs_attributes + where object_type = p_object_type + loop + perform acs_attribute__drop_attribute (p_object_type, row.attribute_name); + end loop; + + -- Remove the associated table if it exists and p_drop_table_p is true + + if p_drop_table_p then + + select table_name into v_table_name + from acs_object_types + where object_type = p_object_type; + + if found then + if not exists (select 1 + from pg_class + where relname = lower(v_table_name)) then + raise exception ''Table "%" does not exist'', v_table_name; + end if; + + execute ''drop table '' || v_table_name || '' cascade''; + end if; + + end if; + + delete from acs_object_types + where object_type = p_object_type; + + return 0; +end;' language 'plpgsql'; + +-- Retained for backwards compatibility + +create or replace function acs_object_type__drop_type (varchar,boolean) +returns integer as ' +begin + return acs_object_type__drop_type($1,$2,''f'',''f''); +end;' language 'plpgsql'; + +-- procedure drop_attribute +select define_function_args('acs_attribute__drop_attribute','object_type,attribute_name,drop_column_p;f'); + +create or replace function acs_attribute__drop_attribute (varchar,varchar,boolean) +returns integer as ' +declare + p_object_type alias for $1; + p_attribute_name alias for $2; + p_drop_column_p alias for $3; + v_table_name acs_object_types.table_name%TYPE; +begin + + -- Check that attribute exists and simultaneously grab the type''s table name + select t.table_name into v_table_name + from acs_object_types t, acs_attributes a + where a.object_type = p_object_type + and a.attribute_name = p_attribute_name + and t.object_type = p_object_type; + + if not found then + raise exception ''Attribute %:% does not exist'', p_object_type, p_attribute_name; + end if; + + -- first remove possible values for the enumeration + delete from acs_enum_values + where attribute_id in (select a.attribute_id + from acs_attributes a + where a.object_type = p_object_type + and a.attribute_name = p_attribute_name); + + -- Drop the table if one were specified for the type and we''re asked to + if p_drop_column_p and v_table_name is not null then + execute ''alter table '' || v_table_name || '' drop column '' || + p_attribute_name || '' cascade''; + end if; + + -- Finally, get rid of the attribute + delete from acs_attributes + where object_type = p_object_type + and attribute_name = p_attribute_name; + + return 0; +end;' language 'plpgsql'; + +create or replace function acs_attribute__drop_attribute (varchar,varchar) +returns integer as ' +begin + return acs_attribute__drop_attribute($1, $2, ''f''); +end;' language 'plpgsql'; + +select acs_object_type__refresh_view('acs_object'); Index: openacs-4/packages/acs-object-management/sql/postgresql/acs-object-management-create.sql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/sql/postgresql/acs-object-management-create.sql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-object-management/sql/postgresql/acs-object-management-create.sql 28 Jul 2009 23:35:09 -0000 1.1 @@ -0,0 +1,4 @@ +\i acs-kernel-changes-create.sql +\i acs-content-repository-changes-create.sql + +select acs_object_type__refresh_view('acs_object'); Index: openacs-4/packages/acs-object-management/tcl/attribute-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/tcl/attribute-procs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-object-management/tcl/attribute-procs.tcl 28 Jul 2009 23:35:09 -0000 1.1 @@ -0,0 +1,98 @@ +ad_library { + + Procs to help with attributes for object types, supplemantary for now to + mbryzek's original arsdigita code found in acs-subsite. + + @author Don Baccus (dhogaza@pacifierlcom) + @cvs-id $Id: attribute-procs.tcl,v 1.1 2009/07/28 23:35:09 donb Exp $ +} + +namespace eval object_type { + namespace eval attribute {} +} + +ad_proc object_type::attribute::new { + -object_type:required + -attribute_name:required + -datatype:required + -pretty_name:required + {-pretty_plural ""} + {-table_name ""} + {-column_name ""} + {-default_value ""} + {-min_n_values 1} + {-max_n_values 1} + {-sort_order ""} + {-storage type_specific} + {-static_p f} + {-create_column_p f} + {-database_type ""} + {-size ""} + {-null_p ""} + {-references ""} + {-check_expr ""} + {-column_spec ""} +} { +} { + set var_list [list \ + [list object_type $object_type] \ + [list attribute_name $attribute_name] \ + [list datatype $datatype] \ + [list pretty_name $pretty_name] \ + [list pretty_plural $pretty_plural] \ + [list table_name $table_name] \ + [list column_name $column_name] \ + [list default_value $default_value] \ + [list min_n_values $min_n_values] \ + [list max_n_values $max_n_values] \ + [list sort_order $sort_order] \ + [list storage $storage] \ + [list static_p $static_p] \ + [list create_column_p $create_column_p] \ + [list database_type $database_type] \ + [list size $size] \ + [list null_p $null_p] \ + [list references $references] \ + [list check_expr $check_expr] \ + [list column_spec $column_spec]] + package_exec_plsql -var_list $var_list acs_attribute create_attribute + package_exec_plsql -var_list [list [list object_type $object_type]] acs_object_type refresh_view + db_flush_cache -cache_pool acs_metadata -cache_key_pattern ${object_type}::* +} + +ad_proc object_type::attribute::delete { + -object_type:required + -attribute_name:required + {-drop_column_p f} +} { +} { + set var_list [list \ + [list object_type $object_type] \ + [list attribute_name $attribute_name] \ + [list drop_column_p $drop_column_p]] + package_exec_plsql -var_list $var_list acs_attribute drop_attribute + package_exec_plsql -var_list [list [list object_type $object_type]] acs_object_type refresh_view + db_flush_cache -cache_pool acs_metadata -cache_key_pattern ${object_type}::* +} + +ad_proc object_type::attribute::get { + -object_type:required + -attribute_name:required + -array:required +} { +} { + upvar $array local + db_1row -cache_pool acs_metadata -cache_key ${object_type}::attribute::get \ + get {} -column_array local +} + +ad_proc object_type::attribute::get_attribute_id { + -object_type:required + -attribute_name:required + -array:required +} { +} { + upvar $array local + db_1row -cache_pool acs_metadata -cache_key ${object_type}::attribute::get_attribute_id \ + get_attribute_id {} -column_array local +} Index: openacs-4/packages/acs-object-management/tcl/attribute-procs.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/tcl/attribute-procs.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-object-management/tcl/attribute-procs.xql 28 Jul 2009 23:35:09 -0000 1.1 @@ -0,0 +1,22 @@ + + + + + + select attribute_id + from acs_attributes + where object_type = :object_type + and attribute_name = :attribute_name + + + + + + select * + from acs_attributes + where object_type = :object_type + and attribute_name = :attribute_name + + + + Index: openacs-4/packages/acs-object-management/tcl/cache-init.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/tcl/cache-init.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-object-management/tcl/cache-init.tcl 28 Jul 2009 23:35:09 -0000 1.1 @@ -0,0 +1,14 @@ +ad_library { + + Initialization cache for object metadata operations + + @creation-date 30 June 2009 + @author Don Baccus (dhogaza@pacifier.com) + @cvs-id $Id: cache-init.tcl,v 1.1 2009/07/28 23:35:09 donb Exp $ + +} + +ns_cache create acs_metadata -size \ + [parameter::get_from_package_key \ + -package_key acs-object-management \ + -parameter DBCacheSize -default 50000] Index: openacs-4/packages/acs-object-management/tcl/object-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/tcl/object-procs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-object-management/tcl/object-procs.tcl 28 Jul 2009 23:35:09 -0000 1.1 @@ -0,0 +1,217 @@ +ad_library { + + Supporting procs for ACS Objects. + + @author Don Baccus (dhogaza@pacifier.com) + @creation-date July 1, 2009 + @cvs-id $Id: object-procs.tcl,v 1.1 2009/07/28 23:35:09 donb Exp $ + +} + +namespace eval object {} + +ad_proc -private object::split_attributes { + -object_type:required + -attributes_array:required + -type_attributes_array:required + -supertype_attributes_array:required +} { +} { + upvar $attributes_array local_attributes_array + upvar $type_attributes_array local_type_attributes_array + upvar $supertype_attributes_array local_supertype_attributes_array + + set type_attribute_names [object_type::get_attribute_names \ + -object_type $object_type] + foreach attribute_name [array names local_attributes_array] { + if { [lsearch -exact $type_attribute_names $attribute_name] == -1 } { + set local_supertype_attributes_array($attribute_name) \ + $local_attributes_array($attribute_name) + } else { + set local_type_attributes_array($attribute_name) \ + $local_attributes_array($attribute_name) + } + } +} + +# Change this to allow an array name or attributes, with the appropriate error. + +ad_proc -private object::new_inner { + -object_type:required + -object_id:required + -attributes:required +} { + array set attributes_array $attributes + object_type::get -object_type $object_type -array object_type_info + set id_column $object_type_info(id_column) + + object::split_attributes \ + -object_type $object_type \ + -attributes_array attributes_array \ + -type_attributes_array our_attributes \ + -supertype_attributes_array supertype_attributes + + # If this conditional looks weird to you, it's because the supertype of acs_object is + # acs_object, not null (boo, hiss, aD!) + + if { $object_type_info(supertype) ne $object_type } { + set object_id \ + [object::new_inner \ + -object_type $object_type_info(supertype) \ + -object_id $object_id \ + -attributes [array get supertype_attributes]] + } else { + if { $object_id eq "" } { + set object_id [db_nextval acs_object_id_seq] + } + if { [llength [array name subtype_attributes]] > 0 } { + # error ... + } + } + + if { $object_type_info(table_name) ne "" } { + + set our_attributes($id_column) $object_id + foreach name [array names our_attributes] { + lappend name_list $name + set __$name $our_attributes($name) + lappend value_name_list :__$name + } + + db_dml insert_object {} + + } else { + # error for now as we don't handle generics etc + } + + return $object_id +} + +ad_proc object::new { + {-object_type acs_object} + {-object_id ""} + {-attributes ""} +} { +} { + array set attributes_array $attributes + + set attributes_array(object_type) $object_type + + if { [ad_conn isconnected] } { + if { ![exists_and_not_null attributes_array(creation_user)] } { + set attributes_array(creation_user) [ad_conn user_id] + } + if { ![exists_and_not_null attributes_array(creation_ip)] } { + set attributes_array(creation_ip) [ad_conn peeraddr] + } + } + + db_transaction { + set object_id [object::new_inner \ + -object_type $object_type \ + -object_id $object_id \ + -attributes [array get attributes_array]] + } + return $object_id +} + +ad_proc object::delete { + -object_id:required +} { +} { + package_exec_plsql -var_list [list [list object_id $object_id]] acs_object delete +} + +ad_proc object::get_object_type { + -object_id:required +} { +} { + return [db_string get_object_type {}] +} + +ad_proc object::get { + -object_id:required + {-view ""} + -array:required +} { +} { + upvar $array local_array + if { $view eq "" } { + set view [object_type::get_root_view \ + -object_type [object::get_object_type -object_id $object_id]] + } + db_1row get {} -column_array local_array +} + +ad_proc object::update_inner { + -object_id:required + -object_type:required + -attributes:required +} { +} { + array set attributes_array $attributes + object_type::get -object_type $object_type -array object_type_info + set id_column $object_type_info(id_column) + + object::split_attributes \ + -object_type $object_type \ + -attributes_array attributes_array \ + -type_attributes_array our_attributes \ + -supertype_attributes_array supertype_attributes + + # If this conditional looks weird to you, it's because the supertype of acs_object is + # acs_object, not null (boo, hiss, aD!) + + if { $object_type_info(supertype) ne $object_type } { + object::update_inner \ + -object_type $object_type_info(supertype) \ + -object_id $object_id \ + -attributes [array get supertype_attributes] + } else { + if { [llength [array name subtype_attributes]] > 0 } { + # error ... + } + } + + if { $object_type_info(table_name) ne "" } { + + foreach name [array names our_attributes] { + set __$name $our_attributes($name) + lappend name_value_list "$name = :__$name" + } + + if { [llength $name_value_list] > 0 } { + db_dml update_object {} + } + + } else { + # error for now as we don't handle generics etc + } + +} + +ad_proc object::update { + -object_id:required + -attributes:required +} { +} { + array set attributes_array $attributes + + if { [ad_conn isconnected] } { + if { ![exists_and_not_null attributes_array(modifying_user)] } { + set attributes_array(modifying_user) [ad_conn user_id] + } + if { ![exists_and_not_null attributes_array(modifying_ip)] } { + set attributes_array(modifying_ip) [ad_conn peeraddr] + } + } + + set object_type [object::get_object_type -object_id $object_id] + + db_transaction { + object::update_inner \ + -object_id $object_id \ + -object_type $object_type \ + -attributes [array get attributes_array] + } +} Index: openacs-4/packages/acs-object-management/tcl/object-procs.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/tcl/object-procs.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-object-management/tcl/object-procs.xql 28 Jul 2009 23:35:09 -0000 1.1 @@ -0,0 +1,37 @@ + + + + + + insert into $object_type_info(table_name) + ([join $name_list ,]) + values + ([join $value_name_list ,]) + + + + + + update $object_type_info(table_name) + set [join $name_value_list ,] + where $id_column = :object_id + + + + + + select object_type + from acs_objects + where object_id = :object_id + + + + + + select * + from $view + where object_id = :object_id + + + + Index: openacs-4/packages/acs-object-management/tcl/object-type-procs-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/tcl/object-type-procs-oracle.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-object-management/tcl/object-type-procs-oracle.xql 28 Jul 2009 23:35:09 -0000 1.1 @@ -0,0 +1,15 @@ + + + oracle8.1.6 + + + select object_type + from object_types + start with object_type = :subtype + connect by prior supertype = object_type + where object_type != :substype + order by level desc + + + + Index: openacs-4/packages/acs-object-management/tcl/object-type-procs-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/tcl/object-type-procs-postgresql.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-object-management/tcl/object-type-procs-postgresql.xql 28 Jul 2009 23:35:09 -0000 1.1 @@ -0,0 +1,15 @@ + + + postgresql7.1 + + + + select o2.object_type + from acs_object_types o1, acs_object_types o2 + where o1.object_type = :subtype + and o1.tree_sortkey between tree_left(o2.tree_sortkey) and tree_right(o2.tree_sortkey) + order by tree_level(o2.tree_sortkey) desc + + + + Index: openacs-4/packages/acs-object-management/tcl/object-type-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/tcl/object-type-procs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-object-management/tcl/object-type-procs.tcl 28 Jul 2009 23:35:09 -0000 1.1 @@ -0,0 +1,167 @@ +ad_library { + + Supporting procs for ACS Object Types + + @author Yonatan Feldman (yon@arsdigita.com) + @creation-date August 13, 2000 + @cvs-id $Id: object-type-procs.tcl,v 1.1 2009/07/28 23:35:09 donb Exp $ + +} + +namespace eval object_type {} + +ad_proc -public object_type::new { + -object_type:required + -pretty_name:required + -pretty_plural:required + {-supertype acs_object} + {-table_name ""} + {-package_name ""} + {-abstract_p f} + {-type_extension_table ""} + {-name_method ""} + {-create_table_p f} + {-dynamic_p t} + -attributes +} { +} { + set var_list [list \ + [list object_type $object_type] \ + [list pretty_name $pretty_name] \ + [list pretty_plural $pretty_plural] \ + [list supertype $supertype] \ + [list table_name $table_name] \ + [list package_name $package_name] \ + [list abstract_p $abstract_p] \ + [list type_extension_table $type_extension_table] \ + [list name_method $name_method] \ + [list create_table_p $create_table_p] \ + [list dynamic_p $dynamic_p]] + + db_transaction { + package_exec_plsql -var_list $var_list acs_object_type create_type + + if { [info exists attributes] } { + foreach {name attr_info} $attributes { + set params [list -object_type $object_type -attribute_name $name] + if { $create_table_p } { + lappend params -create_column_p + lappend params t + } + foreach {param value} $attr_info { + lappend params -$param + lappend params $value + } + } + eval [concat object_type::attribute::new $params] + } + package_exec_plsql \ + -var_list [list [list object_type $object_type]] acs_object_type refresh_view + } +} + +ad_proc -public object_type::delete { + -object_type:required + {-cascade_p t} + {-drop_table_p f} + {-drop_children_p f} +} { + set var_list [list \ + [list object_type $object_type] \ + [list cascade_p $cascade_p] \ + [list drop_table_p $drop_table_p] \ + [list drop_children_p $drop_children_p]] + package_exec_plsql -var_list $var_list acs_object_type drop_type + db_flush_cache -cache_pool acs_metadata -cache_key_pattern ${object_type}::* +} + +ad_proc -public object_type::get { + -object_type:required + -array:required +} { + Get info about an object type. Returns columns + + +} { + upvar 1 $array row + db_1row -cache_pool acs_metadata -cache_key ${object_type}::get \ + select_object_type_info {} -column_array row +} + +ad_proc -public object_type::get_element { + -object_type:required + -element:required +} { +} { + object_type::get -object_type $object_type -array object_type_info + return $object_type_info($element) +} + +ad_proc object_type::get_root_view { + -object_type:required +} { +} { + return [db_string -cache_pool acs_metadata -cache_key ${object_type}::get_root_view \ + select_root_view {}] +} + +ad_proc -private object_type::acs_object_instance_of { + {-object_id:required} + {-type:required} +} { + Returns true if the specified object_id is a subtype of the specified type. + This is an inclusive check. + + @author Lee Denison (lee@thaum.net) +} { + acs_object::get -object_id $object_id -array obj + + return [object_type::supertype \ + -supertype $type \ + -subtype $obj(object_type)] +} + +ad_proc -private object_type::supertype { + {-supertype:required} + {-subtype:required} +} { + Returns true if subtype is equal to, or a subtype of, supertype. + + @author Lee Denison (lee@thaum.net) +} { + set supertypes [object_type::supertypes] + append supertypes $subtype + + return [expr {[lsearch $supertypes $supertype] >= 0}] +} + +ad_proc -private object_type::supertypes { + {-subtype:required} +} { + Returns a list of the supertypes of subtypes. + + @author Lee Denison (lee@thaum.net) +} { + return [db_list -cache_pool acs_metadata -cache_key ${subtype}::supertypes supertypes {}] +} + +ad_proc object_type::get_attribute_names { + -object_type:required +} { + Return a list of attribute names declared for the given object type. +} { + return [db_list -cache_pool acs_metadata -cache_key ${object_type}::attribute_names \ + select_attribute_names {}] +} Index: openacs-4/packages/acs-object-management/tcl/object-type-procs.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/tcl/object-type-procs.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-object-management/tcl/object-type-procs.xql 28 Jul 2009 23:35:09 -0000 1.1 @@ -0,0 +1,31 @@ + + + + + + select object_type, supertype, abstract_p, pretty_name, + pretty_plural, table_name, id_column, package_name, name_method, + type_extension_table, dynamic_p + from acs_object_types + where object_type = :object_type + + + + + + select attribute_name + from acs_attributes + where object_type = :object_type + + + + + + select object_view + from acs_object_views + where object_type = :object_type + and root_view_p + + + + Index: openacs-4/packages/acs-object-management/tcl/object-view-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/tcl/object-view-procs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-object-management/tcl/object-view-procs.tcl 28 Jul 2009 23:35:09 -0000 1.1 @@ -0,0 +1,20 @@ +ad_library { + + Supporting procs for ACS Object Types + + @author Yonatan Feldman (yon@arsdigita.com) + @creation-date August 13, 2000 + @cvs-id $Id: object-view-procs.tcl,v 1.1 2009/07/28 23:35:09 donb Exp $ + +} + +namespace eval object_type::view {} + +ad_proc -public object_type::view::new { + -object_type:required + -object_view:required + -pretty_name:required +} { +} { + db_dml insert_object_view {} +} Index: openacs-4/packages/acs-object-management/tcl/object-view-procs.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/tcl/object-view-procs.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-object-management/tcl/object-view-procs.xql 28 Jul 2009 23:35:09 -0000 1.1 @@ -0,0 +1,13 @@ + + + + + + insert into acs_object_views + (object_view, object_type, pretty_name, root_view_p) + values + (:object_view, :object_type, :pretty_name, 'f') + + + + Index: openacs-4/packages/acs-object-management/tcl/test/object-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/tcl/test/object-procs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-object-management/tcl/test/object-procs.tcl 28 Jul 2009 23:35:09 -0000 1.1 @@ -0,0 +1,37 @@ +ad_library { + Automated tests for the acs-object Tcl API. + + @author Don Baccus (dhogaza@pacifier.com) +} + +aa_register_case -cats {api db smoke} object { + +} { + set object_id [object::new] + aa_log_result pass "Object create" + object::delete -object_id $object_id + aa_log_result pass "Object delete" + + set object_id [db_nextval acs_object_id_seq] + aa_equals "Pre-allocated object_id" $object_id [object::new -object_id $object_id] + object::delete -object_id $object_id + aa_log_result pass "Object delete" + + set attributes(email) foo@bar.com + set attributes(url) "http://url.url" + set attributes(first_names) foo + set attributes(last_name) bar + set object_id [object::new -object_type person -attributes [array get attributes]] + aa_log_result pass "Person create" + + set attributes(first_names) "foo fu" + object::update -object_id $object_id -attributes [array get attributes] + object::get -object_id $object_id -array check_attributes + aa_log_result pass "Person update" + aa_equals "Check update first_names value" $check_attributes(first_names) "foo fu" + aa_equals "Check update email value" $check_attributes(email) foo@bar.com + + object::delete -object_id $object_id + aa_log_result pass "Person delete" + +} Index: openacs-4/packages/acs-object-management/tcl/test/object-types-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/tcl/test/object-types-procs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-object-management/tcl/test/object-types-procs.tcl 28 Jul 2009 23:35:09 -0000 1.1 @@ -0,0 +1,114 @@ +ad_library { + Automated tests for the acs-object-types Tcl API. + + @author Don Baccus (dhogaza@pacifier.com) +} + +aa_register_case -cats {api db smoke} object_type { + +} { + + if { [catch {object_type::new \ + -object_type object_type_test \ + -pretty_name "Object Type" \ + -pretty_plural "Object Types" \ + -create_table_p t \ + -attributes {i {datatype integer pretty_name i}}} error] } { + aa_log_result fail "Attempt to create type \"object_type_test\" failed: $error" + } else { + aa_log_result pass "Created type \"object_type_test\"" + } + + if { [catch {object_type::attribute::delete \ + -object_type object_type_test \ + -attribute_name i \ + -drop_column_p t} error] } { + aa_log_result fail "Attempt to delete attribute \"i\" of \"object_type_test\" failed: $error" + } else { + aa_log_result pass "Deleted attribute \"i\" of \"object_type_test\"" + } + + if { [catch {object_type::attribute::delete \ + -object_type object_type_test \ + -attribute_name xxx \ + -drop_column_p t} error] } { + aa_log_result pass "Attempt to delete non-existent attribute \"xxx\" of \"object_type_test\" failed: $error" + } else { + aa_log_result fail "Deleted non-existent attribute \"xxx\" of \"object_type_test\"" + } + + if { [catch {object_type::delete \ + -object_type object_type_test \ + -drop_table_p t \ + -cascade_p t \ + -drop_children_p t} error] } { + aa_log_result fail "Attempt to delete type \"object_type_test\" failed: $error" + } else { + aa_log_result pass "Deleted type \"object_type_test\"" + } + + if { [catch {object_type::new \ + -object_type object_type_test2 \ + -pretty_name "Object Type 2" \ + -pretty_plural "Object Types 2" \ + -create_table_p t \ + -attributes {i {datatype integer \ + pretty_name i \ + references acs_objects \ + null_p t}}} error] } { + aa_log_result fail "Attempt to create type \"object_type_test2\" failed: $error" + } else { + aa_log_result pass "Created type \"object_type_test2\"" + } + + if { [catch {object_type::delete \ + -object_type object_type_test2 \ + -drop_table_p t \ + -cascade_p t \ + -drop_children_p t} error] } { + aa_log_result fail "Attempt to delete type \"object_type_test2\" failed: $error" + } else { + aa_log_result pass "Deleted type \"object_type_test2\"" + } + + if { [catch {object_type::new \ + -object_type object_type_test3 \ + -pretty_name "Object Type 3" \ + -pretty_plural "Object Types 3" \ + -create_table_p t } error] } { + aa_log_result fail "Attempt to create type \"object_type_test3\" failed: $error" + } else { + aa_log_result pass "Created type \"object_type_test3\"" + } + + if { [catch {object_type::delete \ + -object_type object_type_test3 \ + -drop_table_p t \ + -cascade_p t \ + -drop_children_p t} error] } { + aa_log_result fail "Attempt to delete type \"object_type_test3\" failed: $error" + } else { + aa_log_result pass "Deleted type \"object_type_test3\"" + } + + if { [catch {object_type::new \ + -object_type object_type_test4 \ + -pretty_name "Object Type 4" \ + -pretty_plural "Object Types 4" \ + -table_name acs_objects } error] } { + aa_log_result pass "Attempt to create type \"object_type_test4\" with table \"acs_objects\" failed: $error" + } else { + aa_log_result fail "Created type \"object_type_test4\" with table \"acs_objects\"" + } + + if { [catch {object_type::new \ + -object_type object_type_test5 \ + -pretty_name "Object Type 5" \ + -pretty_plural "Object Types 5" \ + -table_name acs_object_types \ + -create_table_p t } error] } { + aa_log_result pass "Attempt to create type \"object_type_test5\" creating table \"acs_object_types\" failed: $error" + } else { + aa_log_result fail "Created type \"object_type_test5\" creating table \"acs_object_types\"" + } +} Index: openacs-4/packages/acs-object-management/www/admin/attribute-delete-confirm.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/www/admin/Attic/attribute-delete-confirm.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-object-management/www/admin/attribute-delete-confirm.adp 28 Jul 2009 23:35:09 -0000 1.1 @@ -0,0 +1,5 @@ + + Attribute Delete Confirmation + +Really delete attribute "@attribute_name@"? +

Index: openacs-4/packages/acs-object-management/www/admin/attribute-delete-confirm.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/www/admin/Attic/attribute-delete-confirm.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-object-management/www/admin/attribute-delete-confirm.tcl 28 Jul 2009 23:35:09 -0000 1.1 @@ -0,0 +1 @@ +ns_log Notice "Huh? here I am!" Index: openacs-4/packages/acs-object-management/www/admin/attribute-delete.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/www/admin/attribute-delete.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-object-management/www/admin/attribute-delete.adp 28 Jul 2009 23:35:09 -0000 1.1 @@ -0,0 +1,7 @@ + + +

+ +Really delete attribute "@attribute.attribute_name@"? + + Index: openacs-4/packages/acs-object-management/www/admin/attribute-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/www/admin/attribute-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-object-management/www/admin/attribute-delete.tcl 28 Jul 2009 23:35:09 -0000 1.1 @@ -0,0 +1,21 @@ +ad_page_contract { + +} { + object_type:sql_identifier,notnull + attribute_name:sql_identifier,notnull +} + +object_type::attribute::get \ + -object_type $object_type \ + -attribute_name $attribute_name \ + -array attribute + +ad_form -name delete -export {object_type attribute_name} -form { +} -on_submit { + object_type::attribute::delete \ + -attribute_name $attribute_name \ + -object_type $object_type \ + -drop_column_p t + ad_returnredirect ./[export_vars -base dtype {object_type}] + ad_script_abort +} Index: openacs-4/packages/acs-object-management/www/admin/attribute-move.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/www/admin/Attic/attribute-move.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-object-management/www/admin/attribute-move.tcl 28 Jul 2009 23:35:09 -0000 1.1 @@ -0,0 +1,51 @@ +ad_page_contract { + Change attribute sort order +} { + attribute_id:integer,notnull + object_type + sort_order + direction:notnull + {return_url ""} +} + +set user_id [auth::require_login] + +permission::require_permission \ + -object_id [ad_conn package_id] \ + -party_id $user_id \ + -privilege admin + +if { $direction=="up" } { + set next_sort_order [expr { $sort_order - 1 }] +} else { + set next_sort_order [expr { $sort_order + 1 }] +} + +db_transaction { + db_dml swap_sort_orders " +update acs_attributes +set sort_order = (case when sort_order = (cast (:sort_order as integer)) then + cast (:next_sort_order as integer) + when +sort_order = (cast (:next_sort_order as integer)) then cast (:sort_order as integer) end) +where object_type = :object_type and sort_order in (:sort_order, :next_sort_order) +" + set function "dtype::form::metadata::\[^ \]*_list -no_cache" + util_memoize_flush_regexp "$function -object_type \"$object_type\".*" + +} on_error { + + ad_return_error "Database error" "A database error occured while trying +to swap your questions. Here's the error: +

+$errmsg
+
+" + ad_script_abort +} + +if {$return_url eq ""} { + set return_url [export_vars -base dtype {object_type}] +} + +ad_returnredirect $return_url \ No newline at end of file Index: openacs-4/packages/acs-object-management/www/admin/attribute.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/www/admin/attribute.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-object-management/www/admin/attribute.adp 28 Jul 2009 23:35:09 -0000 1.1 @@ -0,0 +1,5 @@ + +@page_title@ +@context@ + + Index: openacs-4/packages/acs-object-management/www/admin/attribute.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/www/admin/attribute.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-object-management/www/admin/attribute.tcl 28 Jul 2009 23:35:09 -0000 1.1 @@ -0,0 +1,94 @@ +ad_page_contract { + + @author Don Baccus + @creation-date 2009-07-22 + @cvs-id $Id: attribute.tcl,v 1.1 2009/07/28 23:35:09 donb Exp $ + +} { + {attribute_id:optional} + {object_type:notnull,sql_identifier} +} + +object_type::get -object_type $object_type -array type_info + +if {[info exists attribute_id]} { + set page_title "[_ acs-object-management.attribute_edit]" +} else { + set page_title "[_ acs-object-management.attribute_add]" +} + +set context [list [list [export_vars -base dtype {object_type}] $type_info(pretty_name)] $page_title] +set table_name $type_info(table_name) +set datatype_options [db_list_of_lists get_datatypes {}] + +ad_form -name attribute_form -export {object_type} -form { + {attribute_id:key} + {attribute_name:text {label "[_ acs-object-management.attribute_name]"} {html {size 30 maxlength 100}} {help_text "[_ acs-object-management.attribute_name_help]"}} + {pretty_name:text,optional {label "[_ acs-object-management.pretty_name]"} {html {size 30 maxlength 100}} {help_text "[_ acs-object-management.attribute_pname_help]"}} + {pretty_plural:text,optional {label "[_ acs-object-management.pretty_plural]"} {html {size 30 maxlength 100}} {help_text "[_ acs-object-management.attribute_pplural_help]"}} +} + +if {![ad_form_new_p -key attribute_id]} { + ad_form -extend -name attribute_form -form { + {datatype:text(inform) {label "[_ acs-object-management.datatype]"} {options $datatype_options} {help_text "[_ acs-object-management.datatype_help]"}} + } +} else { + ad_form -extend -name attribute_form -form { + {datatype:text(select) {label "[_ acs-object-management.datatype]"} {options $datatype_options} {help_text "[_ acs-object-management.datatype_help]"}} + } +} + +ad_form -extend -name attribute_form -form { + {default_value:text(textarea),optional {label "[_ acs-object-management.attribute_default]"} {html {rows 3 cols 40}} {help_text "[_ acs-object-management.attribute_default_help]"}} +} -new_request { + set attribute_name "" + set pretty_name "" + set pretty_plural "" + set datatype string + set default_value "" +} -validate { + {attribute_name + {([lsearch [db_list get_attributes {}] [string tolower $attribute_name]] == -1) || + ([string tolower $attribute_name] eq [db_string get_current_name {}])} + "An attribute with the same name already exists. Attribute name must be unique"} +} -edit_request { + db_1row attribute_data {} +} -on_submit { + if {[empty_string_p $pretty_name]} { + foreach word [split $attribute_name] { + lappend pretty_name [string totitle $word] + } + set pretty_name [join $pretty_name] + } + set default_locale [lang::system::site_wide_locale] +} -new_data { + object_type::attribute::new \ + -attribute_name [string tolower $attribute_name] \ + -object_type $object_type \ + -datatype $datatype \ + -pretty_name $pretty_name \ + -pretty_plural $pretty_plural \ + -default_value $default_value \ + -create_column_p t +} -edit_data { +# Oh need to add an update function to the tcl API + dtype::edit_attribute \ + -name [string tolower $attribute_name] \ + -object_type $object_type \ + -pretty_name $pretty_name \ + -pretty_plural $pretty_plural \ + -default_value $default_value +} -after_submit { + lang::message::register -update_sync $default_locale acs-translations "${object_type}_$attribute_name" $pretty_name + lang::message::register -update_sync $default_locale acs-translations "${object_type}_${attribute_name}s" $pretty_plural + + util_memoize_flush "dtype::form::metadata::widgets_list -no_cache -object_type \"$object_type\" -dform \"implicit\" -exclude_static_p 0" + util_memoize_flush "dtype::form::metadata::widgets_list -no_cache -object_type \"$object_type\" -dform \"implicit\" -exclude_static_p 1" + + util_memoize_flush_regexp "dtype::form::metadata::params_list -no_cache -object_type \"$object_type\".*" + + ad_returnredirect [export_vars -base dtype {object_type}] + ad_script_abort +} + +ad_return_template Index: openacs-4/packages/acs-object-management/www/admin/attribute.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/www/admin/attribute.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-object-management/www/admin/attribute.xql 28 Jul 2009 23:35:09 -0000 1.1 @@ -0,0 +1,37 @@ + + + + + + + select datatype, datatype + from acs_datatypes + order by datatype + + + + + + select attribute_name + from acs_attributes + where object_type = :object_type + + + + + + select attribute_name + from acs_attributes + where attribute_id = :attribute_id + + + + + + select attribute_name, pretty_name, pretty_plural, datatype, default_value + from acs_attributes + where attribute_id = :attribute_id + + + + Index: openacs-4/packages/acs-object-management/www/admin/dtype-add.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/www/admin/Attic/dtype-add.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-object-management/www/admin/dtype-add.adp 28 Jul 2009 23:35:09 -0000 1.1 @@ -0,0 +1,5 @@ + +@page_title@ +@context@ + + Index: openacs-4/packages/acs-object-management/www/admin/dtype-add.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/www/admin/Attic/dtype-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-object-management/www/admin/dtype-add.tcl 28 Jul 2009 23:35:09 -0000 1.1 @@ -0,0 +1,44 @@ +ad_page_contract { + + @author Vinod Kurup (vinod@kurup.com) + @author Don Baccus (dhogaza@pacifier.com) + @creation-date 2009-07-20 + + Modified from dynamic types. +} { +} + +set page_title [_ acs-object-management.create_type] +set context [list $page_title] + +ad_form -name dtype-add -form { + {object_type:keyword + {label {[_ acs-object-management.object_type]}} + {html {size 30 maxlength 100}} + } + {supertype:keyword + {label {[_ acs-object-management.supertype]}} + {html {size 30 maxlength 100}} + } + {pretty_name:text + {label {[_ acs-object-management.pretty_name]}} + {html {size 30 maxlength 100}} + } + {pretty_plural:text + {label {[_ acs-object-management.pretty_plural]}} + {html {size 30 maxlength 100}} + } +} -on_request { + set supertype acs_object +} -on_submit { + object_type::new \ + -object_type $object_type \ + -supertype $supertype \ + -pretty_name $pretty_name \ + -pretty_plural $pretty_plural \ + -create_table_p t +} -after_submit { + ad_returnredirect ./ + ad_script_abort +} + Index: openacs-4/packages/acs-object-management/www/admin/dtype-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/www/admin/Attic/dtype-postgresql.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-object-management/www/admin/dtype-postgresql.xql 28 Jul 2009 23:35:09 -0000 1.1 @@ -0,0 +1,20 @@ + + + + + + + select a.attribute_id, a.attribute_name, a.pretty_name, a.pretty_plural, + a.datatype, a.object_type as attribute_object_type + from acs_attributes a, acs_object_types t + where t.object_type in (select ot1.object_type + from acs_object_types ot1, acs_object_types ot2 + where ot2.tree_sortkey between + tree_left(ot1.tree_sortkey) and tree_right(ot1.tree_sortkey) + and ot2.object_type = :object_type) + and a.object_type = t.object_type + order by t.tree_sortkey desc, a.sort_order asc; + + + + Index: openacs-4/packages/acs-object-management/www/admin/dtype.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/www/admin/Attic/dtype.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-object-management/www/admin/dtype.adp 28 Jul 2009 23:35:09 -0000 1.1 @@ -0,0 +1,12 @@ + +@page_title@ +@context@ + +

#acs-object-management.attributes#

+

#acs-object-management.object_type#: @type_info.pretty_name@

+ +

#acs-object-management.inherited_attributes#

+ +

#acs-object-management.views#

+ + Index: openacs-4/packages/acs-object-management/www/admin/dtype.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/www/admin/Attic/dtype.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-object-management/www/admin/dtype.tcl 28 Jul 2009 23:35:09 -0000 1.1 @@ -0,0 +1,118 @@ +ad_page_contract { + + @author Timo Hentschel (timo@timohentschel.de) + @creation-date 2005-05-02 + @cvs-id $Id: dtype.tcl,v 1.1 2009/07/28 23:35:09 donb Exp $ + +} { + {object_type:notnull,sql_identifier} +} + +object_type::get -object_type $object_type -array type_info + +set page_title $type_info(pretty_name) +set context [list [list . "Dynamic Types"] $page_title] + +list::create \ + -name attributes \ + -multirow attributes \ + -key attribute_id \ + -pass_properties { + object_type + } -actions [list "[_ acs-object-management.add_attribute]" [export_vars -base attribute {object_type}] "[_ acs-object-management.add_attribute]"] \ + -elements { + pretty_name { + label "[_ acs-object-management.pretty_name]" + link_url_eval $attribute_url + } + attribute_name { + label "[_ acs-object-management.attribute]" + } + datatype { + label "[_ acs-object-management.datatype]" + } + delete { + label "[_ acs-object-management.Delete]" + display_template " + + [_ acs-object-management.delete] + " + } + } -filters { + object_type {} + } + +db_multirow -cache_pool acs_metadata -cache_key ${object_type}::get_attributes \ + -extend { attribute_url delete_url } attributes get_attributes {} { + set attribute_url [export_vars -base attribute {attribute_id object_type}] + set delete_url [export_vars -base attribute-delete {object_type attribute_name}] +} + +list::create \ + -name inherited_attributes \ + -multirow inherited_attributes \ + -key attribute_id \ + -elements { + pretty_name { + label "[_ acs-object-management.pretty_name]" + } + attribute_name { + label "[_ acs-object-management.attribute]" + } + attribute_object_type { + label "[_ acs-object-management.object_type]" + } + datatype { + label "[_ acs-object-management.datatype]" + } + } -filters { + object_type {} + } + +db_multirow -cache_pool acs_metadata -cache_key ${object_type}::get_inherited_attributes \ + inherited_attributes get_inherited_attributes {} + +list::create \ + -name views \ + -multirow views \ + -key object_view \ + -actions [list "[_ acs-object-management.add_view]" [export_vars -base view-add {object_type}] "[_ acs-object-management.add_view]"] \ + -elements { + pretty_name { + label "[_ acs-object-management.pretty_name]" + display_template " + + @views.pretty_name@ + + + @views.pretty_name@ + + " + } + object_view { + label "[_ acs-object-management.view]" + } + delete { + label "[_ acs-object-management.Delete]" + display_template " + + + [_ acs-object-management.delete] + + " + } + } -filters { + object_type {} + } + +db_multirow -cache_pool acs_metadata -cache_key ${object_type}::get_views \ + -extend { view_url delete_url } views get_views {} { + set delete_url [export_vars -base view-delete { object_view }] + set view_url [export_vars -base view { object_view }] +ns_log Notice "Huh? view_url: $view_url delete_url: $delete_url" +} + +set add_form_url [export_vars -base form-ae {object_type}] +set return_url [ad_return_url] +ad_return_template Index: openacs-4/packages/acs-object-management/www/admin/dtype.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/www/admin/Attic/dtype.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-object-management/www/admin/dtype.xql 28 Jul 2009 23:35:09 -0000 1.1 @@ -0,0 +1,23 @@ + + + + + + + select a.attribute_id, a.attribute_name, a.pretty_name, a.pretty_plural, + a.datatype + from acs_attributes a + where a.object_type = :object_type + order by a.sort_order asc; + + + + + + select object_view, pretty_name, root_view_p + from acs_object_views + where object_type = :object_type + + + + Index: openacs-4/packages/acs-object-management/www/admin/index.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/www/admin/index.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-object-management/www/admin/index.adp 28 Jul 2009 23:35:09 -0000 1.1 @@ -0,0 +1,5 @@ + +@page_title@ +@context@ + + Index: openacs-4/packages/acs-object-management/www/admin/index.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/www/admin/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-object-management/www/admin/index.tcl 28 Jul 2009 23:35:09 -0000 1.1 @@ -0,0 +1,45 @@ +ad_page_contract { + + @author Timo Hentschel (timo@timohentschel.de) + @author Don Baccus (dhogaza@pacifeir.com) + @creation-date 2005-05-02 + @cvs-id $Id: index.tcl,v 1.1 2009/07/28 23:35:09 donb Exp $ + + This is a derivative of the dynamic types package. +} { + {orderby "pretty_name,asc"} +} + +set page_title "[_ acs-object-management.dynamic_types]" +set context [list $page_title] + +list::create \ + -name dtypes \ + -multirow dtypes \ + -key object_type \ + -actions [list "[_ acs-object-management.add_type]" [export_vars -base dtype-add] "[_ acs-object-management.add_type]"] \ + -row_pretty_plural "[_ acs-object-management.dynamic_types]" \ + -bulk_actions [list "[_ acs-object-management.export]" dtypes-code "[_ acs-object-management.code_export]"] \ + -elements { + pretty_name { + label "[_ acs-object-management.pretty_name]" + link_url_eval $dtype_url + orderby "lower(pretty_name)" + } + object_type { + label "[_ acs-object-management.object_type]" + orderby "object_type" + } + delete { + label "Delete" + display_template "delete" + } + + } + +set orderby_clause [list::orderby_clause -orderby -name dtypes] + +db_multirow -extend { dtype_url delete_url } dtypes select_dtypes {} { + set dtype_url [export_vars -base dtype {object_type}] + set delete_url [export_vars -base dtype-delete {object_type}] +} Index: openacs-4/packages/acs-object-management/www/admin/index.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/www/admin/index.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-object-management/www/admin/index.xql 28 Jul 2009 23:35:09 -0000 1.1 @@ -0,0 +1,16 @@ + + + + + + + + select object_type, pretty_name + from acs_object_types + where dynamic_p = 't' + $orderby_clause + + + + + Index: openacs-4/packages/acs-object-management/www/admin/view-add.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/www/admin/view-add.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-object-management/www/admin/view-add.adp 28 Jul 2009 23:35:09 -0000 1.1 @@ -0,0 +1,5 @@ + +@page_title@ +@context@ + + Index: openacs-4/packages/acs-object-management/www/admin/view-add.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-object-management/www/admin/view-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-object-management/www/admin/view-add.tcl 28 Jul 2009 23:35:09 -0000 1.1 @@ -0,0 +1,31 @@ +ad_page_contract { + + @author Don Baccus (dhogaza@pacifier.com) + @creation-date 2009-07-25 + +} { + object_type:sql_identifier,notnull +} + +set page_title [_ acs-object-management.create_view] +set context [list $page_title] + +ad_form -name view-add -export {object_type} -form { + {object_view:keyword + {label {[_ acs-object-management.object_view]}} + {html {size 30 maxlength 100}} + } + {pretty_name:text + {label {[_ acs-object-management.pretty_name]}} + {html {size 30 maxlength 100}} + } +} -on_submit { + object_type::view::new \ + -object_type $object_type \ + -object_view $object_view \ + -pretty_name $pretty_name +} -after_submit { + ad_returnredirect ./[export_vars -base dtype {object_type}] + ad_script_abort +} +