Forum OpenACS Q&A: Response to HELP I need sound allert on chat

Collapse
Posted by David Kuczek on
Okay my instant alert system is running with this javascript solution... It's pretty nice.

I finished off a first version for pop-up + sound chat alerts:

1. download chat-alert.tar.gz from the file-storage (https://openacs.org/new-file-storage/one-file.tcl?file_id=350)

2. tar xvfz chat-alert.tar.gz

3. move the folders to www/

3. cut and paste the javascript from redirect/ad-defs.tcl.preload to ad_header inside tcl/ad-defs.tcl.preload

4. restart your aolserver

voila it should work....

-----------------------------------------------------------------

What still has to be done:

1. At the moment the pop-up is being shown to all logged in users, which is bad. A solution for this would be to write a "chat_admin_p = 0 or 1" into the ad_session_id cookie...

This way you could read it out of the ad_session_id cookie parallel to [ad_verify_and_get_user_id] and wouldn't have to access the database everytime a page is loaded!!!

2. The chat link inside popup/instant-message.tcl could lead directly to the relevant chat...

3. chat_msgs could be enhanced by

popup_p char(1) default 'f' check (popup_p in ('t','f'))

This way popup/instant-message.tcl could update the relevant row into 't' so that a popup can't be shown twice....

That's it for the beginning....

---------------------------------------------------------------------

In combination with the java chat by grandmaster Rocael this could be the *beginning* of a neat CustomerRelationshipManagement solution...

Collapse
Posted by Hans Gaasenbeek on
Where exactly do I cut/paste the javascript code? (In other words, can you post a complete updated ad-defs.tcl.preload?)
Collapse
Posted by Hans Gaasenbeek on
I pasted the code after [/head], but after installing all files, I do not get a popup or sound. In fact, the chat page which loads does not have a javascript component (when I view the source in a browser).

This is my ad-defs.tcl.preload (sorry for the large text file):

# /tcl/ad-defs.tcl
#
# Author: mailto:philg@arsdigita.com on April 2, 1998
#
# ArsDigita Community System Defs
#
# ad-defs.tcl.preload,v 3.6.2.3 2000/03/17 05:56:11 aure Exp
# -----------------------------------------------------------------------------

# The following two procs use the ACS release tag to return the
# current version and release date.  In a development copy of acs the
# release tag is not expanded and these procs return "development" and
# "not released".  In a released copy the tag is expanded to something
# of the form "acs-major-minor-release-Ryyyymmdd", and these procs
# return e.g. "3.1.3" and "February 20, 2000".

util_report_library_entry

proc ad_acs_version {} {
    set release_tag {acs-3-2-2-R20000412}
    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 {acs-3-2-2-R20000412}
    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"
    }
}

# for setting cookies that will work on, e.g.,
# http://www.foobar.com and http://foobar.com
# we need to push user through the cookie-chain.tcl
# pipeline and use both host names explicitly

proc ad_need_cookie_chain_p {} {
    return [ad_parameter NeedCookieChainP]
}

proc ad_cookie_chain_first_host_name {} {
    return [ad_parameter CookieChainFirstHostName]
}

proc ad_cookie_chain_second_host_name {} {
    return [ad_parameter CookieChainSecondHostName]
}

# this is a technical person who can fix problems
proc ad_host_administrator {} {
    return [ad_parameter HostAdministrator]
}

# set to return 1 if there is a graphics site

proc ad_graphics_site_available_p {} {
    return [ad_parameter 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 SystemName]
}

# This is the URL of a user's private workspace on the system, usually
# /pvt/home.tcl

proc ad_pvt_home {} {
    return "/pvt/home.tcl"
}

proc ad_pvt_home_name {} {
    return "workspace"
}

proc ad_pvt_home_link {} {
    return "<a href=\"/pvt/home.tcl\">your workspace</a>"
}

proc ad_site_home_link {} {
    if { [ad_get_user_id] != 0 } {
        return "<a href=\"/pvt/home.tcl\">[ad_system_name]</a>"
    } else {
        # we don't know who this person is
        return "<a href=\"/\">[ad_system_name]</a>"
    }
}

# person who owns the service
# this person would be interested in user feedback, etc.

proc ad_system_owner {} {
    return [ad_parameter SystemOwner]
}

# a human-readable name of the publisher, suitable for
# legal blather

proc ad_publisher_name {} {
    return [ad_parameter PublisherName]
}

proc ad_url {} {
    # this will be called by email alerts. Do not use ns_conn location
    return [ad_parameter SystemURL]
}

proc ad_present_user {user_id name} {
    return "<a href=\"/shared/community-member.tcl?user_id=$user_id\">$name</a>"
}

