Index: openacs-4/packages/survey/survey.info =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/survey.info,v diff -u -r1.16 -r1.17 --- openacs-4/packages/survey/survey.info 9 Nov 2008 23:29:28 -0000 1.16 +++ openacs-4/packages/survey/survey.info 6 Nov 2013 07:33:53 -0000 1.17 @@ -7,14 +7,14 @@ f f - + Dave Bauer Luke Pond User defined surveys with reporting. OpenACS Expanded functionality survey package derived from simple-survey. - + Index: openacs-4/packages/survey/lib/portlet.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/lib/portlet.tcl,v diff -u -r1.1 -r1.2 --- openacs-4/packages/survey/lib/portlet.tcl 21 Jan 2005 17:24:28 -0000 1.1 +++ openacs-4/packages/survey/lib/portlet.tcl 6 Nov 2013 07:33:53 -0000 1.2 @@ -12,24 +12,24 @@ # id - CSS ID attribute value # cache - cache period, default 0 meaning no cache -if { ![exists_and_not_null package_id] - && ![exists_and_not_null base_url] } { +if { (![info exists package_id] || $package_id eq "") + && (![info exists base_url] || $base_url eq "") } { error "must specify package_id and/or base_url" } -if { ![exists_and_not_null cache] } { +if { ![info exists cache] || $cache eq "" } { set cache 0 } -if { ![exists_and_not_null display_empty_p] } { +if { ![info exists display_empty_p] || $display_empty_p eq "" } { set display_empty_p 1 } -if { ![exists_and_not_null base_url] } { +if { ![info exists base_url] || $base_url eq "" } { set base_url [lindex [site_node::get_url_from_object_id \ -object_id $package_id] 0] } -if { ![exists_and_not_null package_id] } { +if { ![info exists package_id] || $package_id eq "" } { set package_id [site_node::get_element \ -url $base_url -element object_id] } Index: openacs-4/packages/survey/sql/postgresql/survey-create.sql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/sql/postgresql/survey-create.sql,v diff -u -r1.10 -r1.11 --- openacs-4/packages/survey/sql/postgresql/survey-create.sql 19 Sep 2008 19:58:56 -0000 1.10 +++ openacs-4/packages/survey/sql/postgresql/survey-create.sql 6 Nov 2013 07:33:54 -0000 1.11 @@ -11,21 +11,21 @@ -- -- $Id$ -create function inline_0 () -returns integer as ' -begin - PERFORM acs_privilege__create_privilege(''survey_create_survey'', null, null); - PERFORM acs_privilege__create_privilege(''survey_modify_survey'', null, null); - PERFORM acs_privilege__create_privilege(''survey_delete_survey'', null, null); - PERFORM acs_privilege__create_privilege(''survey_create_question'', null, null); - PERFORM acs_privilege__create_privilege(''survey_modify_question'', null, null); - PERFORM acs_privilege__create_privilege(''survey_delete_question'', null, null); - PERFORM acs_privilege__create_privilege(''survey_take_survey'', null, null); - PERFORM acs_privilege__create_privilege(''survey_admin_survey'', null, null); +CREATE OR REPLACE FUNCTION inline_0 () RETURNS integer AS $$ +BEGIN + PERFORM acs_privilege__create_privilege('survey_create_survey', null, null); + PERFORM acs_privilege__create_privilege('survey_modify_survey', null, null); + PERFORM acs_privilege__create_privilege('survey_delete_survey', null, null); + PERFORM acs_privilege__create_privilege('survey_create_question', null, null); + PERFORM acs_privilege__create_privilege('survey_modify_question', null, null); + PERFORM acs_privilege__create_privilege('survey_delete_question', null, null); + PERFORM acs_privilege__create_privilege('survey_take_survey', null, null); + PERFORM acs_privilege__create_privilege('survey_admin_survey', null, null); return 0; -end;' language 'plpgsql'; +END; +$$ LANGUAGE plpgsql; select inline_0 (); drop function inline_0 (); @@ -47,65 +47,65 @@ -create function inline_1 () -returns integer as ' -begin +CREATE OR REPLACE FUNCTION inline_1 () RETURNS integer AS $$ +BEGIN PERFORM acs_object_type__create_type ( - ''survey'', - ''Survey'', - ''Surveys'', - ''acs_object'', - ''surveys'', - ''survey_id'', + 'survey', + 'Survey', + 'Surveys', + 'acs_object', + 'surveys', + 'survey_id', null, - ''f'', + 'f', null, null ); PERFORM acs_object_type__create_type ( - ''survey_section'', - ''Survey Section'', - ''Survey Sections'', - ''acs_object'', - ''survey_sections'', - ''section_id'', + 'survey_section', + 'Survey Section', + 'Survey Sections', + 'acs_object', + 'survey_sections', + 'section_id', null, - ''f'', + 'f', null, null ); PERFORM acs_object_type__create_type ( - ''survey_question'', - ''Survey Question'', - ''Survey Questions'', - ''acs_object'', - ''survey_questions'', - ''question_id'', + 'survey_question', + 'Survey Question', + 'Survey Questions', + 'acs_object', + 'survey_questions', + 'question_id', null, - ''f'', + 'f', null, null ); PERFORM acs_object_type__create_type ( - ''survey_response'', - ''Survey Response'', - ''Survey Responses'', - ''acs_object'', - ''survey_responses'', - ''response_id'', + 'survey_response', + 'Survey Response', + 'Survey Responses', + 'acs_object', + 'survey_responses', + 'response_id', null, - ''f'', + 'f', null, null ); return 0; -end;' language 'plpgsql'; +END; +$$ LANGUAGE plpgsql; select inline_1 (); drop function inline_1 (); @@ -293,27 +293,36 @@ -- API for survey objects -create or replace function survey__new (integer,varchar,text,boolean,boolean,boolean,boolean,boolean,varchar,varchar,integer,integer,integer) -returns integer as ' -declare - new__survey_id alias for $1; -- default null - new__name alias for $2; - new__description alias for $3; - new__description_html_p alias for $4; -- default f - new__single_response_p alias for $5; -- default f - new__editable_p alias for $6; -- default t - new__enabled_p alias for $7; -- default f - new__single_section_p alias for $8; -- default t - new__type alias for $9; -- default general - new__display_type alias for $10; - new__package_id alias for $11; - new__creation_user alias for $12; -- default null - new__context_id alias for $13; -- default null + + +-- added +select define_function_args('survey__new','survey_id;null,name,description,description_html_p;f,single_response_p;f,editable_p;t,enabled_p;f,single_section_p;t,type;general,display_type,package_id,creation_user;null,context_id;null'); + +-- +-- procedure survey__new/13 +-- +CREATE OR REPLACE FUNCTION survey__new( + new__survey_id integer, -- default null + new__name varchar, + new__description text, + new__description_html_p boolean, -- default f + new__single_response_p boolean, -- default f + new__editable_p boolean, -- default t + new__enabled_p boolean, -- default f + new__single_section_p boolean, -- default t + new__type varchar, -- default general + new__display_type varchar, + new__package_id integer, + new__creation_user integer, -- default null + new__context_id integer -- default null + +) RETURNS integer AS $$ +DECLARE v_survey_id integer; -begin +BEGIN v_survey_id := acs_object__new ( new__survey_id, - ''survey'', + 'survey', now(), new__creation_user, null, @@ -331,16 +340,25 @@ return v_survey_id; -end;' language 'plpgsql'; +END; +$$ LANGUAGE plpgsql; -create or replace function survey__remove (integer) -returns integer as ' -declare - remove__survey_id alias for $1; + + +-- added +select define_function_args('survey__remove','survey_id'); + +-- +-- procedure survey__remove/1 +-- +CREATE OR REPLACE FUNCTION survey__remove( + remove__survey_id integer +) RETURNS integer AS $$ +DECLARE v_response_row survey_responses%ROWTYPE; v_section_row survey_sections%ROWTYPE; -begin +BEGIN for v_response_row in SELECT response_id @@ -365,26 +383,36 @@ return 0; -end;' language 'plpgsql'; +END; +$$ LANGUAGE plpgsql; -- API for survey_section objects -create or replace function survey_section__new (integer,integer,varchar,text,boolean,integer,integer) -returns integer as ' -declare - new__section_id alias for $1; -- default null - new__survey_id alias for $2; -- default null - new__name alias for $3; -- default null - new__description alias for $4; -- default null - new__description_html_p alias for $5; -- default f - new__creation_user alias for $6; -- default null - new__context_id alias for $7; -- default null + + +-- added +select define_function_args('survey_section__new','section_id;null,survey_id;null,name;null,description;null,description_html_p;f,creation_user;null,context_id;null'); + +-- +-- procedure survey_section__new/7 +-- +CREATE OR REPLACE FUNCTION survey_section__new( + new__section_id integer, -- default null + new__survey_id integer, -- default null + new__name varchar, -- default null + new__description text, -- default null + new__description_html_p boolean, -- default f + new__creation_user integer, -- default null + new__context_id integer -- default null + +) RETURNS integer AS $$ +DECLARE v_section_id integer; -begin +BEGIN v_section_id := acs_object__new ( new__section_id, - ''survey_section'', + 'survey_section', now(), new__creation_user, null, @@ -398,14 +426,23 @@ return v_section_id; -end;' language 'plpgsql'; +END; +$$ LANGUAGE plpgsql; -create or replace function survey_section__remove (integer) -returns integer as ' -declare - remove__section_id alias for $1; + + +-- added +select define_function_args('survey_section__remove','section_id'); + +-- +-- procedure survey_section__remove/1 +-- +CREATE OR REPLACE FUNCTION survey_section__remove( + remove__section_id integer +) RETURNS integer AS $$ +DECLARE v_question_row survey_questions%ROWTYPE; -begin +BEGIN for v_question_row in select question_id from survey_questions where section_id=remove__section_id @@ -420,28 +457,38 @@ return 0; -end;' language 'plpgsql'; +END; +$$ LANGUAGE plpgsql; -create or replace function survey_question__new (integer,integer,integer,text,varchar,boolean,boolean,varchar,varchar,varchar,integer,integer) -returns integer as ' -declare - new__question_id alias for $1; -- default null - new__section_id alias for $2; -- default null - new__sort_order alias for $3; -- default null - new__question_text alias for $4; -- default null - new__abstract_data_type alias for $5; -- default null - new__required_p alias for $6; -- default t - new__active_p alias for $7; -- default - new__presentation_type alias for $8; -- default null - new__presentation_options alias for $9; -- default null - new__presentation_alignment alias for $10; -- default below - new__creation_user alias for $11; -- default null - new__context_id alias for $12; -- default null + + +-- added +select define_function_args('survey_question__new','question_id;null,section_id;null,sort_order;null,question_text;null,abstract_data_type;null,required_p;t,active_p,presentation_type;null,presentation_options;null,presentation_alignment;below,creation_user;null,context_id;null'); + +-- +-- procedure survey_question__new/12 +-- +CREATE OR REPLACE FUNCTION survey_question__new( + new__question_id integer, -- default null + new__section_id integer, -- default null + new__sort_order integer, -- default null + new__question_text text, -- default null + new__abstract_data_type varchar, -- default null + new__required_p boolean, -- default t + new__active_p boolean, -- default + new__presentation_type varchar, -- default null + new__presentation_options varchar, -- default null + new__presentation_alignment varchar, -- default below + new__creation_user integer, -- default null + new__context_id integer -- default null + +) RETURNS integer AS $$ +DECLARE v_question_id integer; -begin +BEGIN v_question_id := acs_object__new ( new__question_id, - ''survey_question'', + 'survey_question', now(), new__creation_user, null, @@ -461,14 +508,23 @@ return v_question_id; -end;' language 'plpgsql'; +END; +$$ LANGUAGE plpgsql; -create or replace function survey_question__remove (integer) -returns integer as ' -declare - remove__question_id alias for $1; -begin + +-- added +select define_function_args('survey_question__remove','question_id'); + +-- +-- procedure survey_question__remove/1 +-- +CREATE OR REPLACE FUNCTION survey_question__remove( + remove__question_id integer +) RETURNS integer AS $$ +DECLARE +BEGIN + delete from survey_question_responses where question_id=remove__question_id; @@ -482,27 +538,37 @@ return 0; -end;' language 'plpgsql'; +END; +$$ LANGUAGE plpgsql; -- create or replace package body survey_response -- procedure new -create or replace function survey_response__new(integer,integer,varchar,boolean,integer,varchar,integer,integer) -returns integer as ' -declare - new__response_id alias for $1; -- default null - new__survey_id alias for $2; -- default null - new__title alias for $3; -- default null - new__notify_on_comment_p alias for $4; -- default f - new__creation_user alias for $5; -- default null - new__creation_ip alias for $6; -- default null - new__context_id alias for $7; -- default null - new__initial_response_id alias for $8; -- default null + + +-- added +select define_function_args('survey_response__new','response_id;null,survey_id;null,title;null,notify_on_comment_p;f,creation_user;null,creation_ip;null,context_id;null,initial_response_id;null'); + +-- +-- procedure survey_response__new/8 +-- +CREATE OR REPLACE FUNCTION survey_response__new( + new__response_id integer, -- default null + new__survey_id integer, -- default null + new__title varchar, -- default null + new__notify_on_comment_p boolean, -- default f + new__creation_user integer, -- default null + new__creation_ip varchar, -- default null + new__context_id integer, -- default null + new__initial_response_id integer -- default null + +) RETURNS integer AS $$ +DECLARE v_response_id integer; -begin +BEGIN v_response_id := acs_object__new ( new__response_id, - ''survey_response'', + 'survey_response', now(), new__creation_user, new__creation_ip, @@ -516,45 +582,72 @@ return v_response_id; -end;' language 'plpgsql'; +END; +$$ LANGUAGE plpgsql; --function initial_response_id -create or replace function survey_response__initial_response_id(integer) -returns integer as ' -declare - p_response_id alias for $1; + + +-- added +select define_function_args('survey_response__initial_response_id','response_id'); + +-- +-- procedure survey_response__initial_response_id/1 +-- +CREATE OR REPLACE FUNCTION survey_response__initial_response_id( + p_response_id integer +) RETURNS integer AS $$ +DECLARE v_initial_response_id integer; -begin +BEGIN select into v_initial_response_id initial_response_id from survey_responses where response_id = p_response_id; if v_initial_response_id is NULL then v_initial_response_id := p_response_id; end if; return v_initial_response_id; -end;' language 'plpgsql'; +END; +$$ LANGUAGE plpgsql; -create or replace function survey_response__initial_user_id (integer) -returns integer as ' -declare - p_response_id alias for $1; + + +-- added +select define_function_args('survey_response__initial_user_id','response_id'); + +-- +-- procedure survey_response__initial_user_id/1 +-- +CREATE OR REPLACE FUNCTION survey_response__initial_user_id( + p_response_id integer +) RETURNS integer AS $$ +DECLARE v_user_id integer; -begin +BEGIN select into v_user_id o.creation_user from acs_objects o, survey_responses s where object_id = coalesce(s.initial_response_id, s.response_id) and s.response_id = p_response_id; return v_user_id; -end;' language 'plpgsql'; +END; +$$ LANGUAGE plpgsql; -- procedure delete -create or replace function survey_response__remove(integer) -returns integer as ' -declare - remove__response_id alias for $1; + + +-- added +select define_function_args('survey_response__remove','response_id'); + +-- +-- procedure survey_response__remove/1 +-- +CREATE OR REPLACE FUNCTION survey_response__remove( + remove__response_id integer +) RETURNS integer AS $$ +DECLARE v_response_row survey_responses%ROWTYPE; -begin +BEGIN for v_response_row in select response_id from survey_responses where initial_response_id=remove__response_id loop @@ -563,14 +656,23 @@ return 0; -end;' language 'plpgsql'; +END; +$$ LANGUAGE plpgsql; -create or replace function survey_response__del (integer) -returns integer as ' -declare - del__response_id alias for $1; + + +-- added +select define_function_args('survey_response__del','response_id'); + +-- +-- procedure survey_response__del/1 +-- +CREATE OR REPLACE FUNCTION survey_response__del( + del__response_id integer +) RETURNS integer AS $$ +DECLARE v_question_response_row record; -begin +BEGIN for v_question_response_row in select item_id from survey_question_responses, cr_revisions @@ -587,7 +689,8 @@ PERFORM acs_object__delete(del__response_id); return 0; -end;' language 'plpgsql'; +END; +$$ LANGUAGE plpgsql; create view survey_responses_latest as select sr.*, o.creation_date, Index: openacs-4/packages/survey/sql/postgresql/survey-drop.sql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/sql/postgresql/survey-drop.sql,v diff -u -r1.4 -r1.5 --- openacs-4/packages/survey/sql/postgresql/survey-drop.sql 20 Sep 2008 11:45:01 -0000 1.4 +++ openacs-4/packages/survey/sql/postgresql/survey-drop.sql 6 Nov 2013 07:33:54 -0000 1.5 @@ -32,35 +32,35 @@ delete from acs_objects where object_type = 'survey_section'; delete from acs_objects where object_type = 'survey'; -create function inline_0 () -returns integer as ' -begin +CREATE OR REPLACE FUNCTION inline_0 () RETURNS integer AS $$ +BEGIN - PERFORM acs_object_type__drop_type (''survey_response'',''f''); - PERFORM acs_object_type__drop_type (''survey_question'',''f''); - PERFORM acs_object_type__drop_type (''survey_section'',''f''); - PERFORM acs_object_type__drop_type (''survey'',''f''); + PERFORM acs_object_type__drop_type ('survey_response','f'); + PERFORM acs_object_type__drop_type ('survey_question','f'); + PERFORM acs_object_type__drop_type ('survey_section','f'); + PERFORM acs_object_type__drop_type ('survey','f'); - PERFORM acs_privilege__remove_child (''admin'',''survey_admin_survey''); - PERFORM acs_privilege__remove_child (''read'',''survey_take_survey''); - PERFORM acs_privilege__remove_child (''survey_admin_survey'',''survey_delete_question''); - PERFORM acs_privilege__remove_child (''survey_admin_survey'',''survey_modify_question''); - PERFORM acs_privilege__remove_child (''survey_admin_survey'',''survey_create_question''); - PERFORM acs_privilege__remove_child (''survey_admin_survey'',''survey_delete_survey''); - PERFORM acs_privilege__remove_child (''survey_admin_survey'',''survey_modify_survey''); - PERFORM acs_privilege__remove_child (''survey_admin_survey'',''survey_create_survey''); + PERFORM acs_privilege__remove_child ('admin','survey_admin_survey'); + PERFORM acs_privilege__remove_child ('read','survey_take_survey'); + PERFORM acs_privilege__remove_child ('survey_admin_survey','survey_delete_question'); + PERFORM acs_privilege__remove_child ('survey_admin_survey','survey_modify_question'); + PERFORM acs_privilege__remove_child ('survey_admin_survey','survey_create_question'); + PERFORM acs_privilege__remove_child ('survey_admin_survey','survey_delete_survey'); + PERFORM acs_privilege__remove_child ('survey_admin_survey','survey_modify_survey'); + PERFORM acs_privilege__remove_child ('survey_admin_survey','survey_create_survey'); - PERFORM acs_privilege__drop_privilege(''survey_admin_survey''); - PERFORM acs_privilege__drop_privilege(''survey_take_survey''); - PERFORM acs_privilege__drop_privilege(''survey_delete_question''); - PERFORM acs_privilege__drop_privilege(''survey_modify_question''); - PERFORM acs_privilege__drop_privilege(''survey_create_question''); - PERFORM acs_privilege__drop_privilege(''survey_delete_survey''); - PERFORM acs_privilege__drop_privilege(''survey_modify_survey''); - PERFORM acs_privilege__drop_privilege(''survey_create_survey''); + PERFORM acs_privilege__drop_privilege('survey_admin_survey'); + PERFORM acs_privilege__drop_privilege('survey_take_survey'); + PERFORM acs_privilege__drop_privilege('survey_delete_question'); + PERFORM acs_privilege__drop_privilege('survey_modify_question'); + PERFORM acs_privilege__drop_privilege('survey_create_question'); + PERFORM acs_privilege__drop_privilege('survey_delete_survey'); + PERFORM acs_privilege__drop_privilege('survey_modify_survey'); + PERFORM acs_privilege__drop_privilege('survey_create_survey'); return 0; -end;' language 'plpgsql'; +END; +$$ LANGUAGE plpgsql; select inline_0 (); drop function inline_0 (); Index: openacs-4/packages/survey/sql/postgresql/survey-notifications-drop.sql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/sql/postgresql/survey-notifications-drop.sql,v diff -u -r1.1 -r1.2 --- openacs-4/packages/survey/sql/postgresql/survey-notifications-drop.sql 20 Sep 2008 11:45:01 -0000 1.1 +++ openacs-4/packages/survey/sql/postgresql/survey-notifications-drop.sql 6 Nov 2013 07:33:54 -0000 1.2 @@ -4,44 +4,50 @@ -- @creation-date 2002-08-03 -- -- integration with Notifications -create function inline_0 () -returns integer as ' -declare + +-- +-- procedure inline_0/0 +-- +CREATE OR REPLACE FUNCTION inline_0( + +) RETURNS integer AS $$ +DECLARE impl_id integer; v_foo integer; -begin +BEGIN v_foo := acs_sc_impl_alias__delete ( - ''NotificationType'', - ''survey_response_notif_type'', - ''GetURL'' + 'NotificationType', + 'survey_response_notif_type', + 'GetURL' ); v_foo := acs_sc_impl_alias__delete ( - ''NotificationType'', - ''survey_response_notif_type'', - ''ProcessReply'' + 'NotificationType', + 'survey_response_notif_type', + 'ProcessReply' ); v_foo := acs_sc_binding__delete ( - ''NotificationType'', - ''survey_response_notif_type'' + 'NotificationType', + 'survey_response_notif_type' ); - SELECT type_id from notification_types where short_name = ''survey_response_notif'' + SELECT type_id from notification_types where short_name = 'survey_response_notif' INTO v_foo; v_foo := notification_type__delete(v_foo); v_foo := acs_sc_impl__delete ( - ''NotificationType'', - ''survey_response_notif_type'' + 'NotificationType', + 'survey_response_notif_type' ); return 0; -end;' language 'plpgsql'; +END; +$$ LANGUAGE plpgsql; select inline_0(); Index: openacs-4/packages/survey/sql/postgresql/survey-notifications-init.sql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/sql/postgresql/survey-notifications-init.sql,v diff -u -r1.2 -r1.3 --- openacs-4/packages/survey/sql/postgresql/survey-notifications-init.sql 30 Nov 2002 17:49:43 -0000 1.2 +++ openacs-4/packages/survey/sql/postgresql/survey-notifications-init.sql 6 Nov 2013 07:33:54 -0000 1.3 @@ -4,47 +4,52 @@ -- @creation-date 2002-08-03 -- -- integration with Notifications -create function inline_0 () -returns integer as ' -declare + +-- +-- procedure inline_0/0 +-- +CREATE OR REPLACE FUNCTION inline_0( + +) RETURNS integer AS $$ +DECLARE impl_id integer; v_foo integer; -begin +BEGIN -- the notification type impl impl_id := acs_sc_impl__new ( - ''NotificationType'', - ''survey_response_notif_type'', - ''survey'' + 'NotificationType', + 'survey_response_notif_type', + 'survey' ); v_foo := acs_sc_impl_alias__new ( - ''NotificationType'', - ''survey_response_notif_type'', - ''GetURL'', - ''survey::notification::get_url'', - ''TCL'' + 'NotificationType', + 'survey_response_notif_type', + 'GetURL', + 'survey::notification::get_url', + 'TCL' ); v_foo := acs_sc_impl_alias__new ( - ''NotificationType'', - ''survey_response_notif_type'', - ''ProcessReply'', - ''survey::notification::process_reply'', - ''TCL'' + 'NotificationType', + 'survey_response_notif_type', + 'ProcessReply', + 'survey::notification::process_reply', + 'TCL' ); perform acs_sc_binding__new ( - ''NotificationType'', - ''survey_response_notif_type'' + 'NotificationType', + 'survey_response_notif_type' ); v_foo:= notification_type__new ( NULL, impl_id, - ''survey_response_notif'', - ''Survey Response Notification'', - ''Notifications for Survey'', + 'survey_response_notif', + 'Survey Response Notification', + 'Notifications for Survey', current_timestamp, NULL, NULL, @@ -55,14 +60,15 @@ insert into notification_types_intervals (type_id, interval_id) select v_foo, interval_id - from notification_intervals where name in (''instant'',''hourly'',''daily''); + from notification_intervals where name in ('instant','hourly','daily'); insert into notification_types_del_methods (type_id, delivery_method_id) select v_foo, delivery_method_id - from notification_delivery_methods where short_name in (''email''); + from notification_delivery_methods where short_name in ('email'); return 0; -end;' language 'plpgsql'; +END; +$$ LANGUAGE plpgsql; select inline_0(); Index: openacs-4/packages/survey/tcl/survey-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/tcl/survey-procs.tcl,v diff -u -r1.8 -r1.9 --- openacs-4/packages/survey/tcl/survey-procs.tcl 9 Nov 2008 23:29:28 -0000 1.8 +++ openacs-4/packages/survey/tcl/survey-procs.tcl 6 Nov 2013 07:33:54 -0000 1.9 @@ -29,7 +29,7 @@ } { upvar survey_info survey_info - if {[empty_string_p $survey_id]} { + if {$survey_id eq ""} { db_1row lookup_survey_id "" } @@ -41,7 +41,7 @@ return } # If it's a single-section survey, look up the section_id - if {[empty_string_p $section_id] && $survey_info(single_section_p) == "t"} { + if {$section_id eq "" && $survey_info(single_section_p) == "t"} { db_1row lookup_single_section_id "" set survey_info(section_id) $section_id } @@ -61,7 +61,7 @@ {response_id ""} } {Returns a string of HTML to display for a question, suitable for embedding in a form. The form variable is of the form \"response_to_question.\$question_id} { - if {![empty_string_p $response_id]} { + if {$response_id ne ""} { set edit_previous_response_p "t" } else { set edit_previous_response_p "f" @@ -77,7 +77,7 @@ } append html $question_text - if { $presentation_alignment == "below" } { + if { $presentation_alignment eq "below" } { append html "
" } else { append html " " @@ -86,13 +86,13 @@ set user_value "" if {$edit_previous_response_p == "t"} { - set user_id [ad_get_user_id] + set user_id [ad_conn user_id] set count 0 db_foreach prev_response_query {} { incr count - if {$presentation_type == "checkbox"} { + if {$presentation_type eq "checkbox"} { set selected_choices($choice_id) "t" } } if_no_rows { @@ -115,14 +115,14 @@ } "textbox" { if {$edit_previous_response_p == "t"} { - if {$abstract_data_type == "number" || $abstract_data_type == "integer"} { + if {$abstract_data_type eq "number" || $abstract_data_type eq "integer"} { set user_value $number_answer } else { set user_value $varchar_answer } } - append html "" + append html "" } "textarea" { if {$edit_previous_response_p == "t"} { @@ -141,12 +141,12 @@ append html "[ad_dateentrywidget $element_name $user_value]" } "select" { - if { $abstract_data_type == "boolean" } { + if { $abstract_data_type eq "boolean" } { if {$edit_previous_response_p == "t"} { set user_value $boolean_answer } - if {![empty_string_p $presentation_options]} { + if {$presentation_options ne ""} { set options_list [split $presentation_options "/"] set choice_t [lindex $options_list 0] set choice_f [lindex $options_list 1] @@ -183,11 +183,11 @@ } "radio" { - if { $abstract_data_type == "boolean" } { + if { $abstract_data_type eq "boolean" } { if {$edit_previous_response_p == "t"} { set user_value $boolean_answer } - if {![empty_string_p $presentation_options]} { + if {$presentation_options ne ""} { set options_list [split $presentation_options "/"] set choice_t [lindex $options_list 0] set choice_f [lindex $options_list 1] @@ -212,7 +212,7 @@ } } } - if { $presentation_alignment == "beside" } { + if { $presentation_alignment eq "beside" } { append html [join $choices " "] } else { append html "

