irc-logger-procs.tcl

Does not contain a contract.

Location:
/packages/irc-logger/tcl/irc-logger-procs.tcl
File Contents

ad_library {

     Procs used by the irc-logger module.

     @creation-date 2003-01-27
     @author Bart Teeuwisse (bart.teeuwisse@thecodemill.biz)
     @cvs-id $Id: irc-logger-procs.tcl,v 1.12 2022/10/05 07:58:50 gustafn Exp $
     @arch-tag: 02bf231b-7b2f-4261-b671-ccb4d4b7a6f6
}

namespace eval irc::logger {

    # The namespace of the irc-logger module

}

d_proc -public irc::logger::get_log {
    -date:required
    -package_id:required
} {

    Check which .rdf file holds the current IRC log in RDF format as
    created by Dave Beckett's logger.

    @creation-date 2003-01-27
    @author Bart Teeuwisse (bart.teeuwisse@thecodemill.biz)

    @param date The date in YYYY-MM-DD format to get the IRC log of.

    @param package_id The package_id of the mounted IRC logger
    instance to get the log for.

    @return The full path to the IRC log in RDF format.

    @error Return the empty string

} {

    # Locate the RDF log of the given date

    foreach rdf_log [glob -nocomplain -directory [parameter::get \
                                                      -parameter irc_rdf_dir \
                                                      -package_id $package_id \
                                                      -default ""] $date.rdf] {
        return $rdf_log
    }

    # Couldn't find the log, return the empty string.

    return ""
}

d_proc -public irc::logger::apply_xslt {
    -rdf_log:required
    -xsl_style:required
    {-package_id ""}
} {

    Transform the RDF IRC log to HTML using passed XSL stylesheet.

    @creation-date 2003-01-27
    @author Bart Teeuwisse (bart.teeuwisse@thecodemill.biz)

    @param rdf_log The full path to the IRC log in RDF format

    @param xsl_style The full path to the XSL stylesheet to
    transform the RDF log into HTML with.

    @return The transformed IRC log in HTML.

    @error Return the empty string.

} {

    # Parse the RDF log and the XSL style sheet into DOM trees.
    # Return the empty string if the XSL style could not be applied.
    set text ""

    # Return the empty string if the XSL style could not be applied.
    set text ""

    if {![catch {set rdf [dom parse [read [open $rdf_log r]]]} error_msg]} {
        if {![catch {set xsl [dom parse [read [open $xsl_style r]]]} error_msg]} {
    
            # Transform the RDF DOM tree to an HTML DOM tree
        
            if {![catch {set html [$rdf xslt $xsl]} error_msg]} {

                # Serialize the HTML DOM tree as HTML text

        set text [$html asHTML]

            } else {
                ns_log warning "irc::logger::apply_xslt - Could not transform RDF log '$rdf_log' to HTML with XSL sheet '$xsl_style': $error_msg"
            }
        } else {
            ns_log warning "irc::logger::apply_xslt - Could not parse $xsl_style: $error_msg"
        }
    $rdf delete
    } else {
        ns_log warning "irc::logger::apply_xslt - Could not parse $rdf_log: $error_msg"
    }
    
    # clean up the dom references, otherwise we have a mem leak.
    if {[info exists rdf]} {
    $rdf delete
    }
    if {[info exists xsl]} {
    $xsl delete
    }
    if {[info exists html]} {
    $html delete
    }
    return $text
}

d_proc -public irc::logger::rotate_logs {
    -package_id:required
    {-all:boolean}
} {

    Rotate the ETP pages so that the ETP page with the new log is
    listed first instead of last. Please be aware that changes to 
    the sort order through of these logs through ETP might have 
    undesired side effects to the order. This an artifact of ETP
    and not of the IRC logger.

    @creation-date 2003-02-18
    @author Bart Teeuwisse (bart.teeuwisse@thecodemill.biz)

    @param package_id The package_id of the ETP instance that is 
    the parent of the ETP log pages.

    @param -all Switch indicating wether all ETP instances should 
    be rotated or only the ETP log pages. This flag is used when
    the 'current' link has been created and needs to be rotated to 
    the top of the page.

    @return none

    @error none
} {

    # Get the ID of the parent folder of the ETP log pages.

    set parent_id [db_string get_parent_id {} -default {}]

    # Rotate all ETP pages or just the logs?

    if {$all_p} {
    set i1_select_criteria "true"
    set i2_select_criteria "true"
    } else {
    set i1_select_criteria [db_map i1_criteria]
    set i2_select_criteria [db_map i2_criteria]
    }

    # Rotate the logs by assigning the tree_sortkey of the next ETP
    # page to the current page. Assign the tree_sortkey of the first
    # page to the last (=new) page.

    db_foreach etp_logs {} {

        # Assign the tree_sortkey of the next ETP page to the current
        # page or the tree_sortkey of the first ETP to the last page.

        db_dml shift {}
    }
}