proc ad_admin_present_user {user_id name} {
    return "<a href=\"/admin/users/one.tcl?user_id=$user_id\">$name</a>"
}

proc_doc ad_header {page_title {extra_stuff_for_document_head ""}} "writes HEAD, TITLE, and BODY t

    if {[ad_parameter MenuOnUserPagesP pdm] == 1} {

        return [ad_header_with_extra_stuff $page_title [ad_pdm] [ad_pdm_spacer]]

    } else {

        return [ad_header_with_extra_stuff $page_title $extra_stuff_for_document_head]

    }
}

proc_doc ad_header_with_extra_stuff {page_title {extra_stuff_for_document_head ""} {pre_content_ht
    set html "<html>
<head>
$extra_stuff_for_document_head
<title>$page_title</title>
<script language=\"javascript\">
<!--

function showShortmessage(strAction) {
    if (!strAction) strAction = \"\";
    jetzt = new Date();
    instWindow=window.open(\"/popup/instant-message.tcl?action=\"+strAction, \"Instantmessage\", \
    instWindow.focus();
}

[ad_decode [ad_verify_and_get_user_id] "0" "" "
function mailReload() {
  mailswap=new Image();
  mailswap.src=\"/redirect/mailcheck.tcl\";
  mailcheck();
}

function mailcheck() {
  if (mailswap.complete) {
    if (mailswap.width==5) {
          showShortmessage();
    }
    window.setTimeout(\"mailReload()\",30000)
  } else {
    //Image not loaded yet
    window.setTimeout(\"mailcheck()\",1000)
  }
}

mailReload();
"]

// -->
</script>
</head>
"
  if { [info exists prefer_text_only_p] && $prefer_text_only_p == "f" && [ad_graphics_site_avail
        append html "<body bgcolor=\"[ad_parameter bgcolor "" "white"]\" background=\"[ad_paramete
    } else {
        append html "<body bgcolor=[ad_parameter bgcolor "" "white"] text=[ad_parameter textcolor
    }

    append html $pre_content_html
    return $html
}

proc_doc ad_footer {{signatory ""} {suppress_curriculum_bar_p 0}} "writes a horizontal rule, a mai

    global sidegraphic_displayed_p
    if [empty_string_p $signatory] {
        set signatory [ad_system_owner]
    }
    if { [info exists sidegraphic_displayed_p] && $sidegraphic_displayed_p } {
        # we put in a BR CLEAR=RIGHT so that the signature will clear any side graphic
        # from the ad-sidegraphic.tcl package
        set extra_br "<br clear=right>"
    } else {
        set extra_br ""
    }
    if { [ad_parameter EnabledP curriculum 0] && [ad_parameter StickInFooterP curriculum 0] && !$s
        set curriculum_bar "<center>[curriculum_bar]</center>"
    } else {
        set curriculum_bar ""
    }
    return "
$extra_br
$curriculum_bar
<hr>
<a href=\"mailto:$signatory\"><address>$signatory</address></a>
</body>
</html>"
}

# need special headers and footers for admin pages
# notably, we want pages signed by someone different
# (the user-visible pages are probably signed by
# mailto:webmaster@yourdomain.com; the admin pages are probably
# used by this person or persons.  If they don't like
# the way a page works, they should see a link to the
# email address of the programmer who can fix the page).

proc ad_admin_owner {} {
    return [ad_parameter AdminOwner]
}

proc_doc ad_admin_header {page_title {db ""}} "" {
    if {[ad_parameter MenuOnAdminPagesP pdm] == 1} {

        return [ad_header_with_extra_stuff $page_title [ad_pdm "admin" 5 5 $db] [ad_pdm_spacer "ad

    } else {

        return [ad_header_with_extra_stuff $page_title]

    }
}

proc_doc ad_admin_footer {} "Signs pages with ad_admin_owner (usually a programmer who can fix bug
    return "<hr>
<a href=\"mailto:[ad_admin_owner]\"><address>[ad_admin_owner]</address></a>
</body>
</html>"
}

proc_doc ad_return_complaint {exception_count exception_text} "Return a page complaining about the
    # there was an error in the user input
    if { $exception_count == 1 } {
        set problem_string "a problem"
      set please_correct "it"
    } else {
        set problem_string "some problems"
        set please_correct "them"
    }

    ns_return 200 text/html "[ad_header_with_extra_stuff "Problem with Your Input" "" ""]

<h2>Problem with Your Input</h2>

to <a href=/>[ad_system_name]</a>

<hr>

We had $problem_string processing your entry:

<ul>

$exception_text

</ul>

Please back up using your browser, correct $please_correct, and
resubmit your entry.

<p>

Thank you.

[ad_footer]
"}

proc ad_return_error {title explanation} {
    ns_return 500 text/html "[ad_header_with_extra_stuff $title "" ""]
<h2>$title</h2>
<hr>
$explanation
[ad_footer]"
}

# like the above proc, but w/status 200 because it's just a warning
proc ad_return_warning {title explanation} {
    ns_return 200 text/html "[ad_header_with_extra_stuff $title "" ""]
<h2>$title</h2>
<hr>
$explanation
[ad_footer]"
}

proc_doc ad_return_if_another_copy_is_running {{max_simultaneous_copies 1} {call_adp_break_p 0}} {
    # first let's figure out how many are running and queued
    set this_connection_url [ns_conn url]
    set n_matches 0
    foreach connection [ns_server active] {
        set query_connection_url [lindex $connection 4]
        if { $query_connection_url == $this_connection_url } {
            # we got a match (we'll always get at least one
            # since we should match ourselves)
            incr n_matches
        }
    }
    if { $n_matches > $max_simultaneous_copies } {
        ad_return_warning "Too many copies" "This is an expensive page for our server, which is al
        # blow out of the caller as well
        if $call_adp_break_p {
            # we were called from an ADP page; we have to abort processing
            ns_adp_break
        }
        return -code return
    }
    # we're okay
    return 1
}

proc ad_record_query_string {query_string db subsection n_results {user_id "NULL"}} {

    if { $user_id == 0 } {
        set user_id "NULL"
    }

    ns_db dml $db "insert into query_strings
(query_date, query_string, subsection, n_results, user_id)
values
([db_sysdate], '[DoubleApos $query_string]', '[DoubleApos $subsection]', $n_results, $user_id)"
}

proc ad_pretty_mailing_address_from_args {db line1 line2 city state postal_code country_code} {
    set lines [list]
    if [empty_string_p $line2] {
        lappend lines $line1
    } elseif [empty_string_p $line1] {
        lappend lines $line2
    } else {
        lappend lines $line1
        lappend lines $line2
    }
    lappend lines "$city, $state $postal_code"
    if { ![empty_string_p $country_code] && $country_code != "us" } {
        lappend lines [ad_country_name_from_country_code $db $country_code]
    }
    return [join $lines "\n"]
}

# this relies on the variable $db being set already

proc_doc ad_get_user_info {} {Sets first_name, last_name, email in the environment of its caller.}
    uplevel {set user_id [ad_get_user_id]
    if [catch {set selection [ns_db 1row $db "select * from users where user_id=$user_id"]} errmsg
  ad_return_error "Couldn't find user info" "Couldn't find user info."
        return
    }
    set_variables_after_query
}
}

# for pages that have optional decoration

proc_doc ad_decorate_top {simple_headline potential_decoration} "Use this for pages that might or
    if [empty_string_p $potential_decoration] {
        return $simple_headline
    } else {
        return "<table cellspacing=10><tr><td>$potential_decoration<td>$simple_headline</tr></tabl
    }
}

proc_doc ad_parameter {name {subsection ""} {default ""}} {Returns the value of a configuration pa
    set server_name [ns_info server]
    append config_path "ns/server/" $server_name "/acs"
    if ![empty_string_p $subsection] {
        append config_path "/$subsection"
    }
    set config_value [ns_config $config_path $name]
    if ![empty_string_p $config_value] {
        return $config_value
    } else {
        return $default
    }
}

proc_doc ad_parameter_section {{subsection ""}} {Returns all the vars in a parameter section as an
    set server_name [ns_info server]
    append config_path "ns/server/" $server_name "/acs"
    if ![empty_string_p $subsection] {
        append config_path "/$subsection"
}
    set what_aolserver_gave_us [ns_configsection $config_path]
    if [empty_string_p $what_aolserver_gave_us] {
        return [ns_set new "empty set for config section"]
    } else {
        return $what_aolserver_gave_us
    }
}

# returns particular parameter values as a Tcl list (i.e., it selects
# out those with a certain key)

proc ad_parameter_all_values_as_list {name {subsection ""}} {
    set server_name [ns_info server]
    append config_path "ns/server/" $server_name "/acs"
    if ![empty_string_p $subsection] {
        append config_path "/$subsection"
    }
    set the_set [ns_configsection $config_path]
    if [empty_string_p $the_set] {
        return [list]
    }
    set the_values [list]
    for {set i 0} {$i < [ns_set size $the_set]} {incr i} {
        if { [ns_set key $the_set $i] == $name } {
            lappend the_values [ns_set value $the_set $i]
        }
    }
    return $the_values
}

util_report_successful_library_load