Index: openacs-4/packages/ims-ent/ims-ent.info =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/ims-ent/ims-ent.info,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/ims-ent/ims-ent.info 9 Jun 2004 18:10:48 -0000 1.1 @@ -0,0 +1,29 @@ + + + + + IMS Enterprise Spec v. 1.1 + + f + t + ims-ent + + + Rocael Hernandez Rizzardini + Implementing the IMS Enterprise Specification version 1.1, designed to work with .LRN (ver. 2.x right now) + Galileo University + + + + + + + + + + + + + + + Index: openacs-4/packages/ims-ent/sql/postgresql/ims-ent-create.sql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/ims-ent/sql/postgresql/ims-ent-create.sql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/ims-ent/sql/postgresql/ims-ent-create.sql 9 Jun 2004 18:08:07 -0000 1.1 @@ -0,0 +1,26 @@ +-- +-- +-- +-- @author Rocael Hernandez Rizzardini (roc@viaro.net) +-- @creation-date 2004-04-06 +-- @arch-tag: A4D2DD30-8839-11D8-9819-000A95ABB5AA +-- @cvs-id $Id: ims-ent-create.sql,v 1.1 2004/06/09 18:08:07 rocaelh Exp $ +-- +-- we'll use this to identify the relation with a given community_id (class) +-- and the that comes in for a give class + +create table ims_ent_dotlrn_class_map ( + class_instance_key varchar(256) + constraint ms_ent_dotlrn_class_map_pk + primary key, + community_id integer + constraint ims_ent_dotlrn_class_map_comm_id + references dotlrn_communities_all (community_id) +); + + +alter table auth_batch_job_entries add community_key varchar(100); +alter table auth_batch_job_entries add department_key varchar(100); +alter table auth_batch_job_entries add subject_key varchar(100); +alter table auth_batch_job_entries add class_key varchar(100); +alter table auth_batch_job_entries add class_instance_key varchar(100); Index: openacs-4/packages/ims-ent/sql/postgresql/ims-ent-drop.sql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/ims-ent/sql/postgresql/ims-ent-drop.sql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/ims-ent/sql/postgresql/ims-ent-drop.sql 9 Jun 2004 18:08:07 -0000 1.1 @@ -0,0 +1,10 @@ +-- +-- packages/ims-ent/sql/postgresql/ims-ent-drop.sql +-- +-- @author Rocael Hernandez (roc@viaro.net) +-- @creation-date 2004-05-19 +-- @arch-tag: e6b5d26e-940b-43c7-9ada-85732a8ae4f4 +-- @cvs-id $Id: ims-ent-drop.sql,v 1.1 2004/06/09 18:08:07 rocaelh Exp $ +-- + +drop table ims_ent_dotlrn_class_map; \ No newline at end of file Index: openacs-4/packages/ims-ent/tcl/apm-callbacks-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/ims-ent/tcl/apm-callbacks-procs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/ims-ent/tcl/apm-callbacks-procs.tcl 9 Jun 2004 18:08:07 -0000 1.1 @@ -0,0 +1,59 @@ +# packages/ims-ent/tcl/apm-callbacks-procs.tcl + +ad_library { + + Now we'll deal with previous sc from authentication + + @author Rocael Hernandez (roc@viaro.net) + @creation-date 2004-06-04 + @arch-tag: 324dfbee-ce4e-4a83-8122-5a01cf80049c + @cvs-id $Id: apm-callbacks-procs.tcl,v 1.1 2004/06/09 18:08:07 rocaelh Exp $ +} + +namespace eval auth {} + +ad_proc -private ims_enterprise::package_upgrade { +} { + this will upgrade existing related SC from acs-authentication + + @author Rocael Hernandez (roc@viaro.net) + @creation-date 2004-06-04 + + @return + + @error +} { + + db_transaction { + ims_enterprise::unregister_impl + ims_enterprise::register_impl + } + +} + + +ad_proc -private ims_enterprise::register_impl {} { + Register this implementation +} { + set spec { + contract_name "auth_sync_process" + owner "acs-authentication" + name "IMS_Enterprise_v_1p1" + pretty_name "IMS Enterprise 1.1" + aliases { + ProcessDocument ims_enterprise::parser::ProcessDocument + GetAcknowledgementDocument auth::sync::process_doc::ims::GetAcknowledgementDocument + GetElements auth::sync::process_doc::ims::GetElements + GetParameters auth::sync::process_doc::ims::GetParameters + } + } + + return [acs_sc::impl::new_from_spec -spec $spec] + +} + +ad_proc -private ims_enterprise::unregister_impl {} { + Unregister this implementation +} { + acs_sc::impl::delete -contract_name "auth_sync_process" -impl_name "IMS_Enterprise_v_1p1" +} Index: openacs-4/packages/ims-ent/tcl/batch-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/ims-ent/tcl/batch-procs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/ims-ent/tcl/batch-procs.tcl 9 Jun 2004 18:08:07 -0000 1.1 @@ -0,0 +1,93 @@ +# packages/ims-ent/tcl/batch-procs.tcl + +ad_library { + + Contains some of the same functions that sync-procs.tcl + (acs-authentication), but with some modifications + + @author Rocael Hernandez (roc@viaro.net) + @creation-date 2004-06-04 + @arch-tag: 69da0967-01a8-4020-8100-6c5d88857e67 + @cvs-id $Id: batch-procs.tcl,v 1.1 2004/06/09 18:08:07 rocaelh Exp $ +} + +namespace eval ims_enterprise {} +namespace eval ims_enterprise::sync {} +namespace eval ims_enterprise::sync::job {} + +ad_proc -public ims_enterprise::sync::job::get_entry { + {-entry_id:required} + {-array:required} +} { + Get information about a log entry +} { + upvar 1 $array row + + db_1row select_entry { + select e.entry_id, + e.job_id, + e.entry_time, + e.operation, + j.authority_id, + e.username, + e.user_id, + e.community_key, + e.department_key, + e.subject_key, + e.class_key, + e.class_instance_key, + e.success_p, + e.message, + e.element_messages + from auth_batch_job_entries e, + auth_batch_jobs j + where e.entry_id = :entry_id + and j.job_id = e.job_id + } -column_array row +} + +ad_proc -public ims_enterprise::sync::job::create_entry { + {-job_id:required} + {-operation:required} + {-username ""} + {-user_id ""} + {-community_key ""} + {-department_key ""} + {-subject_key ""} + {-class_key ""} + {-class_instance_key ""} + {-success:boolean} + {-message ""} + {-element_messages ""} +} { + Record a batch job entry. + + @param job_id The ID of the batch job you're ending. + + @param operation One of 'insert', 'update', or 'delete'. + + @param username The username of the user being inserted/updated/deleted. + + @param community_key The community id related to the transacion. + + @param user_id The user_id of the local user account, if known. + + @param success Whether or not the operation went well. + + @param message Any error message to stick into the log. + + @return entry_id +} { + set success_p_db [ad_decode $success_p 1 "t" "f"] + + set entry_id [db_nextval "auth_batch_job_entry_id_seq"] + + db_dml insert_entry { + insert into auth_batch_job_entries + (entry_id, job_id, operation, username, user_id, community_key, department_key, subject_key, class_key, class_instance_key, success_p, message, element_messages) + values + (:entry_id, :job_id, :operation, :username, :user_id, :community_key, :department_key, :subject_key, :class_key, :class_instance_key, :success_p_db, :message, :element_messages) + } -clobs [list $element_messages] + + return $entry_id +} Index: openacs-4/packages/ims-ent/tcl/ims-ent-dotlrn-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/ims-ent/tcl/ims-ent-dotlrn-procs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/ims-ent/tcl/ims-ent-dotlrn-procs.tcl 9 Jun 2004 18:08:07 -0000 1.1 @@ -0,0 +1,678 @@ +ad_library { + + new library, for handling the manipulation of .LRN stuff from the + xml file feed + + @author Rocael Hernandez Rizzardini (roc@viaro.net) + @creation-date 2004-04-05 + @arch-tag: 656A1108-872F-11D8-B325-000A95ABB5AA + @cvs-id $Id: ims-ent-dotlrn-procs.tcl,v 1.1 2004/06/09 18:08:07 rocaelh Exp $ +} + + +namespace eval ims_enterprise {} +namespace eval ims_enterprise::ims_dotlrn {} +namespace eval ims_enterprise::ims_dotlrn::groups {} +namespace eval ims_enterprise::ims_dotlrn::membership {} + + +ad_proc -private ims_enterprise::ims_dotlrn::recstatus { + {-recstatus:required} +} { + This should return if recstatus = + 1 = insert + 2 = update + 3 = delete + 4 = snapshot + + @author Rocael Hernandez Rizzardini (roc@viaro.net) + @creation-date 2004-04-01 + + @param recstatus + + @return one of those string values + + @error +} { + + switch $recstatus { + 1 { + set operation "insert" + } + 2 { + set operation "update" + } + 3 { + set operation "delete" + } + default { + set operation "snapshot" + } + } + + return $operation +} + + +ad_proc -private ims_enterprise::ims_dotlrn::groups::department_check { + dep_id +} { + checks if a deparment in .LRN exists + + @author Rocael Hernandez Rizzardini (roc@viaro.net) + @creation-date 2004-04-01 + + @param dep_id + + @return 1 if yes, 0 if not + + @error +} { + + return [db_string get { *SQL* }] + +} + +ad_proc -private ims_enterprise::ims_dotlrn::groups::subject_check { + sub_id + dep_key +} { + checks if a subject in .LRN exists + + @author Rocael Hernandez Rizzardini (roc@viaro.net) + @creation-date 2004-04-01 + + @param dep_id + + @return 1 if yes, 0 if not + + @error +} { + set community_type "${dep_key}.${sub_id}" + return [db_string get { *SQL* }] + +} + + +ad_proc -private ims_enterprise::ims_dotlrn::groups::department { + {-job_id:required} + {-department_key:required} + {-pretty_name:required} + {-description ""} + {-external_url ""} + {-operation:required} +} { + this creates a new department of .LRN from the XML data + + @author Rocael Hernandez Rizzardini (roc@viaro.net) + @creation-date 2004-04-05 + + @param department_key + + @param operation + + @return if it was successful the operation or not, if not, why it fails + + @error +} { + + db_transaction { + + set success_p 1 + array set result { + message {} + element_messages {} + } + + + + set dep_exist_p [department_check $department_key] + + switch $operation { + snapshot { + if ${dep_exist_p} { + set operation update + } else { + set operation insert + } + } + update { + if !${dep_exist_p} { + set success_p 0 + set result(message) "department : A department with this key '$department_key' does not exist" + } + } + delete { + if !${dep_exist_p} { + set success_p 0 + set result(message) "department : A department with this key '$department_key' does not exist" + } elseif {[db_string n_classes { *SQL* }] == 0} { + set success_p 0 + set result(message) "department : A department with this key '$department_key' has more classes associated " + } + } + insert { + if ${dep_exist_p} { + set success_p 0 + set result(message) "department : A department with this key '$department_key' already exist" + } + } + + } + + if { $success_p } { + with_catch errmsg { + switch $operation { + insert { + + dotlrn_department::new \ + -department_key $department_key \ + -pretty_name $pretty_name \ + -description $description \ + -external_url $external_url + + } + update { + + db_dml update_department {} + db_dml update_community_type {} + + } + delete { + + dotlrn_department::delete \ + -department_key $department_key + + } + } + + set result(message) "department $operation" + } { + # Get errorInfo and log it + global errorInfo + ns_log Error "department : Error during batch syncrhonization job (department):\n$errorInfo" + set success_p 0 + set result(message) "department : $errorInfo" + } + } + + # Make a log entry + set entry_id [ims_enterprise::sync::job::create_entry \ + -job_id $job_id \ + -operation $operation \ + -department_key $department_key \ + -success=$success_p \ + -message $result(message) \ + -element_messages $result(element_messages)] + + } + +} + + + + +ad_proc -private ims_enterprise::ims_dotlrn::groups::subject { + {-job_id:required} + {-class_key:required} + {-department_key:required} + {-pretty_name:required} + {-description ""} + {-operation:required} +} { + To create subjects on .LRN from XML IMS Enterprise + + @author Rocael Hernandez Rizzardini (roc@viaro.net) + @creation-date 2004-04-05 + + @param department_key + + @param operation + + @return + + @error +} { + + db_transaction { + + set success_p 1 + array set result { + message {} + element_messages {} + } + + if [empty_string_p $department_key] { + set success_p 0 + set result(message) "subject : A subject without department_key was attempted to be created." + } else { + + set sub_exist_p [subject_check $class_key $department_key] + set dep_exist_p [department_check $department_key] + + switch $operation { + snapshot { + if { !${sub_exist_p} && ${dep_exist_p} } { + set operation insert + } else { + set operation update + } + } + update { + if { !${sub_exist_p} } { + set success_p 0 + set result(message) "subject : A subject with this class key '$class_key' does not exist" + } + } + insert { + if { !${dep_exist_p} } { + set success_p 0 + set result(message) "subject : A subject cannot be created since the department key '$department_key' does not exist" + } elseif { ${sub_exist_p} } { + set success_p 0 + set result(message) "subject : A subject with this class key '$class_key' already exist" + } + } + delete { + set success_p 0 + set result(message) "subject : Deleteting a subject is not supported" + } + } + } + + if { $success_p } { + with_catch errmsg { + switch $operation { + insert { + + dotlrn_class::new \ + -class_key $class_key \ + -department_key $department_key \ + -pretty_name $pretty_name \ + -description $description + + } + update { + + db_dml update_community_type {} + + } + } ;#switch + set result(message) "subject $operation" + } { + # Get errorInfo and log it + global errorInfo + ns_log Error "subject : Error during batch syncrhonization job (subject):\n$errorInfo" + set success_p 0 + set result(message) "subject : $errorInfo" + } + } + + # Make a log entry + set entry_id [ims_enterprise::sync::job::create_entry \ + -job_id $job_id \ + -operation $operation \ + -department_key $department_key \ + -subject_key $class_key \ + -success=$success_p \ + -message $result(message) \ + -element_messages $result(element_messages)] + + } +} + + + + + + + +ad_proc -private ims_enterprise::ims_dotlrn::get_community_id { + class_instance_key +} { + + get the community_id on .LRN context + + @author Rocael Hernandez Rizzardini (roc@viaro.net) + @creation-date 2004-04-14 + + @param class_instance_key + + @return community_id or empty string + + @error +} { + return [db_string get_comm_id { *SQL* } -default ""] +} + + + + +ad_proc -private ims_enterprise::ims_dotlrn::groups::class { + {-job_id:required} + {-class_instance_key:required} + {-class_key:required} + {-term_id:required} + {-pretty_name:required} + {-description ""} + {-join_policy} + {-operation:required} +} { + To create classes on .LRN from XML IMS Enterprise + + @author Rocael Hernandez Rizzardini (roc@viaro.net) + @creation-date 2004-04-05 + + @param department_key + + @param operation + + @return + + @error +} { + + db_transaction { + + set success_p 1 + array set result { + message {} + element_messages {} + } + + if [empty_string_p $class_key] { + set success_p 0 + set result(message) "class : A class with this class key '$class_instance_key' was not found on the system" + } else { + + # search on the relationships if there is one with a department, + # go with the first one found, if none, we'll have error on + # inserts + + set community_id [ims_enterprise::ims_dotlrn::get_community_id $class_instance_key] + + switch $operation { + snapshot { + if [empty_string_p ${community_id}] { + set operation insert + } else { + set operation update + } + } + insert { + if ![empty_string_p ${community_id}] { + set success_p 0 + set result(message) "class : A class with this class instance key '$class_instance_key' already exist" + } + } + update { + if [empty_string_p ${community_id}] { + set success_p 0 + set result(message) "class : A class instance with this class instance key '$class_instance_key' does not exist" + } + } + delete { + set success_p 0 + set result(message) "class : Deleteting a class instance is not supported" + } + } + } + + if { $success_p } { + with_catch errmsg { + switch $operation { + insert { + + set class_instance_id [dotlrn_class::new_instance \ + -class_key $class_key \ + -term_id $term_id \ + -pretty_name $pretty_name \ + -description $description \ + -join_policy $join_policy \ + ] + db_dml map_class { *SQL* } + + } + update { + + dotlrn_community::set_community_name \ + -community_id $community_id \ + -pretty_name $pretty_name + + dotlrn_community::set_community_description \ + -community_id $community_id \ + -description $description + } + delete { + + # this is dangerous, since for one error in XML data we + # might archive an active class, so just lets do nothing + # by now, this part won't execute in any case (roc) + + # what we can really do is to *archive* it + + set subcomm_id [dotlrn_community::archive \ + -community_id $community_id] + + } + } ;#switch + set result(message) "class $operation" + } { + # Get errorInfo and log it + global errorInfo + ns_log Error "class : Error during batch syncrhonization job (class):\n$errorInfo" + set success_p 0 + set result(message) "class : $errorInfo" + } + } + + # Make a log entry + set entry_id [ims_enterprise::sync::job::create_entry \ + -job_id $job_id \ + -operation $operation \ + -class_key $class_key \ + -class_instance_key $class_instance_key \ + -success=$success_p \ + -message $result(message) \ + -element_messages $result(element_messages)] + } +} + + +ad_proc -private ims_enterprise::ims_dotlrn::groups::guess_term { + start_date + end_date +} { + + Here we'll try to see if we found a proper TERM for this specific + dates that we receive. + We need better implementation for this one. + + @author Rocael Hernandez Rizzardini (roc@viaro.net) + @creation-date 2004-04-06 + + @param start_date + + @param end_date + + @return + + @error +} { + + set term_id [db_string get_best_term { *SQL* } -default ""] + + #if no term create one + if [empty_string_p $term_id] { + + set term_year [dotlrn_term::start_end_dates_to_term_year \ + -start_date [split $start_date {-}] \ + -end_date [split $end_date {-}] + ] + + dotlrn_term::new \ + -term_name "$start_date$end_date" \ + -term_year $term_year \ + -start_date $start_date \ + -end_date $end_date + + set term_id [db_string get_best_term { *SQL* } -default ""] + } + + return $term_id + +} + + +ad_proc -private ims_enterprise::ims_dotlrn::membership::rel_type { + roletype +} { + + will return the proper rel_type for a give role that we got from + IMS document + + @author Rocael Hernandez Rizzardini (roc@viaro.net) + @creation-date 2004-04-14 + + @param roletype + + @return + + @error +} { + + # this should be customized using params or some sort of mapping + # (roc), what about numbers like 01, 02 ...?? + set roletype [string trimleft $roletype 0] + + switch $roletype { + 2 { return dotlrn_instructor_rel } + 7 - + 5 { return dotlrn_cadmin_rel } + 3 { return dotlrn_ca_rel } + 6 - + 8 { return dotlrn_ta_rel } + 4 - + 1 { return dotlrn_student_rel } + } + +} + + +ad_proc -private ims_enterprise::ims_dotlrn::groups::membership { + {-job_id:required} + {-class_instance_key:required} + {-community_id:required} + {-username:required} + {-authority_id:required} + {-roletype:required} + {-operation:required} +} { + + To handle the membership between users & groups from XML IMS Enterprise + + @author Rocael Hernandez (roc@viaro.net) + @creation-date 2004-06-03 + + @param job_id + + @param class_instance_key + + @param community_id + + @param username + + @param authority_id + + @param roletype + + @param operation + + @return + + @error +} { + + db_transaction { + + set success_p 1 + array set result { + message {} + element_messages {} + } + + # if the community_id doesn't exist, then its an error + if [empty_string_p $community_id] { + set success_p 0 + set result(message) ": A class with this class instance key '$class_instance_key' doesn't exist" + } else { + + # lets get the user_id (we use the username as key for + # getting the user) + # the user should not be able to change the username! or + # we should store that in another place! + # (roc) + + set user_id [acs_user::get_by_username -authority_id $authority_id -username $username] + + if { [empty_string_p $user_id] } { + # Updating/deleting a user that doesn't exist + set success_p 0 + set result(message) "A user with username '$username' does not exist" + } else { + acs_user::get -user_id $user_id -array existing_user_info + if { [string equal $existing_user_info(member_state) "banned"] } { + # Updating/deleting a user that's already deleted + set success_p 0 + set result(message) "The user with username '$username' has been deleted (banned)" + } elseif ![dotlrn::user_p -user_id $user_id] { + # This is not a dotlrn user + set success_p 0 + set result(message) ": The user with username '$username' isn't a dotlrn user" + } + } + } + if { $success_p } { + with_catch errmsg { + + set member_p [dotlrn_community::member_p $community_id $user_id] + + # this will work for recstatus=delete, but we need to + # do it for any update as well. + if {$member_p} { + dotlrn_community::remove_user $community_id $user_id + } + + if {$operation != "delete" } { + + # this will work for insert, update and snapshot + # as well, since there are not specific procs for update a + # dotlrn rel, just add/delete + set rel_type [ims_enterprise::ims_dotlrn::membership::rel_type $roletype] + + dotlrn_community::add_user -rel_type $rel_type $community_id $user_id + } + set result(message) "" + } { + # Get errorInfo and log it + global errorInfo + ns_log Error ": Error during batch syncrhonization job (membership):\n$errorInfo" + set success_p 0 + set result(message) ": $errorInfo" + } + } + + # Make a log entry + set entry_id [ims_enterprise::sync::job::create_entry \ + -job_id $job_id \ + -operation $operation \ + -username $username \ + -user_id $user_id \ + -community_key $community_id \ + -class_instance_key $class_instance_key \ + -success=$success_p \ + -message $result(message) \ + -element_messages $result(element_messages)] + + } +} Index: openacs-4/packages/ims-ent/tcl/ims-ent-dotlrn-procs.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/ims-ent/tcl/ims-ent-dotlrn-procs.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/ims-ent/tcl/ims-ent-dotlrn-procs.xql 9 Jun 2004 18:08:07 -0000 1.1 @@ -0,0 +1,93 @@ + + + + + + + + + + + + + select count(*) from dotlrn_departments_full + where department_key = :dep_id + + + + + + update dotlrn_departments + set external_url = :external_url + where department_key = :department_key + + + + + + update dotlrn_community_types + set pretty_name = :pretty_name, + description = :description + where community_type = :department_key + + + + + + update dotlrn_community_types + set pretty_name = :pretty_name, + description = :description + where community_type = :class_key + + + + + + select count(*) + from dotlrn_classes + where department_key = :department_key + + + + + + select count(*) + from dotlrn_community_types + where community_type = :community_type + + + + + + select count(*) + from dotlrn_classes + where class_key = :class_key + + + + + + insert into ims_ent_dotlrn_class_map (community_id, class_instance_key) + values (:class_instance_id, :class_instance_key) + + + + + + select community_id from ims_ent_dotlrn_class_map + where class_instance_key = :class_instance_key + + + + + + select term_id + from dotlrn_terms + where start_date >= :start_date + and end_date <= :end_date + order by end_date DESC + limit 1 + + + + \ No newline at end of file Index: openacs-4/packages/ims-ent/tcl/ims-ent-parser-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/ims-ent/tcl/ims-ent-parser-procs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/ims-ent/tcl/ims-ent-parser-procs.tcl 9 Jun 2004 18:08:07 -0000 1.1 @@ -0,0 +1,366 @@ +ad_library { + API for parsing and inserting the respective datamodel the data that has been obtained from the parsing of a IMS Enterprise v. 1.1 DTD + + @creation-date 2004-03-29 + @author Rocael Hernandez (roc@viaro.net) + @cvs-id $Id: ims-ent-parser-procs.tcl,v 1.1 2004/06/09 18:08:07 rocaelh Exp $ +} + +namespace eval ims_enterprise {} +namespace eval ims_enterprise::parser {} + +ad_proc -public ims_enterprise::parser::group_to_dotlrn { + {-job_id:required} + {-document:required} +} { + For parsing the tag of the IMS Enterprise v.1.1 + specification and calling the approiate procs + + @author Rocael Hernandez Rizzardini (roc@viaro.net) + @creation-date 2004-04-01 + + @param document + + @return + + @error +} { + + + set tree [xml_parse -persist $document] + + set root_node [xml_doc_get_first_node $tree] + + # Loop over records + # we'll process as: + # 1. Deparments + # 2. Subjects + # 3. Class instances + # these are the defaults, but can be customized as parameters + + set lookup_levels [list [parameter::get_from_package_key -package_key ims-ent -parameter department] \ + [parameter::get_from_package_key -package_key ims-ent -parameter subject] \ + [parameter::get_from_package_key -package_key ims-ent -parameter class]] + + + foreach lookup_level $lookup_levels { + set xpath [format {/enterprise/group[grouptype/typevalue[@level=%i]]} $lookup_level] + + foreach group_node [xml_node_get_children_by_select $root_node $xpath] { + + set recstatus [xml_node_get_attribute $group_node "recstatus"] + + # + set sourcedidtype [xml_get_child_node_attribute_by_path $group_node {sourcedid} "sourcedidtype"] + set id [xml_get_child_node_content_by_path $group_node { { sourcedid id } }] + set source [xml_get_child_node_content_by_path $group_node { { sourcedid source } }] + + # 3.5 + + # we'll use just short rigth now, shall not be noll + set short [xml_get_child_node_content_by_path $group_node { { description short } }] + # temporal format + set short [string range $short 0 50] + # this migth be complementary info that might have a place to be in .LRN + set long [xml_get_child_node_content_by_path $group_node { { description long } }] + set full [xml_get_child_node_content_by_path $group_node { { description full } }] + + # 3.7 + + # this should help us on mapping a group to a term (roc) + set begin_date [xml_get_child_node_content_by_path $group_node { { timeframe begin } }] + set begin_restrict [xml_get_child_node_attribute_by_path $group_node { timeframe begin } "restrict"] + set end_date [xml_get_child_node_content_by_path $group_node { { timeframe end } }] + set end_restrict [xml_get_child_node_attribute_by_path $group_node { timeframe end } "restrict"] + set adminperiod [xml_get_child_node_content_by_path $group_node { { timeframe adminperiod } }] + + + # 3.8 + + # control for enroll policies + set enrollaccept [xml_get_child_node_content_by_path $group_node { { enrollcontrol enrollaccept } }] + set enrollallowed [xml_get_child_node_content_by_path $group_node { { enrollcontrol enrollallowed } }] + + # 3.10 + + set url [xml_get_child_node_content_by_path $group_node { { url } }] + + + # 3.11 + + # we'll use it to know what which is the *possible* parent or children(s) + # for subjects we need: the 3.11.2 where the 3.11.1 + # is 1 = Parent to determine the deparment_key + # we really don't need to parse this, since all the mapping is + # done through tag (not any more!, we'll use this + # for mapping groups within them) + + # department has no Parent so far, so we won't look for that now + if {$lookup_level != [parameter::get_from_package_key -package_key ims-ent -parameter department]} { + + set relationships [list] + + foreach relationship_node [xml_node_get_children_by_name $group_node "relationship"] { + set relation [xml_node_get_attribute $relationship_node "relation"] + set label [xml_get_child_node_content_by_path $relationship_node { { label } }] + + # we'll get the sourcedid, but we don't expect right here + # to create it, rather, we expect that this key is already + # in the ims_ent_sourcedids table (by now at least) (roc) + set sourcedid [xml_get_child_node_content_by_path $relationship_node { { sourcedid id } }] + + lappend relationships [list $relation $label $sourcedid] + + } + + # now look for parents if they are not provided + + set parent_key "" + foreach relation $relationships { + # 1 = Parent + if {[lindex $relation 0] == 1} { + set parent_key [lindex $relation 2] + break + } + } + + if [empty_string_p $parent_key] { + # we haven't found yet the parent, lets try to find it + # in the above level + + if {[parameter::get_from_package_key -package_key ims-ent -parameter subject] == $lookup_level} { + set parent_grouptype department + } else { + set parent_grouptype subject + } + + set xpath_up [format {/enterprise/group[grouptype/typevalue[@level=%i] and relationship/sourcedid[id='%s']]} \ + [parameter::get_from_package_key -package_key ims-ent -parameter $parent_grouptype] $id] + # do we need here a catch? to avoid parsing errors if + # its not found + set parent_node [xml_node_get_children_by_select $root_node $xpath_up] + if ![empty_string_p $parent_node] { + set parent_key [xml_get_child_node_content_by_path $parent_node {{ sourcedid id } }] + } + + + } + + set parent_key [string trim $parent_key] + + }; #lookup_level + + + + # now we call the actual proc that will create the specific stuff + + set operation [ims_enterprise::ims_dotlrn::recstatus -recstatus $recstatus] + + set id [string trim $id] + + switch $lookup_level { + 1 { + # this range should not be here! + set long [string range $long 0 90] + ims_enterprise::ims_dotlrn::groups::department \ + -job_id $job_id \ + -department_key $id \ + -pretty_name $long \ + -description $full \ + -external_url $url \ + -operation $operation + } + 2 { + ims_enterprise::ims_dotlrn::groups::subject \ + -job_id $job_id \ + -class_key $id \ + -department_key $parent_key \ + -pretty_name $short \ + -description $full \ + -operation $operation + } + 3 { + + set term_id [ims_enterprise::ims_dotlrn::groups::guess_term $begin_date $end_date] + + # right now we assume that the of a + # is unique, so, now we need to determine the + # exact id for a this subject that this class + # belongs to, and in .LRN, automatically the + # subject key is generated as: + # department_key.class_key we might change the + # actual behaivor of .LRN to adapt more smoothly + # to the IMS Enterprise (roc) + + # so lets get the proper key based on the original + # key that we got from the IMS DTD + + set full_key [db_string class_key { *SQL* } -default ""] + + ims_enterprise::ims_dotlrn::groups::class \ + -job_id $job_id \ + -class_instance_key $id \ + -class_key $full_key \ + -term_id $term_id \ + -pretty_name $long \ + -description $full \ + -join_policy $enrollaccept \ + -operation $operation + } + } + + + + + } ;# end foreach + + }; # foreach level + +} + +ad_proc -private ims_enterprise::parser::membership_to_dotlrn { + {-job_id:required} + {-authority_id:required} + {-document:required} +} { + + For parsing the tag of the IMS Enterprise v.1.1 + specification and calling the approiate procs + + @author Rocael Hernandez Rizzardini (roc@viaro.net) + @creation-date 2004-04-14 + + @param document + + @return + + @error +} { + + set tree [xml_parse -persist $document] + + set root_node [xml_doc_get_first_node $tree] + + foreach mem_node [xml_node_get_children_by_name $root_node "membership"] { + + # + set sourcedidtype [xml_get_child_node_attribute_by_path $mem_node {sourcedid} "sourcedidtype"] + set id [xml_get_child_node_content_by_path $mem_node { { sourcedid id } }] + set source [xml_get_child_node_content_by_path $mem_node { { sourcedid source } }] + + set community_id [ims_enterprise::ims_dotlrn::get_community_id $id] + set class_instance_key $id + + set group_source $source + + # temp regsub till quio fix the document + # regsub {(,).*} $id {} id + + foreach member_node [xml_node_get_children_by_name $mem_node "member"] { + + set sourcedidtype [xml_get_child_node_attribute_by_path $member_node {sourcedid} "sourcedidtype"] + set id [xml_get_child_node_content_by_path $member_node { { sourcedid id } }] + set source [xml_get_child_node_content_by_path $member_node { { sourcedid source } }] + + # idtype *must* be 1, probably need to put a check here (roc) + set idtype [xml_get_child_node_content_by_path $member_node { { idtype } }] + + # .LRN right now only allows you to assing one specific + # role for a given relation between a user and a class so + # we won't parse several times the tag, instead + # will go with the first value that we get from it by now + # (roc) + set recstatus [xml_get_child_node_attribute_by_path $member_node {role} "recstatus"] + set roletype [xml_get_child_node_attribute_by_path $member_node {role} "roletype"] + + set operation [ims_enterprise::ims_dotlrn::recstatus -recstatus $recstatus] + + + ims_enterprise::ims_dotlrn::groups::membership \ + -job_id $job_id \ + -class_instance_key $class_instance_key \ + -community_id $community_id \ + -username $id \ + -authority_id $authority_id \ + -roletype $roletype \ + -operation $operation + + } + + } +} + + +ad_proc -private ims_enterprise::parser::ProcessDocument { + job_id + document + parameters +} { + Process IMS Enterprise 1.1 document. +} { + set tree [xml_parse -persist $document] + + set root_node [xml_doc_get_first_node $tree] + + if { ![string equal [xml_node_get_name $root_node] "enterprise"] } { + error "Root node was not " + } + + # Loop over records + foreach person_node [xml_node_get_children_by_name $root_node "person"] { + switch [xml_node_get_attribute $person_node "recstatus"] { + 1 { + set operation "insert" + } + 2 { + set operation "update" + } + 3 { + set operation "delete" + } + default { + set operation "snapshot" + } + } + + # Initialize this record + array unset user_info + + set username [xml_get_child_node_content_by_path $person_node { { userid } { sourcedid id } }] + + set user_info(email) [xml_get_child_node_content_by_path $person_node { { email } }] + set user_info(url) [xml_get_child_node_content_by_path $person_node { { url } }] + + # We need a little more logic to deal with first_names/last_name, since they may not be split up in the XML + set user_info(first_names) [xml_get_child_node_content_by_path $person_node { { name n given } }] + set user_info(last_name) [xml_get_child_node_content_by_path $person_node { { name n family } }] + + if { [empty_string_p $user_info(first_names)] || [empty_string_p $user_info(last_name)] } { + set formatted_name [xml_get_child_node_content_by_path $person_node { { name fn } }] + if { ![empty_string_p $formatted_name] || [string first " " $formatted_name] > -1 } { + # Split, so everything up to the last space goes to first_names, the rest to last_name + regexp {^(.+) ([^ ]+)$} $formatted_name match user_info(first_names) user_info(last_name) + } + } + + auth::sync::job::action \ + -job_id $job_id \ + -operation $operation \ + -username $username \ + -array user_info + } + + # added IMS Ent stuff (roc) + + ims_enterprise::parser::group_to_dotlrn \ + -job_id $job_id \ + -document $document + + set authority_id [auth::sync::job::get_authority_id -job_id $job_id] + + ims_enterprise::parser::membership_to_dotlrn \ + -job_id $job_id \ + -authority_id $authority_id \ + -document $document + +} Index: openacs-4/packages/ims-ent/tcl/ims-ent-parser-procs.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/ims-ent/tcl/ims-ent-parser-procs.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/ims-ent/tcl/ims-ent-parser-procs.xql 9 Jun 2004 18:08:07 -0000 1.1 @@ -0,0 +1,115 @@ + + + + + + + + + + + + + insert into ims_ent_groups (ims_ent_group_id, recstatus) + values (:ims_ent_group_id, :recstatus) + + + + + + select ims_ent_lang_id from ims_ent_langs + where lang = :lang + + + + + + insert into ims_ent_comments (ims_ent_comment_id, ims_ent_tag_id, tag_type, comments) + values (:ims_ent_comment_id, :ims_ent_tag_id, :tag_type, :comments) + + + + + + insert into ims_ent_comm_lang_map (ims_ent_comment_id, ims_ent_lang_id) + values (:ims_ent_comment_id, :ims_ent_lang_id) + + + + + + insert into ims_ent_sourcedids (ims_ent_sourcedid_id, ims_ent_tag_id, tag_type, sourcedidtype, source, id) + values (:ims_ent_sourcedid_id, :ims_ent_tag_id, :tag_type, :sourcedidtype, :source, :id) + + + + + + insert into ims_ent_gr_grouptypes (ims_ent_gr_grouptype_id, ims_ent_group_id, scheme) + values (:ims_ent_gr_grouptype_id, :ims_ent_group_id, :scheme) + + + + + + insert into ims_ent_gr_typevalues (ims_ent_gr_typevalue_id, ims_ent_gr_grouptype_id, typevalue, level) + values (:ims_ent_gr_typevalue_id, :ims_ent_gr_grouptype_id, :typevalue, :level) + + + + + + insert into ims_ent_gr_descriptions (ims_ent_gr_description_id, ims_ent_group_id, short, long, full_name) + values (:ims_ent_gr_description_id, :ims_ent_group_id, :short, :long, :full) + + + + + + insert into ims_ent_timeframes (ims_ent_timeframe_id, ims_ent_tag_id, tag_type, begin_date, begin_restrict, end_date, end_restrict, adminperiod) + values (:ims_ent_timeframe_id, :ims_ent_tag_id, :tag_type, :begin_date, :begin_restrict, :end_date, :end_restrict, :adminperiod) + + + + + + insert into ims_ent_gr_enrollcontrols (ims_ent_gr_enrollcontrol_id, ims_ent_group_id, enrollaccept, enrollallowed) + values (:ims_ent_gr_enrollcontrol_id, :ims_ent_group_id, :enrollaccept, :enrollallowed) + + + + + + insert into ims_ent_emails (ims_ent_email_id, ims_ent_tag_id, tag_type, email) + values (:ims_ent_email_id, :ims_ent_tag_id, :tag_type, :email) + + + + + + insert into ims_ent_urls (ims_ent_url_id, ims_ent_tag_id, tag_type, url) + values (:ims_ent_url_id, :ims_ent_tag_id, :tag_type, :url) + + + + + + insert into ims_ent_gr_relationships (ims_ent_gr_relationship_id, ims_ent_group_id, relation, sourcedid, label) + values (:ims_ent_gr_relationship_id, :ims_ent_group_id, :relation, :sourcedid, :label) + + + + + + insert into ims_ent_datasources (ims_ent_datasource_id, ims_ent_tag_id, tag_type, datasource) + values (:ims_ent_datasource_id, :ims_ent_tag_id, :tag_type, :datasource) + + + + + + select class_key from dotlrn_classes_full where trim(class_key) like '%.$parent_key' + limit 1 + + + \ No newline at end of file Index: openacs-4/packages/ims-ent/www/index.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/ims-ent/www/index.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/ims-ent/www/index.adp 9 Jun 2004 18:08:07 -0000 1.1 @@ -0,0 +1,5 @@ + + + + Admin IMS Enterprise + \ No newline at end of file Index: openacs-4/packages/ims-ent/www/index.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/ims-ent/www/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/ims-ent/www/index.tcl 9 Jun 2004 18:08:07 -0000 1.1 @@ -0,0 +1,19 @@ +# packages/ims-ent/www/index.tcl + +ad_page_contract { + + + + @author Rocael Hernandez (roc@viaro.net) + @creation-date 2004-05-19 + @arch-tag: f4e6662a-79fa-4343-9afe-711ac085fc03 + @cvs-id $Id: index.tcl,v 1.1 2004/06/09 18:08:07 rocaelh Exp $ +} { + +} -properties { +} -validate { +} -errors { +} + +set package_id [ad_conn package_id] +set admin_p [permission::permission_p -object_id $package_id -privilege admin] \ No newline at end of file Index: openacs-4/packages/ims-ent/www/admin/authority-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/ims-ent/www/admin/authority-oracle.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/ims-ent/www/admin/authority-oracle.xql 9 Jun 2004 18:08:07 -0000 1.1 @@ -0,0 +1,28 @@ + + +oracle8.1.6 + + + + + select job_id, + to_char(job_start_time, 'YYYY-MM-DD HH24:MI:SS') as start_time_ansi, + to_char(job_end_time, 'YYYY-MM-DD HH24:MI:SS') as end_time_ansi, + snapshot_p, + (select count(e1.entry_id) + from auth_batch_job_entries e1 + where e1.job_id = auth_batch_jobs.job_id) as num_actions, + (select count(e2.entry_id) + from auth_batch_job_entries e2 + where e2.job_id = auth_batch_jobs.job_id + and e2.success_p = 'f') as num_problems, + interactive_p, + message, + round((nvl(job_end_time, sysdate) - job_start_time) * 24*60*60) as run_time_seconds + from auth_batch_jobs + where authority_id = :authority_id + + + + + Index: openacs-4/packages/ims-ent/www/admin/authority-parameters.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/ims-ent/www/admin/authority-parameters.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/ims-ent/www/admin/authority-parameters.adp 9 Jun 2004 18:08:07 -0000 1.1 @@ -0,0 +1,11 @@ + + @context;noquote@ + @page_title;noquote@ + parameters.@first_param_name;noquote@ + + + + + + The selected driver implementation has no parameters to configure. + Index: openacs-4/packages/ims-ent/www/admin/authority-parameters.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/ims-ent/www/admin/authority-parameters.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/ims-ent/www/admin/authority-parameters.tcl 9 Jun 2004 18:08:07 -0000 1.1 @@ -0,0 +1,86 @@ +ad_page_contract { + Set parameters for the service contract implementation of an authority + (for example authentication or password management). + + @author Peter Marklund +} { + authority_id:integer +} + +auth::authority::get -authority_id $authority_id -array authority + +set page_title "Configure" +set authority_url [export_vars -base authority { authority_id }] +set context [list [list "." "Authentication"] [list $authority_url $authority(pretty_name)] $page_title] + + +# Get the implementation id and implementation pretty name +array set parameters [list] +array set parameter_values [list] + +# Each element is a list of impl_ids which have this parameter +array set param_impls [list] + +foreach element_name [auth::authority::get_sc_impl_columns] { + set name_column $element_name + regsub {^.*(_id)$} $element_name {_name} name_column + + set impl_params [auth::driver::get_parameters -impl_id $authority($element_name)] + + foreach { param_name dummy } $impl_params { + lappend param_impls($param_name) $authority($element_name) + } + + array set parameters $impl_params + + array set parameter_values [auth::driver::get_parameter_values \ + -authority_id $authority_id \ + -impl_id $authority($element_name)] + +} + +set has_parameters_p [expr [llength [array names parameters]] > 0] + +set first_param_name "" +if { $has_parameters_p } { + + # Set focus on first param name + set first_param_name [lindex [array names parameters] 0] + + set form_widgets [list] + foreach parameter_name [array names parameters] { + lappend form_widgets [list ${parameter_name}:text,optional [list label $parameter_name] [list help_text $parameters($parameter_name)] {html {size 80}}] + } + + set hidden_vars {authority_id} + + ad_form -name parameters \ + -cancel_url $authority_url \ + -form $form_widgets \ + -export $hidden_vars \ + -on_request { + + foreach parameter_name [array names parameter_values] { + set $parameter_name $parameter_values($parameter_name) + } + + } -on_submit { + + foreach element_name [template::form::get_elements -no_api parameters] { + + # Make sure we have a parameter element + if { [info exists param_impls($element_name)] } { + foreach impl_id $param_impls($element_name) { + auth::driver::set_parameter_value \ + -authority_id $authority_id \ + -impl_id $impl_id \ + -parameter $element_name \ + -value [element get_value parameters $element_name] + } + } + } + + ad_returnredirect $authority_url + ad_script_abort + } +} Index: openacs-4/packages/ims-ent/www/admin/authority-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/ims-ent/www/admin/authority-postgresql.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/ims-ent/www/admin/authority-postgresql.xql 9 Jun 2004 18:08:07 -0000 1.1 @@ -0,0 +1,30 @@ + + +postgresql7.1 + + + + + select job_id, + to_char(job_start_time, 'YYYY-MM-DD HH24:MI:SS') as start_time_ansi, + to_char(job_end_time, 'YYYY-MM-DD HH24:MI:SS') as end_time_ansi, + snapshot_p, + (select count(e1.entry_id) + from auth_batch_job_entries e1 + where e1.job_id = auth_batch_jobs.job_id) as num_actions, + (select count(e2.entry_id) + from auth_batch_job_entries e2 + where e2.job_id = auth_batch_jobs.job_id + and e2.success_p = 'f') as num_problems, + interactive_p, + message, + trunc(extract(epoch from (coalesce(job_end_time, current_timestamp) - job_start_time))) as run_time_seconds + from auth_batch_jobs + where authority_id = :authority_id + [template::list::orderby_clause -orderby -name batch_jobs] + + + + + + Index: openacs-4/packages/ims-ent/www/admin/authority.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/ims-ent/www/admin/authority.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/ims-ent/www/admin/authority.adp 9 Jun 2004 18:08:07 -0000 1.1 @@ -0,0 +1,34 @@ + + @context;noquote@ + @page_title;noquote@ + authority.pretty_name + + +