d_proc -public irc::logger::update_log {
    -date:required
    -package_id:required
} {

    Check the IRC log of the passed date associated with
    package_id. Transform the RDF log to HTML if the log has changed
    since the last time this proc was run. Then place the HTML log
    in an ETP page of the ETP instance that IRC logger is mounted
    under. The ETP page has the name of passed date.

    @creation-date 2003-01-27
    @author Bart Teeuwisse (bart.teeuwisse@thecodemill.biz)

    @param date The date in YYYY-MM-DD format to get the IRC log of.

    @param package_id The package_id of the mounted IRC logger
    instance to get the log for.

    @return none

    @error Write warning messages to the log were necessary.

} {

    # Check for an ETP parent node.

    set logger_url [apm_package_url_from_id $package_id]
    if {![empty_string_p $logger_url]} {
        set parent_package_id [site_node::get_object_id \
                                   -node_id [site_node::get_parent_id \
                                                 -node_id [site_node::get_node_id \
                                                               -url $logger_url]]]
        set parent_package_key [apm_package_key_from_id $parent_package_id]
        if {[string equal $parent_package_key "edit-this-page"]} {

            # Get the RDF log for today.

            set irc_rdf_log [irc::logger::get_log \
                                 -date $date \
                                 -package_id $package_id]
            if {![empty_string_p $irc_rdf_log]} {
                
                # Check if today's log has been modified. 

                if {[file mtime $irc_rdf_log] > [expr [clock seconds] - [parameter::get \
                                                                             -parameter irc_log_interval \
                                                                             -package_id $package_id \
                                                                             -default 600]]} {
                    
                    # Transform the RDF log to HTML.

                    set irc_html_log [irc::logger::apply_xslt \
                                          -rdf_log $irc_rdf_log \
                                          -xsl_style [parameter::get \
                                                          -parameter xsl_stylesheet \
                                                          -package_id $package_id \
                                                          -default "[acs_package_root_dir [apm_package_key_from_id $package_id]]/data/default.xsl"] \
                      -package_id $package_id]

                    if {![empty_string_p $irc_html_log]} {
                        
                        # The transformation was succesful. Time to create
                        # or update the ETP page.

                        set irc_channel_name "[parameter::get \
                                   -parameter irc_channel_name \
                                   -package_id $package_id \
                                   -default ""]"
                        set log_latest_revision_id [etp::get_latest_revision_id $parent_package_id $date]
                        set content_type [etp::get_content_type]
                        if {[empty_string_p $log_latest_revision_id]} {

                            # Create a new ETP page for the log.

                            db_exec_plsql page_create {}
                set log_live_revision_id [etp::get_live_revision_id $parent_package_id $date]

                # Rotate the logs so that the new log is
                # on top.

                irc::logger::rotate_logs -package_id $parent_package_id

                # Symlink 'current' to the latest log.

                set log_url "[site_node::get_url -node_id $parent_package_id]$date"
                if {![db_0or1row get_extlink {}]} {

                # Create a 'current' symlink to the
                # new log. As ETP symlinks don't
                # support labels the link is created
                # as an ETP extlink which do support
                # labels and descriptions.

                set link_label "current"
                set link_description "Current $irc_channel_name conversation log"
                db_exec_plsql create_extlink {}

                # Rotate the symlink to the top of the list.

                irc::logger::rotate_logs -package_id $parent_package_id -all

                } else {

                # Point the 'current' symlink to the new log.

                db_dml update_extlink {}

                }
                        } else {
                set log_live_revision_id [etp::get_live_revision_id $parent_package_id $date]
            }

                        # The update the existing ETP page for the log.
                        
                        set log_description "Conversation log of $irc_channel_name of $date"
                        db_dml update_revision {}

                        # Flush the cached page from memory

                        util_memoize_flush "etp::get_pa $parent_package_id $date $content_type"
                    }
                }
            }    
        } else {
            ns_log warning "irc::logger::update_log - IRC logger $logger_url is not directly mounted under an ETP instance but rather $parent_package_key"
        }
    } else {
        ns_log warning "irc::logger::update_log - IRC logger $package_id has been unmounted"
    }
}