\n[join $choices "
\n"]\n

" @@ -228,7 +228,7 @@ lappend choices " $label" } } - if { $presentation_alignment == "beside" } { + if { $presentation_alignment eq "beside" } { append html [join $choices " "] } else { append html "

\n[join $choices "
\n"]\n

" @@ -260,7 +260,7 @@ continue } - if $html_p { + if {$html_p} { append return_string "# $sort_order: $question_text

" append return_string "[ad_enhanced_text_to_html "$clob_answer $number_answer $varchar_answer $date_answer"]" } else { @@ -270,23 +270,23 @@ append return_string "[ad_html_to_text -- [ad_enhanced_text_to_html "$clob_answer $number_answer $varchar_answer $date_answer"]]" } - if {![empty_string_p $attachment_answer]} { + if {$attachment_answer ne ""} { set package_id [ad_conn package_id] set filename [db_string get_filename {}] - append return_string "[_ survey.Uploaded_file] \"$filename\"" + append return_string "[_ survey.Uploaded_file] \"$filename\"" } - if {$choice_id != 0 && ![empty_string_p $choice_id] && $question_id != $question_id_previous} { + if {$choice_id != 0 && $choice_id ne "" && $question_id != $question_id_previous} { set label_list [db_list survey_label_list ""] append return_string "[join $label_list ", "]" } - if ![empty_string_p $boolean_answer] { + if {$boolean_answer ne ""} { append return_string "[survey_decode_boolean_answer -response $boolean_answer -question_id $question_id]" } - if $html_p { + if {$html_p} { append return_string "

" } else { append return_string "\n\n" @@ -327,12 +327,12 @@ } { set user_id [ad_conn user_id] db_1row get_question_details {} - if {![empty_string_p $new_section_id]} { + if {$new_section_id ne ""} { set section_id $new_section_id } set old_question_id $question_id - if {[empty_string_p $new_section_id]} { + if {$new_section_id eq ""} { set after $sort_order set new_sort_order [expr {$after + 1}] db_dml renumber_sort_orders {} @@ -362,12 +362,12 @@ same package instance } { - if {[empty_string_p $package_id]} { + if {$package_id eq ""} { set package_id [ad_conn package_id] } db_1row get_survey_info {} - if {![empty_string_p $new_name]} { + if {$new_name ne ""} { set name $new_name } set user_id [ad_conn user_id] @@ -379,7 +379,7 @@ set new_section_id [db_exec_plsql section_create {}] set new_section_ids($section_id) $new_section_id - if {![empty_string_p $description]} { + if {$description ne ""} { db_dml set_section_description {} } } @@ -405,10 +405,10 @@ set community_url [ad_conn package_url] #dotlrn specific info - set dotlrn_installed_p [expr [apm_package_installed_p dotlrn] && [apm_package_enabled_p dotlrn]] + set dotlrn_installed_p [expr {[apm_package_installed_p dotlrn] && [apm_package_enabled_p dotlrn]}] if { $dotlrn_installed_p } { # Cannot do this unless dotlrn package is installed and enabled - if { [empty_string_p [dotlrn_community::get_community_id]] } { + if { [dotlrn_community::get_community_id] eq "" } { set dotlrn_installed_p 0 } } @@ -418,7 +418,7 @@ set community_id [dotlrn_community::get_community_id] set segment_id [dotlrn_community::get_rel_segment_id -community_id $community_id -rel_type "dotlrn_member_rel"] set community_name [dotlrn_community::get_community_name $community_id] - set community_url "[ad_parameter -package_id [ad_acs_kernel_id] SystemURL][dotlrn_community::get_community_url $community_id]" + set community_url "[parameter::get -package_id [ad_acs_kernel_id] -parameter SystemURL][dotlrn_community::get_community_url $community_id]" } db_1row get_response_info {} @@ -430,7 +430,7 @@ append notif_html "Group: $community_name
" } - set comm_url "[ad_parameter -package_id [ad_acs_kernel_id] SystemURL][acs_community_member_url -user_id $responding_user_id]" + set comm_url "[parameter::get -package_id [ad_acs_kernel_id] -parameter SystemURL][acs_community_member_url -user_id $responding_user_id]" append notif_text "\n[_ survey.lt_Survey_survey_name]" append notif_text "\n[_ survey.lt_Survey_survey_Res]\n" append notif_text "\n[_ survey.lt_Survey_survey_notif_intro]\n" @@ -487,12 +487,12 @@ @param -question_id question_id of question response is from } { set presentation_options [db_string get_presentation_options {}] - if {[empty_string_p $presentation_options]} { + if {$presentation_options eq ""} { set presentation_options "True/False" } - if {![empty_string_p $response]} { + if {$response ne ""} { set options_list [split $presentation_options "/"] if {$response=="t"} { Index: openacs-4/packages/survey/www/index.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/index.tcl,v diff -u -r1.3 -r1.4 --- openacs-4/packages/survey/www/index.tcl 1 Mar 2005 00:01:44 -0000 1.3 +++ openacs-4/packages/survey/www/index.tcl 6 Nov 2013 07:33:54 -0000 1.4 @@ -17,7 +17,7 @@ set user_id [auth::require_login] -set admin_p [ad_permission_p $package_id admin] +set admin_p [permission::permission_p -object_id $package_id -privilege admin] db_multirow surveys survey_select {} Index: openacs-4/packages/survey/www/one-respondent.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/one-respondent.tcl,v diff -u -r1.7 -r1.8 --- openacs-4/packages/survey/www/one-respondent.tcl 5 Mar 2008 21:20:39 -0000 1.7 +++ openacs-4/packages/survey/www/one-respondent.tcl 6 Nov 2013 07:33:54 -0000 1.8 @@ -18,7 +18,7 @@ } -validate { survey_exists -requires {survey_id} { - if ![db_0or1row survey_exists {}] { + if {![db_0or1row survey_exists {}]} { ad_complain "[_ survey.lt_Survey_section_id_does]" } } Index: openacs-4/packages/survey/www/one-survey.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/one-survey.tcl,v diff -u -r1.3 -r1.4 --- openacs-4/packages/survey/www/one-survey.tcl 1 Mar 2005 00:01:44 -0000 1.3 +++ openacs-4/packages/survey/www/one-survey.tcl 6 Nov 2013 07:33:54 -0000 1.4 @@ -17,9 +17,9 @@ set user_id [auth::require_login] -set take_survey_p [ad_permission_p $survey_id survey_take_survey] +set take_survey_p [permission::permission_p -object_id $survey_id -privilege survey_take_survey] -set admin_p [ad_permission_p $survey_id survey_admin_survey] +set admin_p [permission::permission_p -object_id $survey_id -privilege survey_admin_survey] db_multirow survey_details get_survey_details {} Index: openacs-4/packages/survey/www/process-response.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/process-response.tcl,v diff -u -r1.14 -r1.15 --- openacs-4/packages/survey/www/process-response.tcl 1 Mar 2005 00:01:44 -0000 1.14 +++ openacs-4/packages/survey/www/process-response.tcl 6 Nov 2013 07:33:54 -0000 1.15 @@ -24,7 +24,7 @@ } -validate { section_exists -requires { section_id } { - if ![db_0or1row section_exists {}] { + if {![db_0or1row section_exists {}]} { ad_complain "[_ survey.lt_Section_section_id_do]" } } @@ -58,24 +58,24 @@ # but first value for 'choice' abstract_data_type - see ad_page_contract # doc and code for more info. # - if { [exists_and_not_null response_to_question($question_id)] } { - if {$abstract_data_type != "choice"} { + if { ([info exists response_to_question($question_id)] && $response_to_question($question_id) ne "") } { + if {$abstract_data_type ne "choice"} { set response_to_question($question_id) [join $response_to_question($question_id)] } else { - if { [empty_string_p [lindex $response_to_question($question_id) 0 ] ] } { + if { [lindex $response_to_question($question_id) 0 ] eq "" } { set response_to_question($question_id) "" } } } - if { $abstract_data_type == "date" } { + if { $abstract_data_type eq "date" } { if [catch { set response_to_question($question_id) [validate_ad_dateentrywidget "" response_to_question.$question_id [ns_getform]]} errmsg] { ad_complain "$errmsg: [_ survey.lt_Please_make_sure_your]" } } - if { [exists_and_not_null response_to_question($question_id)] } { + if { ([info exists response_to_question($question_id)] && $response_to_question($question_id) ne "") } { set response_value [string trim $response_to_question($question_id)] } elseif {$required_p == "t"} { @@ -86,14 +86,14 @@ set response_value "" } - if {![empty_string_p $response_value]} { - if { $abstract_data_type == "number" } { + if {$response_value ne ""} { + if { $abstract_data_type eq "number" } { if { ![regexp {^(-?[0-9]+\.)?[0-9]+$} $response_value] } { ad_complain "[_ survey.lt_The_response_to_ques_n]" continue } - } elseif { $abstract_data_type == "integer" } { + } elseif { $abstract_data_type eq "integer" } { if { ![regexp {^[0-9]+$} $response_value] } { ad_complain "[_ survey.lt_The_response_to_ques_i]" @@ -102,7 +102,7 @@ } } - if { $abstract_data_type == "blob" } { + if { $abstract_data_type eq "blob" } { set tmp_filename $response_to_question($question_id.tmpfile) set n_bytes [file size $tmp_filename] if { $n_bytes == 0 && $required_p == "t" } { @@ -129,7 +129,7 @@ survey_name:onerow } -ad_require_permission $survey_id survey_take_survey +permission::require_permission -object_id $survey_id -privilege survey_take_survey set user_id [ad_conn user_id] @@ -177,19 +177,19 @@ switch -- $abstract_data_type { "choice" { - if { $presentation_type == "checkbox" } { + if { $presentation_type eq "checkbox" } { # Deal with multiple responses. set checked_responses $response_to_question($question_id) foreach response_value $checked_responses { - if { [empty_string_p $response_value] } { + if { $response_value eq "" } { set response_value [db_null] } db_dml survey_question_response_checkbox_insert "insert into survey_question_responses (response_id, question_id, choice_id) values (:response_id, :question_id, :response_value)" } } else { - if { [empty_string_p $response_value] || [empty_string_p [lindex $response_value 0]] } { + if { $response_value eq "" || [lindex $response_value 0] eq "" } { set response_value [db_null] } @@ -202,7 +202,7 @@ values (:response_id, :question_id, :response_value)" } "boolean" { - if { [empty_string_p $response_value] } { + if { $response_value eq "" } { set response_value [db_null] } @@ -211,14 +211,14 @@ } "integer" - "number" { - if { [empty_string_p $response_value] } { + if { $response_value eq "" } { set response_value [db_null] } db_dml survey_question_response_integer_insert "insert into survey_question_responses (response_id, question_id, number_answer) values (:response_id, :question_id, :response_value)" } "text" { - if { [empty_string_p $response_value] } { + if { $response_value eq "" } { set response_value [db_null] } @@ -229,7 +229,7 @@ returning clob_answer into :1" -clobs [list $response_value] } "date" { - if { [empty_string_p $response_value] } { + if { $response_value eq "" } { set response_value [db_null] } @@ -238,7 +238,7 @@ } "blob" { - if { ![empty_string_p $response_value] } { + if { $response_value ne "" } { # this stuff only makes sense to do if we know the file exists set tmp_filename $response_to_question($question_id.tmpfile) @@ -249,7 +249,7 @@ set n_bytes [file size $tmp_filename] # strip off the C:\directories... crud and just get the file name - if ![regexp {([^/\\]+)$} $response_value match client_filename] { + if {![regexp {([^/\\]+)$} $response_value match client_filename]} { # couldn't find a match set client_filename $response_value } @@ -279,7 +279,7 @@ } -if {[info exists return_url] && ![empty_string_p $return_url]} { +if {[info exists return_url] && $return_url ne ""} { ad_returnredirect "$return_url" ad_script_abort } else { Index: openacs-4/packages/survey/www/respond.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/respond.tcl,v diff -u -r1.8 -r1.9 --- openacs-4/packages/survey/www/respond.tcl 1 Mar 2005 00:01:44 -0000 1.8 +++ openacs-4/packages/survey/www/respond.tcl 6 Nov 2013 07:33:54 -0000 1.9 @@ -18,7 +18,7 @@ } -validate { survey_exists -requires {survey_id} { - if ![db_0or1row survey_exists {}] { + if {![db_0or1row survey_exists {}]} { ad_complain "[_ survey.lt_Survey_survey_id_do_no]" } set user_id [auth::require_login] @@ -56,7 +56,7 @@ return_url:onerow } -ad_require_permission $survey_id survey_take_survey +permission::require_permission -object_id $survey_id -privilege survey_take_survey set context $name set button_label "[_ survey.Submit_response]" @@ -84,10 +84,10 @@ # executing the survey associated with the logic # after the survey is completed # - if ![info exists return_url] { + if {![info exists return_url]} { set return_url {} } } -set form_vars [export_form_vars section_id survey_id new_response_id] +set form_vars [export_vars -form {section_id survey_id new_response_id}] ad_return_template Index: openacs-4/packages/survey/www/view-attachment.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/view-attachment.tcl,v diff -u -r1.2 -r1.3 --- openacs-4/packages/survey/www/view-attachment.tcl 12 Mar 2003 01:05:39 -0000 1.2 +++ openacs-4/packages/survey/www/view-attachment.tcl 6 Nov 2013 07:33:54 -0000 1.3 @@ -20,7 +20,7 @@ attachment_exists -requires {response_id question_id} { db_1row get_file_info {} - if { [empty_string_p $file_type] } { + if { $file_type eq "" } { ad_complain "[_ survey.lt_Couldnt_find_attachment]" } } Index: openacs-4/packages/survey/www/admin/description-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/description-edit.tcl,v diff -u -r1.5 -r1.6 --- openacs-4/packages/survey/www/admin/description-edit.tcl 21 Jan 2005 17:24:28 -0000 1.5 +++ openacs-4/packages/survey/www/admin/description-edit.tcl 6 Nov 2013 07:33:54 -0000 1.6 @@ -14,7 +14,7 @@ } -ad_require_permission $survey_id survey_modify_survey +permission::require_permission -object_id $survey_id -privilege survey_modify_survey ad_form -name edit-survey -form { survey_id:key {description:text(textarea) {label "[_ survey.Survey_Description]"} {html {rows 10 cols 65}}} @@ -47,10 +47,10 @@ } db_dml survey_update_description "" - ad_returnredirect "one?[export_url_vars survey_id]" + ad_returnredirect "one?[export_vars -url {survey_id}]" ad_script_abort } -set context [list [list "one?[export_url_vars survey_id]" $survey_info(name)] "[_ survey.Edit_Description]"] +set context [list [list "one?[export_vars -url {survey_id}]" $survey_info(name)] "[_ survey.Edit_Description]"] ad_return_template Index: openacs-4/packages/survey/www/admin/index.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/index.tcl,v diff -u -r1.2 -r1.3 --- openacs-4/packages/survey/www/admin/index.tcl 21 Jan 2005 17:24:28 -0000 1.2 +++ openacs-4/packages/survey/www/admin/index.tcl 6 Nov 2013 07:33:54 -0000 1.3 @@ -14,7 +14,7 @@ set package_id [ad_conn package_id] # bounce the user if they don't have permission to admin surveys -ad_require_permission $package_id survey_admin_survey +permission::require_permission -object_id $package_id -privilege survey_admin_survey set disabled_header_written_p 0 Index: openacs-4/packages/survey/www/admin/modify-responses-2.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/modify-responses-2.tcl,v diff -u -r1.1 -r1.2 --- openacs-4/packages/survey/www/admin/modify-responses-2.tcl 16 Sep 2002 00:00:24 -0000 1.1 +++ openacs-4/packages/survey/www/admin/modify-responses-2.tcl 6 Nov 2013 07:33:54 -0000 1.2 @@ -18,7 +18,7 @@ {choice_id_list ""} } -ad_require_permission $section_id survey_modify_question +permission::require_permission -object_id $section_id -privilege survey_modify_question db_transaction { @@ -46,6 +46,6 @@ get_survey_info -section_id $section_id set survey_id $survey_info(survey_id) -ad_returnredirect "one?[export_url_vars survey_id]" +ad_returnredirect "one?[export_vars -url {survey_id}]" Index: openacs-4/packages/survey/www/admin/modify-responses.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/modify-responses.tcl,v diff -u -r1.2 -r1.3 --- openacs-4/packages/survey/www/admin/modify-responses.tcl 12 Mar 2003 01:05:52 -0000 1.2 +++ openacs-4/packages/survey/www/admin/modify-responses.tcl 6 Nov 2013 07:33:54 -0000 1.3 @@ -15,7 +15,7 @@ } -ad_require_permission $section_id survey_modify_question +permission::require_permission -object_id $section_id -privilege survey_modify_question get_survey_info -section_id $section_id set survey_id $survey_info(survey_id) @@ -68,14 +68,14 @@ doc_return 200 text/html "[ad_header "[_ survey.Modify_Responses]"]

$survey_name

-[ad_context_bar [list "one?[export_url_vars survey_id]" $survey_info(name)] "[_ survey.lt_Modify_Question_Respo]"] +[ad_context_bar [list "one?[export_vars -url {survey_id}]" $survey_info(name)] "[_ survey.lt_Modify_Question_Respo]"]
[_ survey.Question]: $question_text

-[export_form_vars section_id question_id choice_id_list variable_id_list] +[export_vars -form {section_id question_id choice_id_list variable_id_list}] $table_html

Index: openacs-4/packages/survey/www/admin/name-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/name-edit.tcl,v diff -u -r1.5 -r1.6 --- openacs-4/packages/survey/www/admin/name-edit.tcl 21 Jan 2005 17:24:28 -0000 1.5 +++ openacs-4/packages/survey/www/admin/name-edit.tcl 6 Nov 2013 07:33:54 -0000 1.6 @@ -18,7 +18,7 @@ get_survey_info -survey_id $survey_id set survey_name "$survey_info(name)" -ad_require_permission $survey_id survey_modify_survey +permission::require_permission -object_id $survey_id -privilege survey_modify_survey ad_form -name edit-name -form { survey_id:key Index: openacs-4/packages/survey/www/admin/one-respondent.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/one-respondent.tcl,v diff -u -r1.5 -r1.6 --- openacs-4/packages/survey/www/admin/one-respondent.tcl 5 Mar 2008 21:43:07 -0000 1.5 +++ openacs-4/packages/survey/www/admin/one-respondent.tcl 6 Nov 2013 07:33:54 -0000 1.6 @@ -15,7 +15,7 @@ } -ad_require_permission $survey_id survey_admin_survey +permission::require_permission -object_id $survey_id -privilege survey_admin_survey get_survey_info -survey_id $survey_id set survey_name $survey_info(name) Index: openacs-4/packages/survey/www/admin/one.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/one.tcl,v diff -u -r1.9 -r1.10 --- openacs-4/packages/survey/www/admin/one.tcl 5 Mar 2008 21:43:07 -0000 1.9 +++ openacs-4/packages/survey/www/admin/one.tcl 6 Nov 2013 07:33:54 -0000 1.10 @@ -17,7 +17,7 @@ set package_id [ad_conn package_id] -ad_require_permission $package_id survey_admin_survey +permission::require_permission -object_id $package_id -privilege survey_admin_survey # Get the survey information. get_survey_info -survey_id $survey_id @@ -50,7 +50,7 @@ # allow site-wide admins to enable/disable surveys directly from here -set target "one?[export_url_vars survey_id]" +set target "one?[export_vars -url {survey_id}]" set enabled_p $survey_info(enabled_p) set toggle_enabled_url "survey-toggle?[export_vars {survey_id enabled_p target}]" if {$enabled_p == "t"} { Index: openacs-4/packages/survey/www/admin/process-response.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/process-response.tcl,v diff -u -r1.4 -r1.5 --- openacs-4/packages/survey/www/admin/process-response.tcl 1 Mar 2005 00:01:44 -0000 1.4 +++ openacs-4/packages/survey/www/admin/process-response.tcl 6 Nov 2013 07:33:54 -0000 1.5 @@ -25,7 +25,7 @@ } -validate { section_exists -requires { section_id } { - if ![db_0or1row section_exists {}] { + if {![db_0or1row section_exists {}]} { ad_complain "Section $section_id does not exist" } } @@ -59,23 +59,23 @@ # but first value for 'choice' abstract_data_type - see ad_page_contract # doc and code for more info. # - if { [exists_and_not_null response_to_question($question_id)] } { - if {$abstract_data_type != "choice"} { + if { ([info exists response_to_question($question_id)] && $response_to_question($question_id) ne "") } { + if {$abstract_data_type ne "choice"} { set response_to_question($question_id) [join $response_to_question($question_id)] } else { - if { [empty_string_p [lindex $response_to_question($question_id) 0 ] ] } { + if { [lindex $response_to_question($question_id) 0 ] eq "" } { set response_to_question($question_id) "" } } } - if { $abstract_data_type == "date" } { + if { $abstract_data_type eq "date" } { if [catch { set response_to_question($question_id) [validate_ad_dateentrywidget "" response_to_question.$question_id [ns_getform]]} errmsg] { ad_complain "$errmsg: Please make sure your dates are valid." } } - if { [exists_and_not_null response_to_question($question_id)] } { + if { ([info exists response_to_question($question_id)] && $response_to_question($question_id) ne "") } { set response_value [string trim $response_to_question($question_id)] } elseif {$required_p == "t"} { @@ -85,7 +85,7 @@ # it is not required to enter a file. Instead, the # file from the prior response will be used. - if { $abstract_data_type != "blob" || [empty_string_p $initial_response_id]} { + if { $abstract_data_type ne "blob" || $initial_response_id eq ""} { lappend questions_with_missing_responses $question_text continue } @@ -95,14 +95,14 @@ set response_value "" } - if {![empty_string_p $response_value]} { - if { $abstract_data_type == "number" } { + if {$response_value ne ""} { + if { $abstract_data_type eq "number" } { if { ![regexp {^(-?[0-9]+\.)?[0-9]+$} $response_value] } { ad_complain "The response to \"$question_text\" must be a number. Your answer was \"$response_value\"." continue } - } elseif { $abstract_data_type == "integer" } { + } elseif { $abstract_data_type eq "integer" } { if { ![regexp {^[0-9]+$} $response_value] } { ad_complain "The response to \"$question_text\" must be an integer. Your answer was \"$response_value\"." @@ -111,11 +111,11 @@ } } - if { $abstract_data_type == "blob" } { + if { $abstract_data_type eq "blob" } { set tmp_filename $response_to_question($question_id.tmpfile) set n_bytes [file size $tmp_filename] if { $n_bytes == 0 && $required_p == "t" && - [empty_string_p $initial_response_id]} { + $initial_response_id eq ""} { ad_complain "Your file is zero-length. Either you attempted to upload a zero length file, a file which does not exist, or something went wrong during the transfer." } @@ -139,7 +139,7 @@ survey_name:onerow } -ad_require_permission $survey_id survey_take_survey +permission::require_permission -object_id $survey_id -privilege survey_take_survey set user_id [ad_conn user_id] @@ -202,19 +202,19 @@ switch -- $abstract_data_type { "choice" { - if { $presentation_type == "checkbox" } { + if { $presentation_type eq "checkbox" } { # Deal with multiple responses. set checked_responses $response_to_question($question_id) foreach response_value $checked_responses { - if { [empty_string_p $response_value] } { + if { $response_value eq "" } { set response_value [db_null] } db_dml survey_question_response_checkbox_insert "insert into survey_question_responses (response_id, question_id, choice_id) values (:response_id, :question_id, :response_value)" } } else { - if { [empty_string_p $response_value] || [empty_string_p [lindex $response_value 0]] } { + if { $response_value eq "" || [lindex $response_value 0] eq "" } { set response_value [db_null] } @@ -227,7 +227,7 @@ values (:response_id, :question_id, :response_value)" } "boolean" { - if { [empty_string_p $response_value] } { + if { $response_value eq "" } { set response_value [db_null] } @@ -236,14 +236,14 @@ } "integer" - "number" { - if { [empty_string_p $response_value] } { + if { $response_value eq "" } { set response_value [db_null] } db_dml survey_question_response_integer_insert "insert into survey_question_responses (response_id, question_id, number_answer) values (:response_id, :question_id, :response_value)" } "text" { - if { [empty_string_p $response_value] } { + if { $response_value eq "" } { set response_value [db_null] } @@ -254,7 +254,7 @@ returning clob_answer into :1" -clobs [list $response_value] } "date" { - if { [empty_string_p $response_value] } { + if { $response_value eq "" } { set response_value [db_null] } @@ -263,7 +263,7 @@ } "blob" { - if { ![empty_string_p $response_value] } { + if { $response_value ne "" } { # this stuff only makes sense to do if we know the file exists set tmp_filename $response_to_question($question_id.tmpfile) @@ -274,7 +274,7 @@ set n_bytes [file size $tmp_filename] # strip off the C:\directories... crud and just get the file name - if ![regexp {([^/\\]+)$} $response_value match client_filename] { + if {![regexp {([^/\\]+)$} $response_value match client_filename]} { # couldn't find a match set client_filename $response_value } @@ -293,7 +293,7 @@ } else { # There was no response. - if {![empty_string_p $initial_response_id]} { + if {$initial_response_id ne ""} { # There was a prior response # Get the revision_id for this question from the # prior question. @@ -313,7 +313,7 @@ } -if {[info exists return_url] && ![empty_string_p $return_url]} { +if {[info exists return_url] && $return_url ne ""} { ad_returnredirect "$return_url" ad_script_abort } else { Index: openacs-4/packages/survey/www/admin/question-active-toggle.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/question-active-toggle.tcl,v diff -u -r1.1 -r1.2 --- openacs-4/packages/survey/www/admin/question-active-toggle.tcl 16 Sep 2002 00:00:24 -0000 1.1 +++ openacs-4/packages/survey/www/admin/question-active-toggle.tcl 6 Nov 2013 07:33:54 -0000 1.2 @@ -14,7 +14,7 @@ } -ad_require_permission $section_id survey_admin_survey +permission::require_permission -object_id $section_id -privilege survey_admin_survey db_dml survey_question_required_toggle "update survey_questions set active_p = util.logical_negation(active_p) where section_id = :section_id @@ -23,5 +23,5 @@ db_release_unused_handles get_survey_info -section_id $section_id set survey_id $survey_info(survey_id) -ad_returnredirect "one?[export_url_vars survey_id]" +ad_returnredirect "one?[export_vars -url {survey_id}]" Index: openacs-4/packages/survey/www/admin/question-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/question-add-2.tcl,v diff -u -r1.4 -r1.5 --- openacs-4/packages/survey/www/admin/question-add-2.tcl 21 Jan 2005 17:24:28 -0000 1.4 +++ openacs-4/packages/survey/www/admin/question-add-2.tcl 6 Nov 2013 07:33:54 -0000 1.5 @@ -29,8 +29,8 @@ } set package_id [ad_conn package_id] -set user_id [ad_get_user_id] -ad_require_permission $package_id survey_create_question +set user_id [ad_conn user_id] +permission::require_permission -object_id $package_id -privilege survey_create_question set question_id [db_nextval acs_object_id_seq] get_survey_info -section_id $section_id @@ -63,12 +63,12 @@ # set exception_count 0 # set exception_text "" -# if { $type != "general" && $type != "scored" } { +# if { $type ne "general" && $type ne "scored" } { # incr exception_count # append exception_text "
  • Surveys of type $type are not currently available\n" # } -# if { $presentation_type == "upload_file" } { +# if { $presentation_type eq "upload_file" } { # # incr exception_count # # append exception_text "
  • The presentation type: upload file is not supported at this time." @@ -81,7 +81,7 @@ # Survey-type specific question settings -if { $type == "scored" } { +if { $type eq "scored" } { db_1row count_variable_names "" @@ -108,9 +108,9 @@ append response_fields "\n" set response_type_html "" set presentation_options_html "" - set form_var_list [export_form_vars section_id question_id question_text presentation_type after required_p active_p type n_variables variable_id_list] + set form_var_list [export_vars -form {section_id question_id question_text presentation_type after required_p active_p type n_variables variable_id_list}] -} elseif { $type == "general" } { +} elseif { $type eq "general" } { # Display presentation options for sizing text input fields and textareas. @@ -178,6 +178,6 @@ ad_form -extend -name create-question-2 -form { {presentation_alignment:text(radio) {options {{"[_ survey.Beside_the_question]" beside} {"[_ survey.Below_the_question]" below}}} {value below} {label "[_ survey.lt_Presentation_Alignmen]"}} } -set context [list [list "one?[export_url_vars survey_id]" $survey_info(name)] "[_ survey.Add_A_Question]"] +set context [list [list "one?[export_vars -url {survey_id}]" $survey_info(name)] "[_ survey.Add_A_Question]"] ad_return_template Index: openacs-4/packages/survey/www/admin/question-add-3.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/question-add-3.tcl,v diff -u -r1.5 -r1.6 --- openacs-4/packages/survey/www/admin/question-add-3.tcl 12 Mar 2003 01:05:52 -0000 1.5 +++ openacs-4/packages/survey/www/admin/question-add-3.tcl 6 Nov 2013 07:33:54 -0000 1.6 @@ -39,8 +39,8 @@ } set package_id [ad_conn package_id] -set user_id [ad_get_user_id] -ad_require_permission $package_id survey_create_question +set user_id [ad_conn user_id] +permission::require_permission -object_id $package_id -privilege survey_create_question get_survey_info -section_id $section_id if {![info exists survey_info(survey_id)]} { @@ -52,18 +52,18 @@ set exception_count 0 set exception_text "" -if { [empty_string_p $question_text] } { +if { $question_text eq "" } { incr exception_count append exception_text "
  • [_ survey.lt_You_did_not_enter_a_q]\n" } -if { $type != "scored" && $type != "general" } { +if { $type ne "scored" && $type ne "general" } { incr exception_count set type_var $type append exception_text "
  • [_ survey.Surveys of type $type are not currently available.\n" } -if { $type == "general" && $abstract_data_type == "choice" && [empty_string_p $valid_responses] } { +if { $type eq "general" && $abstract_data_type eq "choice" && $valid_responses eq "" } { incr exception_count append exception_text "
  • [_ survey.lt_You_did_not_enter_a_l]\n" } @@ -82,30 +82,30 @@ } # Generate presentation_options. set presentation_options "" - if { $presentation_type == "textbox" } { - if { [exists_and_not_null textbox_size] } { + if { $presentation_type eq "textbox" } { + if { ([info exists textbox_size] && $textbox_size ne "") } { # Will be "small", "medium", or "large". set presentation_options $textbox_size } - } elseif { $presentation_type == "textarea" } { - if { [exists_and_not_null textarea_size] } { + } elseif { $presentation_type eq "textarea" } { + if { ([info exists textarea_size] && $textarea_size ne "") } { # Will be "small", "medium", or "large". set presentation_options $textarea_size } - } elseif { $abstract_data_type == "yn" } { + } elseif { $abstract_data_type eq "yn" } { set abstract_data_type "boolean" set presentation_options "[_ survey.YesNo]" - } elseif { $abstract_data_type == "boolean" } { + } elseif { $abstract_data_type eq "boolean" } { set presentation_options "[_ survey.TrueFalse]" } db_transaction { - if { [exists_and_not_null after] } { + if { ([info exists after] && $after ne "") } { # We're inserting between existing questions; move everybody down. set sort_order [expr { $after + 1 }] db_dml renumber_sort_orders {} } else { - set sort_order [expr [db_string max_question {}] + 1] + set sort_order [expr {[db_string max_question {}] + 1}] } db_exec_plsql create_question {} @@ -116,13 +116,13 @@ # For questions where the user is selecting a canned response, insert # the canned responses into survey_question_choices by parsing the valid_responses # field. - if { $presentation_type == "checkbox" || $presentation_type == "radio" || $presentation_type == "select" } { - if { $abstract_data_type == "choice" } { + if { $presentation_type eq "checkbox" || $presentation_type eq "radio" || $presentation_type eq "select" } { + if { $abstract_data_type eq "choice" } { set responses [split $valid_responses "\n"] set count 0 foreach response $responses { set trimmed_response [string trim $response] - if { [empty_string_p $trimmed_response] } { + if { $trimmed_response eq "" } { # skip empty lines continue } Index: openacs-4/packages/survey/www/admin/question-add.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/question-add.tcl,v diff -u -r1.5 -r1.6 --- openacs-4/packages/survey/www/admin/question-add.tcl 21 Jan 2005 17:24:28 -0000 1.5 +++ openacs-4/packages/survey/www/admin/question-add.tcl 6 Nov 2013 07:33:54 -0000 1.6 @@ -16,8 +16,8 @@ } set package_id [ad_conn package_id] -set user_id [ad_get_user_id] -ad_require_permission $package_id survey_create_question +set user_id [ad_conn user_id] +permission::require_permission -object_id $package_id -privilege survey_create_question get_survey_info -section_id $section_id @@ -43,9 +43,9 @@ get_survey_info -section_id $section_id set survey_id $survey_info(survey_id) -set context [list [list "one?[export_url_vars survey_id]" $survey_info(name)] "[_ survey.Add_A_Question]"] +set context [list [list "one?[export_vars -url {survey_id}]" $survey_info(name)] "[_ survey.Add_A_Question]"] -if {[ad_parameter allow_question_deactivation_p] == 1} { +if {[parameter::get -parameter allow_question_deactivation_p] == 1} { ad_form -extend -name create_question -form { {active:text(radio) {label "[_ survey.Active]"} {options {{[_ survey.Yes] t} {[_ survey.No] f}}} {value t}} } Index: openacs-4/packages/survey/www/admin/question-copy.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/question-copy.tcl,v diff -u -r1.1 -r1.2 --- openacs-4/packages/survey/www/admin/question-copy.tcl 16 Sep 2002 00:00:24 -0000 1.1 +++ openacs-4/packages/survey/www/admin/question-copy.tcl 6 Nov 2013 07:33:54 -0000 1.2 @@ -9,9 +9,9 @@ } set package_id [ad_conn package_id] -set user_id [ad_get_user_id] +set user_id [ad_conn user_id] -ad_require_permission $package_id survey_create_question +permission::require_permission -object_id $package_id -privilege survey_create_question set section_id [db_string get_section_id_from_question {}] get_survey_info -section_id $section_id set survey_id $survey_info(survey_id) Index: openacs-4/packages/survey/www/admin/question-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/question-delete.tcl,v diff -u -r1.5 -r1.6 --- openacs-4/packages/survey/www/admin/question-delete.tcl 21 Jan 2005 17:24:28 -0000 1.5 +++ openacs-4/packages/survey/www/admin/question-delete.tcl 6 Nov 2013 07:33:55 -0000 1.6 @@ -15,7 +15,7 @@ {sort_order ""} } -ad_require_permission $question_id survey_delete_question +permission::require_permission -object_id $question_id -privilege survey_delete_question db_1row section_id_from_question_id "" @@ -58,7 +58,7 @@ db_dml survey_question_choices_delete {} db_exec_plsql survey_delete_question {} - if {![empty_string_p $sort_order]} { + if {$sort_order ne ""} { db_dml survey_renumber_questions {} } } on_error { @@ -75,7 +75,7 @@ db_release_unused_handles set sort_order [expr {$sort_order -1}] } - ad_returnredirect "one?[export_url_vars survey_id]&#${sort_order}" + ad_returnredirect "one?[export_vars -url {survey_id}]&#${sort_order}" ad_script_abort } Index: openacs-4/packages/survey/www/admin/question-modify-text.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/question-modify-text.tcl,v diff -u -r1.4 -r1.5 --- openacs-4/packages/survey/www/admin/question-modify-text.tcl 21 Jan 2005 17:24:28 -0000 1.4 +++ openacs-4/packages/survey/www/admin/question-modify-text.tcl 6 Nov 2013 07:33:55 -0000 1.5 @@ -16,7 +16,7 @@ } -ad_require_permission $section_id survey_modify_question +permission::require_permission -object_id $section_id -privilege survey_modify_question get_survey_info -section_id $section_id set survey_name $survey_info(name) @@ -35,6 +35,6 @@ } -set context [list [list "one?[export_url_vars survey_id]" $survey_info(name)] "[_ survey.lt_Modify_a_Questions_Te]"] +set context [list [list "one?[export_vars -url {survey_id}]" $survey_info(name)] "[_ survey.lt_Modify_a_Questions_Te]"] ad_return_template Index: openacs-4/packages/survey/www/admin/question-modify.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/question-modify.tcl,v diff -u -r1.4 -r1.5 --- openacs-4/packages/survey/www/admin/question-modify.tcl 21 Jan 2005 17:24:28 -0000 1.4 +++ openacs-4/packages/survey/www/admin/question-modify.tcl 6 Nov 2013 07:33:55 -0000 1.5 @@ -21,8 +21,8 @@ get_survey_info -section_id $section_id set survey_name $survey_info(name) set survey_id $survey_info(survey_id) -ad_require_permission $survey_id survey_modify_question -set allow_question_deactivation [ad_parameter "allow_question_deactivation_p"] +permission::require_permission -object_id $survey_id -privilege survey_modify_question +set allow_question_deactivation [parameter::get -parameter "allow_question_deactivation_p"] set n_responses [db_string survey_number_responses {} ] ad_form -name modify_question -form { @@ -65,7 +65,7 @@ db_1row presentation {} -if {($presentation_type=="checkbox" || $presentation_type=="select" || $presentation_type=="radio") && $abstract_data_type != "boolean"} { +if {($presentation_type=="checkbox" || $presentation_type=="select" || $presentation_type=="radio") && $abstract_data_type ne "boolean"} { set valid_responses_list [db_list survey_question_valid_responses {}] set response_list "" foreach response $valid_responses_list { @@ -79,7 +79,7 @@ } } -if {$presentation_type == "textarea" || $presentation_type == "textbox"} { +if {$presentation_type eq "textarea" || $presentation_type eq "textbox"} { ad_form -extend -name modify_question -form { {presentation_options:text(select) {options {{[_ survey.Small] small} {[_ survey.Medium] medium} {[_ survey.Large] large}}} {value $presentation_options} {label "[string totitle $presentation_type] [_ survey.Size]"}} @@ -101,7 +101,7 @@ set response_list "" foreach response $responses { set trimmed_response [string trim $response] - if { [empty_string_p $trimmed_response] } { + if { $trimmed_response eq "" } { # skip empty lines continue } @@ -116,7 +116,7 @@ set choice_name [lindex $one_response 0] set choice_value [lindex $one_response 1] set choice_id_to_update [lindex $choice_id_to_update_list $choice_count] - if {[empty_string_p $choice_id_to_update]} { + if {$choice_id_to_update eq ""} { db_dml insert_new_choice {} } else { Index: openacs-4/packages/survey/www/admin/question-required-toggle.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/question-required-toggle.tcl,v diff -u -r1.1 -r1.2 --- openacs-4/packages/survey/www/admin/question-required-toggle.tcl 16 Sep 2002 00:00:24 -0000 1.1 +++ openacs-4/packages/survey/www/admin/question-required-toggle.tcl 6 Nov 2013 07:33:55 -0000 1.2 @@ -19,7 +19,7 @@ } -ad_require_permission $section_id survey_modify_question +permission::require_permission -object_id $section_id -privilege survey_modify_question db_dml survey_question_required_toggle "update survey_questions set required_p = util.logical_negation(required_p) where section_id = :section_id @@ -28,5 +28,5 @@ db_release_unused_handles get_survey_info -section_id $section_id set survey_id $survey_info(survey_id) -ad_returnredirect "one?[export_url_vars survey_id]" +ad_returnredirect "one?[export_vars -url {survey_id}]" Index: openacs-4/packages/survey/www/admin/question-swap.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/question-swap.tcl,v diff -u -r1.3 -r1.4 --- openacs-4/packages/survey/www/admin/question-swap.tcl 12 Mar 2003 01:05:52 -0000 1.3 +++ openacs-4/packages/survey/www/admin/question-swap.tcl 6 Nov 2013 07:33:55 -0000 1.4 @@ -17,7 +17,7 @@ direction:notnull } -ad_require_permission $section_id survey_modify_survey +permission::require_permission -object_id $section_id -privilege survey_modify_survey if { $direction=="up" } { set next_sort_order [expr { $sort_order - 1 }] Index: openacs-4/packages/survey/www/admin/respond.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/respond.tcl,v diff -u -r1.3 -r1.4 --- openacs-4/packages/survey/www/admin/respond.tcl 21 Jan 2005 17:24:28 -0000 1.3 +++ openacs-4/packages/survey/www/admin/respond.tcl 6 Nov 2013 07:33:55 -0000 1.4 @@ -21,7 +21,7 @@ } -validate { survey_exists -requires {survey_id} { - if ![db_0or1row survey_exists {}] { + if {![db_0or1row survey_exists {}]} { ad_complain "Survey $survey_id does not exist" } } @@ -38,7 +38,7 @@ # Added by request from a professor at Sloan. -ad_require_permission $survey_id survey_admin_survey +permission::require_permission -object_id $survey_id -privilege survey_admin_survey get_survey_info -survey_id $survey_id set survey_name $survey_info(name) @@ -82,13 +82,13 @@ # rather than executing the survey associated with the logic # after the survey is completed - if ![info exists return_url] { + if {![info exists return_url]} { set return_url {} } } set edited_response_id $response_id -set form_vars [export_form_vars section_id survey_id new_response_id user_id edited_response_id] +set form_vars [export_vars -form {section_id survey_id new_response_id user_id edited_response_id}] ad_return_template Index: openacs-4/packages/survey/www/admin/respondents.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/respondents.tcl,v diff -u -r1.10 -r1.11 --- openacs-4/packages/survey/www/admin/respondents.tcl 2 Apr 2009 13:48:21 -0000 1.10 +++ openacs-4/packages/survey/www/admin/respondents.tcl 6 Nov 2013 07:33:55 -0000 1.11 @@ -17,7 +17,7 @@ respondents:multirow } -ad_require_permission $survey_id survey_admin_survey +permission::require_permission -object_id $survey_id -privilege survey_admin_survey # for sloanspace, we can also list users who have NOT responded or # the entire group. Index: openacs-4/packages/survey/www/admin/response-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/response-delete.tcl,v diff -u -r1.3 -r1.4 --- openacs-4/packages/survey/www/admin/response-delete.tcl 21 Jan 2005 17:24:28 -0000 1.3 +++ openacs-4/packages/survey/www/admin/response-delete.tcl 6 Nov 2013 07:33:55 -0000 1.4 @@ -12,7 +12,7 @@ } set package_id [ad_conn package_id] -ad_require_permission $package_id survey_admin_survey +permission::require_permission -object_id $package_id -privilege survey_admin_survey db_1row get_response_info {} Index: openacs-4/packages/survey/www/admin/response-drill-down.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/response-drill-down.tcl,v diff -u -r1.3 -r1.4 --- openacs-4/packages/survey/www/admin/response-drill-down.tcl 21 Jan 2005 17:24:28 -0000 1.3 +++ openacs-4/packages/survey/www/admin/response-drill-down.tcl 6 Nov 2013 07:33:55 -0000 1.4 @@ -20,7 +20,7 @@ } -ad_require_permission $question_id survey_admin_survey +permission::require_permission -object_id $question_id -privilege survey_admin_survey # get the prompt text for the question and the ID for survey of # which it is part @@ -50,8 +50,8 @@ db_multirow user_responses all_users_for_response {} set context [list \ - [list "one?[export_url_vars survey_id]" $survey_info(name)] \ - [list "responses?[export_url_vars survey_id]" "[_ survey.Responses]"] \ + [list "one?[export_vars -url {survey_id}]" $survey_info(name)] \ + [list "responses?[export_vars -url {survey_id}]" "[_ survey.Responses]"] \ "[_ survey.One_Response]"] ad_return_template Index: openacs-4/packages/survey/www/admin/response-editable-toggle.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/response-editable-toggle.tcl,v diff -u -r1.1 -r1.2 --- openacs-4/packages/survey/www/admin/response-editable-toggle.tcl 16 Sep 2002 00:00:24 -0000 1.1 +++ openacs-4/packages/survey/www/admin/response-editable-toggle.tcl 6 Nov 2013 07:33:55 -0000 1.2 @@ -14,9 +14,9 @@ } -ad_require_permission $survey_id survey_admin_survey +permission::require_permission -object_id $survey_id -privilege survey_admin_survey db_dml survey_response_editable_toggle "" db_release_unused_handles -ad_returnredirect "one?[export_url_vars survey_id]" +ad_returnredirect "one?[export_vars -url {survey_id}]" Index: openacs-4/packages/survey/www/admin/response-limit-toggle.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/response-limit-toggle.tcl,v diff -u -r1.2 -r1.3 --- openacs-4/packages/survey/www/admin/response-limit-toggle.tcl 6 Nov 2003 15:38:01 -0000 1.2 +++ openacs-4/packages/survey/www/admin/response-limit-toggle.tcl 6 Nov 2013 07:33:55 -0000 1.3 @@ -13,9 +13,9 @@ } -ad_require_permission $survey_id survey_admin_survey +permission::require_permission -object_id $survey_id -privilege survey_admin_survey db_dml survey_response_toggle "" db_release_unused_handles -ad_returnredirect "one?[export_url_vars survey_id]" +ad_returnredirect "one?[export_vars -url {survey_id}]" Index: openacs-4/packages/survey/www/admin/responses-export.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/responses-export.tcl,v diff -u -r1.9 -r1.10 --- openacs-4/packages/survey/www/admin/responses-export.tcl 21 Jan 2005 17:24:28 -0000 1.9 +++ openacs-4/packages/survey/www/admin/responses-export.tcl 6 Nov 2013 07:33:55 -0000 1.10 @@ -17,13 +17,13 @@ } set csv_export "" set package_id [ad_conn package_id] -ad_require_permission $package_id survey_admin_survey +permission::require_permission -object_id $package_id -privilege survey_admin_survey set n_responses [db_string get_n_responses {}] ns_log notice "DAVEB: n_responses=$n_responses" if {$n_responses==0} { get_survey_info -survey_id $survey_id - set context [list [list "one?[export_url_vars survey_id]" $survey_info(name)] "[_ survey.CSV_Export]"] + set context [list [list "one?[export_vars -url {survey_id}]" $survey_info(name)] "[_ survey.CSV_Export]"] ad_return_template "no-responses" return } @@ -83,11 +83,11 @@ db_foreach get_all_survey_question_responses "" { if { $response_id != $current_response_id } { - if { ![empty_string_p $current_question_id] } { + if { $current_question_id ne "" } { append current_response ",\"[join $current_question_list ","]\"" } - if { ![empty_string_p $current_response_id] } { + if { $current_response_id ne "" } { append csv_export "$current_response \r\n" } set current_response_id $response_id @@ -110,7 +110,7 @@ regsub -all {[\r\n]} $response_value {} response_value if { $question_id != $current_question_id } { - if { ![empty_string_p $current_question_id] } { + if { $current_question_id ne "" } { append current_response ",\"[join $current_question_list ","]\"" } set current_question_id $question_id @@ -134,13 +134,13 @@ } - if { ![empty_string_p $current_question_id] } { + if { $current_question_id ne "" } { append current_response ",\"[join $current_question_list ","]\"" } - if { ![empty_string_p $current_response_id] } { + if { $current_response_id ne "" } { append csv_export "$current_response\r\n" } - if {[empty_string_p $csv_export]} { + if {$csv_export eq ""} { set csv_export "\r\n" } ns_write $csv_export Index: openacs-4/packages/survey/www/admin/responses.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/responses.tcl,v diff -u -r1.5 -r1.6 --- openacs-4/packages/survey/www/admin/responses.tcl 9 Nov 2008 23:29:28 -0000 1.5 +++ openacs-4/packages/survey/www/admin/responses.tcl 6 Nov 2013 07:33:55 -0000 1.6 @@ -15,9 +15,9 @@ } -ad_require_permission $survey_id survey_admin_survey +permission::require_permission -object_id $survey_id -privilege survey_admin_survey -set user_id [ad_get_user_id] +set user_id [ad_conn user_id] # nstrug - 12/9/2000 # Summarise scored responses for all users @@ -65,7 +65,7 @@ } "choice" { db_foreach survey_section_question_choices "" { - append results "$label: $n_responses
    \n" + append results "$label: $n_responses
    \n" } } "blob" { @@ -87,6 +87,6 @@ set response_sentence "[_ survey.lt_There_have_been_n]" } -set context [list [list "one?[export_url_vars survey_id]" $survey_info(name)] "[_ survey.Responses]"] +set context [list [list "one?[export_vars -url {survey_id}]" $survey_info(name)] "[_ survey.Responses]"] ad_return_template Index: openacs-4/packages/survey/www/admin/send-mail.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/send-mail.tcl,v diff -u -r1.5 -r1.6 --- openacs-4/packages/survey/www/admin/send-mail.tcl 21 Jan 2005 17:24:28 -0000 1.5 +++ openacs-4/packages/survey/www/admin/send-mail.tcl 6 Nov 2013 07:33:55 -0000 1.6 @@ -18,7 +18,7 @@ set user_id [ad_conn user_id] set sender_id [ad_conn user_id] -ad_require_permission $survey_id survey_admin_survey +permission::require_permission -object_id $survey_id -privilege survey_admin_survey get_survey_info -survey_id $survey_id set survey_name $survey_info(name) @@ -29,7 +29,7 @@ set community_id [dotlrn_community::get_community_id] set segment_id [db_string select_rel_segment_id {}] set community_name [dotlrn_community::get_community_name $community_id] - set community_url "[ad_parameter -package_id [ad_acs_kernel_id] SystemURL][dotlrn_community::get_community_url $community_id]" + set community_url "[parameter::get -package_id [ad_acs_kernel_id] -parameter SystemURL][dotlrn_community::get_community_url $community_id]" set n_responses [db_string n_responses {}] if {$n_responses > 0} { Index: openacs-4/packages/survey/www/admin/survey-category-add.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/survey-category-add.tcl,v diff -u -r1.1 -r1.2 --- openacs-4/packages/survey/www/admin/survey-category-add.tcl 16 Sep 2002 00:00:25 -0000 1.1 +++ openacs-4/packages/survey/www/admin/survey-category-add.tcl 6 Nov 2013 07:33:55 -0000 1.2 @@ -40,5 +40,5 @@ get_survey_info -section_id $section_id set survey_id $survey_info(survey_id) -ad_returnredirect "one?[export_url_vars survey_id]" +ad_returnredirect "one?[export_vars -url {survey_id}]" Index: openacs-4/packages/survey/www/admin/survey-copy.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/survey-copy.tcl,v diff -u -r1.4 -r1.5 --- openacs-4/packages/survey/www/admin/survey-copy.tcl 21 Jan 2005 17:24:28 -0000 1.4 +++ openacs-4/packages/survey/www/admin/survey-copy.tcl 6 Nov 2013 07:33:55 -0000 1.5 @@ -10,9 +10,9 @@ } set package_id [ad_conn package_id] -set user_id [ad_get_user_id] +set user_id [ad_conn user_id] -ad_require_permission $package_id survey_create_question +permission::require_permission -object_id $package_id -privilege survey_create_question db_1row get_survey_info {} set title_name $name set name "[_ survey.Copy_of] $name" Index: openacs-4/packages/survey/www/admin/survey-create-choice.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/survey-create-choice.tcl,v diff -u -r1.2 -r1.3 --- openacs-4/packages/survey/www/admin/survey-create-choice.tcl 12 Mar 2003 01:05:52 -0000 1.2 +++ openacs-4/packages/survey/www/admin/survey-create-choice.tcl 6 Nov 2013 07:33:55 -0000 1.3 @@ -14,7 +14,7 @@ } set package_id [ad_conn package_id] -ad_require_permission $package_id survey_create_survey +permission::require_permission -object_id $package_id -privilege survey_create_survey set whole_page "[ad_header "[_ survey.Choose_Survey_Type]"] Index: openacs-4/packages/survey/www/admin/survey-create-confirm.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/survey-create-confirm.tcl,v diff -u -r1.2 -r1.3 --- openacs-4/packages/survey/www/admin/survey-create-confirm.tcl 13 Jan 2005 13:58:46 -0000 1.2 +++ openacs-4/packages/survey/www/admin/survey-create-confirm.tcl 6 Nov 2013 07:33:55 -0000 1.3 @@ -1,6 +1,6 @@ -if {$desc_html == "pre"} { +if {$desc_html eq "pre"} { set description [ad_text_to_html $description] -} elseif {$desc_html == "plain"} { +} elseif {$desc_html eq "plain"} { set description [ad_quotehtml $description] } Index: openacs-4/packages/survey/www/admin/survey-create.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/survey-create.tcl,v diff -u -r1.7 -r1.8 --- openacs-4/packages/survey/www/admin/survey-create.tcl 21 Jan 2005 17:24:28 -0000 1.7 +++ openacs-4/packages/survey/www/admin/survey-create.tcl 6 Nov 2013 07:33:55 -0000 1.8 @@ -22,7 +22,7 @@ set package_id [ad_conn package_id] # bounce the user if they don't have permission to admin surveys -ad_require_permission $package_id survey_create_survey +permission::require_permission -object_id $package_id -privilege survey_create_survey set user_id [ad_conn user_id] # use ad_form --DaveB @@ -50,7 +50,7 @@ } -new_data { - if {[string compare $desc_html "html"] == 0} { + if {$desc_html eq "html" } { set description_html_p "t" } else { set description_html_p "f" Index: openacs-4/packages/survey/www/admin/survey-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/survey-delete.tcl,v diff -u -r1.4 -r1.5 --- openacs-4/packages/survey/www/admin/survey-delete.tcl 21 Jan 2005 17:24:28 -0000 1.4 +++ openacs-4/packages/survey/www/admin/survey-delete.tcl 6 Nov 2013 07:33:55 -0000 1.5 @@ -14,7 +14,7 @@ } set package_id [ad_conn package_id] -ad_require_permission $package_id survey_admin_survey +permission::require_permission -object_id $package_id -privilege survey_admin_survey get_survey_info -survey_id $survey_id Index: openacs-4/packages/survey/www/admin/survey-display-type-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/survey-display-type-edit.tcl,v diff -u -r1.1 -r1.2 --- openacs-4/packages/survey/www/admin/survey-display-type-edit.tcl 16 Sep 2002 00:00:25 -0000 1.1 +++ openacs-4/packages/survey/www/admin/survey-display-type-edit.tcl 6 Nov 2013 07:33:55 -0000 1.2 @@ -10,11 +10,11 @@ display_type:notnull } -ad_require_permission $survey_id survey_admin_survey +permission::require_permission -object_id $survey_id -privilege survey_admin_survey if {[lsearch [survey_display_types] $display_type] > -1} { db_dml survey_display_type_edit "" } db_release_unused_handles -ad_returnredirect "one?[export_url_vars survey_id]" +ad_returnredirect "one?[export_vars -url {survey_id}]" Index: openacs-4/packages/survey/www/admin/survey-preview.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/survey-preview.tcl,v diff -u -r1.4 -r1.5 --- openacs-4/packages/survey/www/admin/survey-preview.tcl 21 Jan 2005 17:24:28 -0000 1.4 +++ openacs-4/packages/survey/www/admin/survey-preview.tcl 6 Nov 2013 07:33:55 -0000 1.5 @@ -17,7 +17,7 @@ } -validate { survey_exists -requires {survey_id} { - if ![db_0or1row survey_exists {}] { + if {![db_0or1row survey_exists {}]} { ad_complain "[_ survey.lt_Survey_survey_id_does]" } } @@ -32,7 +32,7 @@ return_url:onerow } -ad_require_permission $survey_id survey_take_survey +permission::require_permission -object_id $survey_id -privilege survey_take_survey get_survey_info -survey_id $survey_id set name $survey_info(name) @@ -64,6 +64,6 @@ } set return_url "one?[export_vars survey_id]" -set form_vars [export_form_vars section_id survey_id] +set form_vars [export_vars -form {section_id survey_id}] ad_return_template Index: openacs-4/packages/survey/www/admin/survey-toggle.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/survey-toggle.tcl,v diff -u -r1.2 -r1.3 --- openacs-4/packages/survey/www/admin/survey-toggle.tcl 18 Sep 2002 14:55:01 -0000 1.2 +++ openacs-4/packages/survey/www/admin/survey-toggle.tcl 6 Nov 2013 07:33:55 -0000 1.3 @@ -15,7 +15,7 @@ {target "./"} } -ad_require_permission $survey_id survey_admin_survey +permission::require_permission -object_id $survey_id -privilege survey_admin_survey if {$enabled_p == "f"} { set enabled_p "t" Index: openacs-4/packages/survey/www/admin/user-responses-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/user-responses-delete.tcl,v diff -u -r1.4 -r1.5 --- openacs-4/packages/survey/www/admin/user-responses-delete.tcl 21 Jan 2005 17:24:28 -0000 1.4 +++ openacs-4/packages/survey/www/admin/user-responses-delete.tcl 6 Nov 2013 07:33:55 -0000 1.5 @@ -13,7 +13,7 @@ } set package_id [ad_conn package_id] -ad_require_permission $package_id survey_admin_survey +permission::require_permission -object_id $package_id -privilege survey_admin_survey db_multirow responses get_response_info {} @@ -32,7 +32,7 @@ } -on_submit { if {$confirmation} { template::multirow foreach responses { - if {[empty_string_p $initial_response_id]} { + if {$initial_response_id eq ""} { db_exec_plsql delete_response {} } } Index: openacs-4/packages/survey/www/admin/view-text-responses.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/survey/www/admin/view-text-responses.tcl,v diff -u -r1.3 -r1.4 --- openacs-4/packages/survey/www/admin/view-text-responses.tcl 21 Jan 2005 17:24:28 -0000 1.3 +++ openacs-4/packages/survey/www/admin/view-text-responses.tcl 6 Nov 2013 07:33:55 -0000 1.4 @@ -21,17 +21,17 @@ set survey_name $survey_info(name) set survey_id $survey_info(survey_id) -ad_require_permission $survey_id survey_admin_survey +permission::require_permission -object_id $survey_id -privilege survey_admin_survey set abstract_data_type [db_string abstract_data_type "select abstract_data_type from survey_questions q where question_id = :question_id"] -if { $abstract_data_type == "text" } { +if { $abstract_data_type eq "text" } { set column_name "clob_answer" -} elseif { $abstract_data_type == "shorttext" } { +} elseif { $abstract_data_type eq "shorttext" } { set column_name "varchar_answer" -} elseif { $abstract_data_type == "date" } { +} elseif { $abstract_data_type eq "date" } { set column_name "date_answer" } @@ -40,4 +40,4 @@ db_multirow responses all_responses_to_question {} -set context [list [list "one?[export_url_vars survey_id]" $survey_info(name)] "[_ survey.lt_Responses_to_Question]"] +set context [list [list "one?[export_vars -url {survey_id}]" $survey_info(name)] "[_ survey.lt_Responses_to_Question]"]