+ » Configure drivers for this authority +

+ + + + + +

+ » Configure drivers for this authority +

+ + +

+ » Show users in this authority (@num_users@ users) +

+ + +

Batch Jobs

+ + +

+ » Run new batch job now +

+ + +

+ Index: openacs-4/packages/ims-ent/www/admin/authority.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/ims-ent/www/admin/authority.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/ims-ent/www/admin/authority.tcl 9 Jun 2004 18:08:07 -0000 1.1 @@ -0,0 +1,328 @@ +ad_page_contract { + Page for adding and editing an authority. + + @author Peter Marklund + @creation-date 2003-09-08 +} { + authority_id:integer,optional + bj_orderby:optional + {ad_form_mode display} +} + +set page_title "" +if { [exists_and_not_null authority_id] } { + # Initial request in display or edit mode or a submit of the form + set authority_exists_p [db_string authority_exists_p { + select count(*) + from auth_authorities + where authority_id = :authority_id + }] +} else { + # Initial request in add mode + set page_title "New Authority" + set ad_form_mode edit + set authority_exists_p 0 +} + +set form_widgets_full { + + authority_id:key(acs_object_id_seq) + + {pretty_name:text + {html {size 50}} + {label "Name"} + {section "General"} + } + + {short_name:text,optional + {html {size 50}} + {label "Short Name"} + {mode {[ad_decode $local_authority_p 1 "display" ""]}} + {help_text "This is used when referring to the authority in parameters etc. Even if you need to change the display name above, this should stay unchanged."} + } + + {enabled_p:text(radio) + {label "Enabled"} + {options {{Yes t} {No f}}} + } + + {help_contact_text:richtext,optional + {html {cols 60 rows 13}} + {label "Help contact text"} + {help_text "Contact information (phone, email, etc.) to be displayed as a last resort when people are having problems with an authority."} + } + {auth_impl_id:integer(select),optional + {label "Authentication"} + {section "Authentication"} + {options {[acs_sc::impl::get_options -empty_label "--Disabled--" -contract_name auth_authentication]}} + } + + {pwd_impl_id:integer(select),optional + {label "Password management"} + {section "Password Management"} + {options {[acs_sc::impl::get_options -empty_label "--Disabled--" -contract_name auth_password]}} + } + + {forgotten_pwd_url:text,optional + {html {size 50}} + {label "Recover password URL"} + {help_text "Instead of a password management driver, you may provide a URL to which users are sent when they need help recovering their password. Any username in this url must be on the syntax foo={username} and {username} will be replaced with the real username."} + } + {change_pwd_url:text,optional + {html {size 50}} + {label "Change password URL"} + {help_text "Instead of a password management driver, you may provide a URL to which users are sent when they want to change their password. Any username in this url must be on the syntax foo={username} and {username} will be replaced with the real username."} + } + + {register_impl_id:integer(select),optional + {label "Account registration"} + {section "Account Registration"} + {options {[acs_sc::impl::get_options -empty_label "--Disabled--" -contract_name auth_registration]}} + } + + {register_url:text,optional + {html {size 50}} + {label "Account registration URL"} + {help_text "URL where users register for a new account."} + } + + {user_info_impl_id:integer(select),optional + {label "User Info"} + {section "On-Demand Sync"} + {options {[acs_sc::impl::get_options -empty_label "--Disabled--" -contract_name auth_user_info]}} + {help_text "The implementation for getting user information from the authority in real-time"} + } + + {batch_sync_enabled_p:text(radio) + {label "Batch sync enabled"} + {options {{Yes t} {No f}}} + {section {Batch Synchronization}} + } + + {get_doc_impl_id:integer(select),optional + {label "GetDocument implementation"} + {options {[acs_sc::impl::get_options -empty_label "--Disabled--" -contract_name auth_sync_retrieve]}} + } + + {process_doc_impl_id:integer(select),optional + {label "ProcessDocument implementation"} + {options {[acs_sc::impl::get_options -empty_label "--Disabled--" -contract_name auth_sync_process]}} + } +} + +# For the local authority we allow only limited editing +# Is this the local authority? +set local_authority_p 0 +if { $authority_exists_p && [string equal $authority_id [auth::authority::local]] } { + set local_authority_p 1 +} + +if { $local_authority_p } { + # Local authority + # The form elements we use for local authority + set local_editable_elements { + authority_id + pretty_name + short_name + forgotten_pwd_url + change_pwd_url + register_url + } + + foreach element $form_widgets_full { + regexp {^[a-zA-Z_]+} [lindex $element 0] element_name + + if { [lsearch -exact $local_editable_elements $element_name] != -1 } { + lappend form_widgets $element + } + } +} else { + # Not local authority - use full form + set form_widgets $form_widgets_full +} + +ad_form -name authority \ + -mode $ad_form_mode \ + -form $form_widgets \ + -cancel_url "." \ + -new_request { + set enabled_p t + set batch_sync_enabled_p f + } \ + -edit_request { + + auth::authority::get -authority_id $authority_id -array element_array + + set page_title $element_array(pretty_name) + + foreach element_name [array names element_array] { + set $element_name $element_array($element_name) + } + + if { !$local_authority_p } { + # Set the value of the help_contact_text element - both contents and format attributes + set help_contact_text [template::util::richtext::create] + set help_contact_text [template::util::richtext::set_property contents $help_contact_text $element_array(help_contact_text)] + if { [empty_string_p $element_array(help_contact_text_format)] } { + set element_array(help_contact_text_format) "text/enhanced" + } + set help_contact_text [template::util::richtext::set_property format $help_contact_text $element_array(help_contact_text_format)] + } + +} -new_data { + + set page_title $pretty_name + + foreach var_name [template::form::get_elements -no_api authority] { + set element_array($var_name) [set $var_name] + } + + set element_array(sort_order) "" + + if { !$local_authority_p } { + set element_array(help_contact_text) [template::util::richtext::get_property contents $help_contact_text] + set element_array(help_contact_text_format) [template::util::richtext::get_property format $help_contact_text] + } + + auth::authority::create \ + -authority_id $authority_id \ + -array element_array + +} -edit_data { + + foreach var_name [template::form::get_elements -no_api authority] { + if { ![string equal $var_name "authority_id"] } { + set element_array($var_name) [set $var_name] + } + } + + if { !$local_authority_p } { + set element_array(help_contact_text) [template::util::richtext::get_property contents $help_contact_text] + set element_array(help_contact_text_format) [template::util::richtext::get_property format $help_contact_text] + if { [info exists element_array(short_name)] } { + unset element_array(short_name) + } + } + + auth::authority::edit \ + -authority_id $authority_id \ + -array element_array +} -after_submit { + ad_returnredirect [export_vars -base [ad_conn url] { authority_id }] +} + +# Show recent batch jobs for existing authorities + +list::create \ + -name batch_jobs \ + -multirow batch_jobs \ + -key job_id \ + -elements { + start_time_pretty { + label "Start time" + link_url_eval {$job_url} + } + end_time_pretty { + label "End time" + } + run_time { + label "Run time" + html { align right } + } + num_actions { + label "Actions" + html { align right } + } + num_problems { + label "Problems" + html { align right } + } + actions_per_minute { + label "Actions/Minute" + html { align right } + } + short_message { + label "Message" + } + interactive_pretty { + label "Interactive" + html { align center } + } + } -filters { + authority_id {} + } -orderby { + default_value start_time_pretty,asc + start_time_pretty { + label "Start time" + orderby_desc "job_start_time desc" + orderby_asc "job_start_time asc" + default_direction asc + } + } -orderby_name bj_orderby + +set display_batch_history_p [expr $authority_exists_p && [string equal $ad_form_mode "display"]] +if { $display_batch_history_p } { + + db_multirow -extend { + job_url + start_time_pretty + end_time_pretty + interactive_pretty + short_message + actions_per_minute + run_time + } batch_jobs select_batch_jobs {} { + set job_url [export_vars -base batch-job { job_id }] + + set start_time_pretty [lc_time_fmt $start_time_ansi "%x %X"] + set end_time_pretty [lc_time_fmt $end_time_ansi "%x %X"] + + set interactive_pretty [ad_decode $interactive_p "t" "Yes" "No"] + + set short_message [string_truncate -len 30 -- $message] + + set actions_per_minute {} + if { $run_time_seconds > 0 && $num_actions > 0 } { + set actions_per_minute [expr round(60.0 * $num_actions / $run_time_seconds)] + } + set run_time [util::interval_pretty -seconds $run_time_seconds] + } + if { [exists_and_not_null get_doc_impl_id] && [exists_and_not_null process_doc_impl_id] } { + set batch_sync_run_url [export_vars -base batch-job-run { authority_id }] + } else { + # If there's neither a driver, nor any log history to display, hide any mention of batch jobs + if { ${batch_jobs:rowcount} == 0 } { + set display_batch_history_p 0 + } + } +} + +set context [list $page_title] + +if { [exists_and_not_null authority_id] } { + set num_users [lc_numeric [db_string num_users_in_auhtority { select count(*) from users where authority_id = :authority_id }]] +} else { + set num_users 0 +} +set show_users_url [export_vars -base ../users/complex-search { authority_id { target one } }] + + +# This code should be executed for non-local authorities in the following types of requests: +# - initial request of the form (display mode) +# - The form is being submitted (display mode) +set initial_request_p [empty_string_p [form get_action authority]] +set submit_p [form is_valid authority] +if { ($initial_request_p || $submit_p) && !$local_authority_p } { + + # Add parameter links for implementations in display mode + foreach element_name [auth::authority::get_sc_impl_columns] { + # Only offer link if there is an implementation chosen and that implementation has + # parameters to configure + if { [exists_and_not_null element_array($element_name)] && + ![empty_string_p [auth::driver::get_parameters -impl_id $element_array($element_name)]]} { + + set configure_url [export_vars -base authority-parameters { authority_id }] + break + } + } +} Index: openacs-4/packages/ims-ent/www/admin/batch-action.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/ims-ent/www/admin/batch-action.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/ims-ent/www/admin/batch-action.adp 9 Jun 2004 18:08:07 -0000 1.1 @@ -0,0 +1,5 @@ + +@context;noquote@ +@page_title;noquote@ + + Index: openacs-4/packages/ims-ent/www/admin/batch-action.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/ims-ent/www/admin/batch-action.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/ims-ent/www/admin/batch-action.tcl 9 Jun 2004 18:08:07 -0000 1.1 @@ -0,0 +1,94 @@ +ad_page_contract { + Display all information about a certain batch import operation. + + @author Peter marklund (peter@collaboraid.biz) + @creation-date 2003-09-10 +} { + entry_id:integer +} + +ims_enterprise::sync::job::get_entry -entry_id $entry_id -array batch_action +auth::sync::job::get -job_id $batch_action(job_id) -array batch_job + +set page_title "One batch action" + +set context [list \ + [list [export_vars -base authority { {authority_id $batch_action(authority_id)} }] \ + "$batch_job(authority_pretty_name)"] \ + [list [export_vars -base batch-job {{job_id $batch_action(job_id)}}] "One batch job"] \ + $page_title] + +ad_form -name batch_action_form \ + -mode display \ + -display_buttons {} \ + -form { + {entry_time:text(inform) + {label "Timestamp"} + } + {operation:text(inform) + {label "Action type"} + } + {username:text(inform) + {label "Username"} + } + {user_id:text(inform) + {label "User"} + } + {community_key:text(inform) + {label "Community Key"} + } + {department_key:text(inform) + {label "Department Key"} + } + {subject_key:text(inform) + {label "Subject Key"} + } + {class_key:text(inform) + {label "Class Key"} + } + {class_instance_key:text(inform) + {label "Class Instance Key"} + } + {success_p:text(inform) + {label "Success"} + } + {message:text(inform) + {label "Message"} + } + {element_messages:text(inform) + {label "Element messages"} + } + } -on_request { + foreach element_name [array names batch_action] { + # Prettify certain elements + if { [regexp {_p$} $element_name] } { + set $element_name [ad_decode $batch_action($element_name) "t" "Yes" "No"] + } elseif { [string equal $element_name "user_id"] && ![empty_string_p $batch_action($element_name)] } { + if { [catch {set $element_name [acs_community_member_link -user_id $batch_action($element_name)]}] } { + set $element_name $batch_action($element_name) + } + } elseif { [string equal $element_name "element_messages"] && ![empty_string_p $batch_action($element_name)] } { + array set messages_array $batch_action($element_name) + append $element_name "
    " + foreach message_name [array names messages_array] { + append $element_name "
  • $message_name - $messages_array($message_name)
    • " + } + append $element_name "
" + } elseif { [string equal $element_name "department_key"] && ![empty_string_p $batch_action($element_name)] } { + set dep_key $batch_action($element_name) + if { [catch {set $element_name "$batch_action($element_name)"}] } { + set $element_name $batch_action($element_name) + } + } elseif { [string equal $element_name "subject_key"] && ![empty_string_p $batch_action($element_name)] } { + if { [catch {set $element_name "$batch_action($element_name)"}] } { + set $element_name $batch_action($element_name) + } + } elseif { [string equal $element_name "class_instance_key"] && ![empty_string_p $batch_action($element_name)] } { + if { [catch {set $element_name "$batch_action($element_name)"}] } { + set $element_name $batch_action($element_name) + } + } else { + set $element_name $batch_action($element_name) + } + } + } Index: openacs-4/packages/ims-ent/www/admin/batch-document-download.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/ims-ent/www/admin/batch-document-download.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/ims-ent/www/admin/batch-document-download.tcl 9 Jun 2004 18:08:07 -0000 1.1 @@ -0,0 +1,15 @@ +ad_page_contract { + Download a whole batch xml document. + + @author Peter Marklund +} { + job_id:integer +} + +set document [db_string select_document { + select document + from auth_batch_jobs + where job_id = :job_id +}] + +ns_return 200 text/plain $document Index: openacs-4/packages/ims-ent/www/admin/batch-job-run.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/ims-ent/www/admin/batch-job-run.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/ims-ent/www/admin/batch-job-run.adp 9 Jun 2004 18:08:07 -0000 1.1 @@ -0,0 +1,9 @@ + + @context;noquote@ + @page_title;noquote@ + +

Batch sync completed.

+ +

+ » View job results +

Index: openacs-4/packages/ims-ent/www/admin/batch-job-run.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/ims-ent/www/admin/batch-job-run.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/ims-ent/www/admin/batch-job-run.tcl 9 Jun 2004 18:08:07 -0000 1.1 @@ -0,0 +1,18 @@ +ad_page_contract { + Manually runs a batch synchronization. + + @author Peter Marklund + @creation-date 2003-09-11 +} { + authority_id:integer +} + +auth::authority::get -authority_id $authority_id -array authority + +set page_title "Run batch job" +set authority_page_url [export_vars -base authority { {authority_id $authority(authority_id)} }] +set context [list [list "." "Authentication"] [list $authority_page_url "$authority(pretty_name)"] $page_title] + +set job_id [auth::authority::batch_sync -authority_id $authority_id] + +set job_url [export_vars -base batch-job { job_id }] Index: openacs-4/packages/ims-ent/www/admin/batch-job.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/ims-ent/www/admin/batch-job.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/ims-ent/www/admin/batch-job.adp 9 Jun 2004 18:08:07 -0000 1.1 @@ -0,0 +1,15 @@ + +@context;noquote@ +@page_title;noquote@ + +

+ +

+ +

+ +

+ +

+ +

Index: openacs-4/packages/ims-ent/www/admin/batch-job.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/ims-ent/www/admin/batch-job.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/ims-ent/www/admin/batch-job.tcl 9 Jun 2004 18:08:07 -0000 1.1 @@ -0,0 +1,256 @@ +ad_page_contract { + Page displaying info about a single batch job. + + @author Peter Marklund + @creation-date 2003-09-09 +} { + job_id + page:optional + success_p:boolean,optional + ba_orderby:optional +} + +auth::sync::job::get -job_id $job_id -array batch_job + +set page_title "One batch job" +set context [list \ + [list [export_vars -base authority { {authority_id $batch_job(authority_id)} }] "$batch_job(authority_pretty_name)"] $page_title] + +ad_form \ + -name batch_job_form \ + -mode display \ + -display_buttons {} \ + -form { + {authority_pretty_name:text(inform) + {label "Authority name"} + } + {job_start_time:text(inform) + {label "Start time"} + } + {job_end_time:text(inform) + {label "End time"} + } + {run_time_seconds:text(inform) + {label "Running time"} + {after_html " seconds"} + } + {interactive_p:text(inform) + {label "Interactive"} + } + {snapshot_p:text(inform) + {label "Snapshot"} + } + {message:text(inform) + {label "Message"} + } + {creation_user:text(inform) + {label "Creation user"} + } + {doc_start_time:text(inform) + {label "Document start time"} + } + {doc_end_time:text(inform) + {label "Document end time"} + } + {doc_status:text(inform) + {label "Document status"} + } + {doc_message:text(inform) + {label "Document message"} + } + {document_download:text(inform) + {label "Document"} + } + {num_actions:text(inform) + {label "Number of actions"} + } + {num_problems:text(inform) + {label "Number of problems"} + } + } -on_request { + foreach element_name [array names batch_job] { + # Make certain columns pretty for display + if { [regexp {_p$} $element_name] } { + set $element_name [ad_decode $batch_job($element_name) "t" "Yes" "No"] + } elseif { [string equal $element_name "creation_user"] && ![empty_string_p $batch_job($element_name)] } { + set $element_name [acs_community_member_link -user_id $batch_job($element_name)] + } else { + set $element_name [ad_quotehtml $batch_job($element_name)] + } + } + + set job_start_time [lc_time_fmt $batch_job(job_start_time) "%x %X"] + set job_end_time [lc_time_fmt $batch_job(job_end_time) "%x %X"] + + set document_download "download" + } + +list::create \ + -name batch_actions \ + -multirow batch_actions \ + -key entry_id \ + -page_size 100 \ + -page_query_name pagination \ + -elements { + entry_time_pretty { + label "Timestamp" + link_url_eval {$entry_url} + link_html { title "View log entry" } + } + operation { + label "Operation" + } + username { + label "Username" + link_url_col user_url + } + department_key { + label "Department Key" + link_url_col dep_url + } + subject_key { + label "Subject Key" + link_url_col sub_url + } + class_instance_key { + label "Class Instance Key" + link_url_col class_url + } + success_p { + label "Success" + display_template { + + Yes + + + No + + } + } + short_message { + label "Message" + } + } -filters { + job_id { + hide_p 1 + } + entry_time_pretty { + label "Timestamp" + hide_p 1 + } + username { + label "Username" + hide_p 1 + } + success_p { + label "Success" + values { + { Success t } + { Failure f } + } + where_clause { + success_p = :success_p + } + default_value f + } + } -orderby { + default_value entry_time_pretty,asc + entry_time_pretty { + label "Timestamp" + orderby_desc "entry_time desc" + orderby_asc "entry_time asc" + default_direction asc + } + username { + label "Username" + orderby_desc "upper(username) desc" + orderby_asc "upper(username) asc" + default_direction asc + } + department_key { + label "Department Key" + orderby_desc "upper(department_key) desc" + orderby_asc "upper(department_key) asc" + default_direction asc + } + subject_key { + label "Subject Key" + orderby_desc "upper(subject_key) desc" + orderby_asc "upper(subject_key) asc" + default_direction asc + } + class_instance_key { + label "Class Instance Key" + orderby_desc "upper(class_instance_key) desc" + orderby_asc "upper(class_instance_key) asc" + default_direction asc + } + short_message { + label "Message" + orderby_desc "upper(message) desc" + orderby_asc "upper(message) asc" + default_direction asc + } + } -orderby_name ba_orderby + + +db_multirow -extend { entry_url short_message entry_time_pretty user_url dep_url sub_url class_url } batch_actions select_batch_actions " + select entry_id, + to_char(entry_time, 'YYYY-MM-DD HH24:MI:SS') as entry_time_ansi, + operation, + username, + user_id, + department_key, + subject_key, + class_instance_key, + success_p, + message, + element_messages, + (select count(*) from users u2 where u2.user_id = user_id) as user_exists_p + from auth_batch_job_entries + where [template::list::page_where_clause -name batch_actions] + [template::list::filter_where_clauses -and -name batch_actions] + [template::list::orderby_clause -orderby -name batch_actions] +" { + set entry_url [export_vars -base batch-action { entry_id }] + + # Use message and element_messages to display one short message in the table + if { ![empty_string_p $message] } { + set short_message $message + } elseif { [llength $element_messages] == 2 } { + # Only one element message - use it + set short_message $element_messages + } elseif { [llength $element_messages] > 0 } { + # Several element messages + set short_message "Problems with elements" + } else { + set short_message "" + } + set short_message [string_truncate -len 75 -- $short_message] + + if { $user_exists_p && ![empty_string_p $user_id] } { + set user_url [acs_community_member_admin_url -user_id $user_id] + } else { + set user_url {} + } + + if ![empty_string_p $department_key] { + set dep_url "[dotlrn::get_url]/admin/department?department_key=$department_key" + } else { + set dep_url {} + } + + if ![empty_string_p $subject_key] { + set sub_url "[dotlrn::get_url]/admin/class?class_key=${department_key}.$subject_key" + } else { + set sub_url {} + } + + if ![empty_string_p $class_instance_key] { + set class_url "[dotlrn_community::get_community_url [ims_enterprise::ims_dotlrn::get_community_id $class_instance_key]]" + } else { + set class_url {} + } + + set entry_time_pretty [lc_time_fmt $entry_time_ansi "%x %X"] +} Index: openacs-4/packages/ims-ent/www/admin/batch-job.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/ims-ent/www/admin/batch-job.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/ims-ent/www/admin/batch-job.xql 9 Jun 2004 18:08:07 -0000 1.1 @@ -0,0 +1,16 @@ + + + + + + + select entry_id + from auth_batch_job_entries + where job_id = :job_id + [template::list::filter_where_clauses -and -name batch_actions] + order by entry_id + + + + + Index: openacs-4/packages/ims-ent/www/admin/index.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/ims-ent/www/admin/index.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/ims-ent/www/admin/index.adp 9 Jun 2004 18:08:08 -0000 1.1 @@ -0,0 +1,11 @@ + +@context;noquote@ +@page_title;noquote@ + +

Authorities

+ + + +

+ » Create new authority +

Index: openacs-4/packages/ims-ent/www/admin/index.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/ims-ent/www/admin/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/ims-ent/www/admin/index.tcl 9 Jun 2004 18:08:08 -0000 1.1 @@ -0,0 +1,95 @@ +ad_page_contract { + Index page for External Authentication listing + available authorities. + + @author Peter Marklund + @creation-date 2003-09-08 +} + +set page_title "Authentication" +set context [list $page_title] + +list::create \ + -name "authorities" \ + -multirow "authorities" \ + -key authority_id \ + -elements { + pretty_name { + label "Name" + link_url_eval {[export_vars -base authority { authority_id }]} + } + enabled { + label "Enabled" + html { align center } + display_template { + + + + + + + } + } + delete { + label "" + display_template { + + + Delete + + + } + sub_class narrow + } + } + +# The authority currently selected for registering users +set register_authority_id [auth::get_register_authority] + +db_multirow -extend { + enabled_p_url + sort_order_url_up + sort_order_url_down + delete_url + registration_url + registration_status +} authorities authorities_select { + select authority_id, + short_name, + pretty_name, + enabled_p, + sort_order, + (select max(sort_order) from auth_authorities) as lowest_sort_order, + (select min(sort_order) from auth_authorities) as highest_sort_order, + (select impl_pretty_name from acs_sc_impls where impl_id = auth_impl_id) as auth_impl, + (select impl_pretty_name from acs_sc_impls where impl_id = pwd_impl_id) as pwd_impl, + (select impl_pretty_name from acs_sc_impls where impl_id = register_impl_id) as reg_impl + from auth_authorities + where process_doc_impl_id = + (select asi.impl_id from acs_sc_impls asi + where asi.impl_contract_name = 'auth_sync_process') + order by sort_order +} { + set toggle_enabled_p [ad_decode $enabled_p "t" "f" "t"] + set enabled_p_url "authority-set-enabled-p?[export_vars { authority_id {enabled_p $toggle_enabled_p} }]" + set delete_url [export_vars -base authority-delete { authority_id }] + set sort_order_url_up "authority-set-sort-order?[export_vars { authority_id {direction up} }]" + set sort_order_url_down "authority-set-sort-order?[export_vars { authority_id {direction down} }]" + + if { [string equal $authority_id $register_authority_id] } { + # The authority is selected as register authority + set registration_status "selected" + } elseif { ![empty_string_p $reg_impl] } { + # The authority can be selected as register authority + set registration_status "can_select" + set registration_url [export_vars -base authority-registration-select { authority_id }] + } else { + # This authority has no account creation driver + set registration_status "cannot_select" + } +} + +set auth_package_id [apm_package_id_from_key "acs-authentication"] +set parameter_url [export_vars -base /shared/parameters { { package_id $auth_package_id } { return_url [ad_return_url] } }]