d_proc -public irc::logger::scheduled_update {
    -package_id:required
} {

    Scheduled procedure to check for updates of today's IRC log.

    @creation-date 2003-01-27
    @author Bart Teeuwisse (bart.teeuwisse@thecodemill.biz)

    @param package_id The package_id of the mounted IRC logger
    instance to get the log for.

    @return none

    @error none

} {
    # The current log has the name of today's date in the GMT
    # timezone.

    set gmt_today [clock format [clock seconds] -format %Y-%m-%d -gmt true]
    irc::logger::update_log \
        -date $gmt_today \
        -package_id $package_id
}

namespace eval dom::xpathFunc::irc::logger {

    # The namespace of the tDOM XSLT extension functions for the
    # irc-logger module.

}

d_proc -public dom::xpathFunc::irc::logger::user_link {
    ctxNode 
    pos 
    nodeListType 
    nodeList 
    args
} {
        
    <p>Create a link to the user account on this site where the IRC
    nick matches the user's screen name.</p>

    <p>Rolf (rolf@pointsman.de) from the tDOM team on tDOM extension
    functions:</p>

    <blockquote>
    <p>If an XPath expr (both for the selectNodes method and in XSLT
    stylesheets) uses a not standard XPath function name (you cannot
    'overwrite' the C coded standard built-in functions), the engine
    looks, if there is a tcl proc with the given function name in
    the ::dom::xpathFunc:: namespace. In other words: all extension
    functions procs must reside in the namespace ::dom::xpathFunc or
    in a child namespace of that namespace. If the XPath extension
    function has a prefix, the prefix is expanded to the namespace
    URI and that namespace URI must be the name of the child
    namespace of the ::dom::xpathFunc namespace.</p>

    <p>If there is such a proc, this proc is called with the following
    arguments: ctxNode pos nodeListType nodeList args. The 'args'
    are, as type/value pairs, the arguments, that are given to the
    extension functions. (E.g. if you have
    myExtensionFunction('foo'), you will get two args, the first
    "string" the second "foo").</p>

    <p>The tcl proc, which implements the extension function must
    return a list of two elements: {&lt;type&gt; &lt;value&gt;}. The possible
    types at the moment are: "bool", "number", "string", "nodes".</p>

    <p>But don't get confused by my probably (too) vague
    explanations. Just look at the examples in the xpath.test and
    tdom.tcl files. For almost all 'real life' needs, you should get
    it very fast, what to do from that usage examples.</p>
    </blockquote>

    @author Bart Teeuwisse (bart.teeuwisse@thecodemill.biz)
    @creation-date 2003-01-31

    @param ctxNode See <a href="http://www.tdom.org">tDOM</a> documentation.
    @param pos See <a href="http://www.tdom.org">tDOM</a> documentation.
    @param nodeListType See <a href="http://www.tdom.org">tDOM</a> documentation.
    @param nodeList See <a href="http://www.tdom.org">tDOM</a> documentation.

    @param args A single (type, value) pair of type 'attrnodes' with
    the nick of the IRC user.

    @return A single (type, value) pair with a link to the user
    account on the site. Or just the nick if no user account was found.

    @error The empty string.

} {

    # Default return value

    set link ""

    # Limited parameter checking. The tDOM related parameters don't
    # matter.

    if {[llength $args] == 2} {

        # Get argument type and value.

        foreach {type value} $args {
            break
        }
        
        # Check that the parameter an attribute node is and extract
        # the value of the attribute.

        if {[string equal $type "attrnodes"]} {
            set nick [lindex [lindex $value end] end]

            # Locate the first user with a screen name of 'nick' on this
            # site. DB caching reduces the number of hits on the DB
            # itself.
        
        # community_member_url was changed to require a conn
        # it always returned / for the subsite since we run from a 
        # scheduled proc. This needs to be smarter.

        set community_member_url "[parameter::get -package_id [ad_acs_kernel_id] -parameter CommunityMemberURL]?[export_vars {user_id}]"

            if {[db_0or1row get_user {}]} {
                set link "<a href=\"$community_member_url\" title=\"$name\">$nick</a>"
            } else {
                set link $nick
            }
        } else {
            ns_log warning "dom::xpathFunc::irc::logger::user_link wrong parameter type '$type($value)'; type should have been attrnodes"
        }
    } else {
        ns_log warning "dom::xpathFunc::irc::logger::user_link accepts only 1 parameter, received [llength $args] parameters"
    }

    return [list string $link]
}
irc-logger-procs.tcl

Related Files

File Contents
