ad_library { ACS-specific general utility routines. @author Philip Greenspun (philg@arsdigita.com) @date 2 April 1998 @cvs-id $Id: defs-procs.tcl,v 1.1 2002/07/09 17:34:59 rmello Exp $ } proc ad_acs_version {} { set release_tag {} regexp "acs-(\[0-9\]+)-(\[0-9\]+)-(\[0-9\]+)" \ $release_tag match major minor release if {[info exists major] && [info exists minor] && [info exists release]} { return "$major.$minor.$release" } else { return "development" } } proc ad_acs_release_date {} { set release_tag {} regexp "R(\[0-9\]+)" $release_tag match release_date if {[info exists release_date]} { set year [string range $release_date 0 3] set month [string range $release_date 4 5] set day [string range $release_date 6 7] return [util_AnsiDatetoPrettyDate "$year-$month-$day"] } else { return "not released" } } # this is a technical person who can fix problems proc ad_host_administrator {} { return [ad_parameter -package_id [ad_acs_kernel_id] HostAdministrator] } # The email address that will sign outgoing alerts proc ad_outgoing_sender {} { return [ad_parameter -package_id [ad_acs_kernel_id] OutgoingSender] } # set to return 1 if there is a graphics site proc ad_graphics_site_available_p {} { return [ad_parameter -package_id [ad_acs_kernel_id] GraphicsSiteAvailableP] } # this is the main name of the Web service that you're offering # on top of the Arsdigita Web Publishing System proc ad_system_name {} { return [ad_parameter -package_id [ad_acs_kernel_id] SystemName] } # This is the URL of a user's private workspace on the system, usually # /pvt/home.tcl proc ad_pvt_home {} { return [ad_parameter -package_id [ad_acs_kernel_id] HomeURL] } proc ad_admin_home {} { return "/admin" } proc ad_package_admin_home { package_key } { return "[ad_admin_home]/$package_key" } proc ad_pvt_home_name {} { return [ad_parameter -package_id [ad_acs_kernel_id] HomeName] } proc ad_pvt_home_link {} { return "[ad_pvt_home_name]" } proc ad_site_home_link {} { if { [ad_get_user_id] != 0 } { return "[ad_system_name]" } else { # we don't know who this person is return "[ad_system_name]" } } # person who owns the service # this person would be interested in user feedback, etc. proc ad_system_owner {} { return [ad_parameter -package_id [ad_acs_kernel_id] SystemOwner] } # a human-readable name of the publisher, suitable for # legal blather proc ad_publisher_name {} { return [ad_parameter -package_id [ad_acs_kernel_id] PublisherName] } proc ad_url {} { # this will be called by email alerts. Do not use ad_conn location return [ad_parameter -package_id [ad_acs_kernel_id] SystemURL] } ad_proc -public acs_community_member_url { {-user_id:required} } { return the url for the community member page of a particular user } { return "[ad_parameter -package_id [ad_acs_kernel_id] CommunityMemberURL]?[export_vars user_id]" } ad_proc -public acs_community_member_link { {-user_id:required} {-label ""} } { return the link of the community member page of a particular user } { if {[empty_string_p $label]} { set label [db_string select_community_member_link_label { select persons.first_names || ' ' || persons.last_name from persons where person_id = :user_id } -default $user_id] } return "$label" } proc ad_present_user {user_id name} { return [acs_community_member_link -user_id $user_id -label $name] } ad_proc -public acs_community_member_admin_url { {-user_id:required} } { return the url for the community member admin page of a particular user } { return "[ad_parameter -package_id [ad_acs_kernel_id] CommunityMemberAdminURL]?[export_vars user_id]" } ad_proc -public acs_community_member_admin_link { {-user_id:required} {-label ""} } { return the link of the community member page of a particular user } { if {[empty_string_p $label]} { set label [db_string select_community_member_link_label { select persons.first_names || ' ' || persons.last_name from persons where person_id = :user_id } -default $user_id] } return "$label" } proc ad_admin_present_user {user_id name} { return [acs_community_member_admin_link -user_id $user_id -label $name] } ad_proc ad_header { {-focus ""} page_title {extra_stuff_for_document_head ""} } { writes HEAD, TITLE, and BODY tags to start off pages in a consistent fashion } { # if {[ad_parameter MenuOnUserPagesP pdm] == 1} { # return [ad_header_with_extra_stuff -focus $focus $page_title [ad_pdm] [ad_pdm_spacer]] # } else { # } return [ad_header_with_extra_stuff -focus $focus $page_title $extra_stuff_for_document_head] } ad_proc ad_header_with_extra_stuff { {-focus ""} page_title {extra_stuff_for_document_head ""} {pre_content_html ""} } { This is the version of the ad_header that accepts extra stuff for the document head and pre-page content html } { set html "
$extra_stuff_for_document_head