news-procs.tcl

Utility functions for News Application

Location:

packages/news/tcl/news-procs.tcl

Created:

12-14-00

Author:

stefan@arsdigita.com

CVS Identification:

$Id: news-procs.tcl,v 1.41.2.3 2023/02/20 17:40:07 antoniop Exp $

Procedures in this file

• news_do_notification (public)
• news_items_archive (public)
• news_items_delete (public)
• news_items_make_permanent (public)
• news_notification_get_url (public)
• news_pretty_status (public)
• news_util_get_url (public)

Detailed information

 news_do_notification news_package_id news_id

 news_items_archive id_list when

 news_items_delete id_list

 news_items_make_permanent id_list

 news_notification_get_url news_package_id

 news_pretty_status -publish_date publish_date \
    -archive_date archive_date -status status

 news_util_get_url package_id

Content File Source

# /packages/news/tcl/news-procs.tcl
ad_library {
    Utility functions for News Application

    @author stefan@arsdigita.com
    @creation-date 12-14-00
    @cvs-id $Id: news-procs.tcl,v 1.41.2.3 2023/02/20 17:40:07 antoniop Exp $
}

# News specific db-API wrapper functions and interpreters

ad_proc news_items_archive { id_list when } {

    Immediately gives all news items in list id_list a status of
    archived as of ANSI date in when, i.e. when must be like
    2000-10-11.

} {
    foreach id $id_list {
        db_exec_plsql news_item_archive {}
    }
}

ad_proc news_items_make_permanent { id_list } {

    Immediately gives all news items in list id_list a status of
    permanently published.

} {
    foreach id  $id_list {
        db_exec_plsql news_item_make_permanent {}
    }
}

ad_proc news_items_delete { id_list } {

    Deletes all news items with news_id in id_list.

} {
    foreach id $id_list {
        db_exec_plsql news_item_delete {}
    }
}

d_proc news_util_get_url {
    package_id
} {
    Get package URL from package_id. If this was mounted multiple
    times, only the first occurrence will be returned.

    This proc could be deprecated in the future.

    @see apm_package_url_from_id

    @author Robert Locke
} {
    return [apm_package_url_from_id $package_id]
}

d_proc -private news__datasource {
    object_id
} {
    This proc implements the 'datasource' operation of the
    FtsContentProvider Service Contract and should not be invoke
    directly.

    @author Jeff Davis (davis@xarg.net)
} {
    db_1row get {
        select
        item_id,
        package_id,
        live_revision,
        publish_title,
        publish_lead,
        publish_format,
        publish_date,
        publish_body,
        creation_user,
        item_creator
        from news_items_live_or_submitted
        where item_id = :object_id
        or item_id = (select item_id from cr_revisions where revision_id = :object_id)}

    set url_stub [news_util_get_url $package_id]
    set url "[ad_url]${url_stub}item/$item_id"

    if {$publish_lead eq ""} {
        set publish_lead $publish_body
    }

    set content [template::adp_include /packages/news/www/news \
                     [list \
                          item_id $object_id \
                          publish_title $publish_title \
                          publish_lead $publish_lead \
                          publish_body $publish_body \
                          publish_format $publish_format \
                          publish_image {} \
                          creator_link $item_creator ]]

    return [list \
                object_id $object_id \
                title $publish_title \
                content $content \
                mime text/html \
                keywords {} \
                storage_type text \
                syndication [list link $url \
                                 description $publish_lead \
                                 author $item_creator \
                                 category News \
                                 guid "[ad_url]/o/$item_id" \
                                 pubDate $publish_date \
                                ] \
               ]
}


d_proc -private news__url {
    object_id
} {
    Returns the URL for specified news object.

    This proc implements the 'url' operation of the
    'FtsContentProvider' Service Contract and should not be invoked
    directly.

    @author Robert Locke
} {
    db_1row get {}
    set package_url [apm_package_url_from_id $package_id]
    return "[ad_url]${package_url}item/$item_id"
}

d_proc news_pretty_status {
    {-publish_date:required}
    {-archive_date:required}
    {-status:required}
} {
    Given the publish status of a news items  return a localization human readable
    sentence for the status.

    @param status Publish status short name. Valid values are returned
    by the plsql function news_status.

    @author Peter Marklund
} {
    array set news_status_keys {
        unapproved news.Unapproved
        going_live_no_archive news.going_live_no_archive
        going_live_with_archive news.going_live_with_archive
        published_no_archive news.published_no_archive
        published_with_archive news.published_scheduled_for_archive
        archived news.Archived
    }

    set now_seconds [clock scan now]
    set n_days_until_archive {}

    if { $archive_date ne "" } {
        set archive_date_seconds [clock scan $archive_date]

        if { $archive_date_seconds > $now_seconds } {
            # Scheduled for archive
            set n_days_until_archive [expr {($archive_date_seconds - $now_seconds) / 86400}]
        }
    }

    if { $publish_date ne "" } {
        # The item has been published or is scheduled to be published

        set publish_date_seconds [clock scan $publish_date]
        if { $publish_date_seconds > $now_seconds } {
            # Will be published in the future

            set n_days_until_publish [expr {($publish_date_seconds - $now_seconds) / 86400}]
        }
    }

    # Message lookup may use vars n_days_until_archive and n_days_until_publish
    return [_ $news_status_keys($status)]
}


# register news search implementation
namespace eval news::sc {}

ad_proc -private news::sc::unregister_news_fts_impl {} {
    db_transaction {
        acs_sc::impl::delete -contract_name FtsContentProvider -impl_name news
    }
}

ad_proc -private news::sc::register_news_fts_impl {} {
    set spec {
        name "news"
        aliases {
            datasource news__datasource
            url news__url
        }
        contract_name FtsContentProvider
        owner news
    }

    acs_sc::impl::new_from_spec -spec $spec
}


d_proc -private news__last_updated {
    package_id
} {

    Return the timestamp of the most recent item in this news instance.

    This proc implements the 'lastUpdated' operation of the
    'RssGenerationSubscriber' Service Contract and should not be invoked
    directly.

    @author Dave Bauer (dave@thedesignexperience.org)
    @creation-date 2005-01-22

    @param package_id

} {
    return [db_string get_last_updated {}]
}

d_proc -private news__rss_datasource {
    summary_context_id
} {
    This procedure implements the 'datasource' operation of the
    'RssGenerationSubscriber' Service Contract and should not be
    invoked directly.

    @author Dave Bauer (dave@thedesignexperience.org)
} {
    # TODO make limit a parameter
    set limit 15

    set items [list]
    set counter 0
    set package_url [news_util_get_url $summary_context_id]
    db_foreach get_news_items {
        select cn.*,
        ci.item_id,
        cr.content,
        cr.title,
        cr.mime_type,
        cr.description,
        to_char(o.last_modified, 'YYYY-MM-DD HH24:MI:SS') as last_modified
        from cr_news cn,
        cr_revisions cr,
        cr_items ci,
        acs_objects o
        where cn.package_id=:summary_context_id
        and cr.revision_id=cn.news_id
        and cn.news_id=o.object_id
        and cr.item_id=ci.item_id
        and cr.revision_id=ci.live_revision
        order by o.last_modified desc
        fetch first :limit rows only
    } {
        set entry_url [export_vars -base "[ad_url]${package_url}item" {item_id}]

        # content doesn't need to be convert to plain text. moreover it will look much
        # better in HTML
        set content_as_html [ad_html_text_convert -from $mime_type -to text/html -- $content]
        set description $content_as_html

        # Always convert timestamp to GMT
        set entry_date_ansi [lc_time_tz_convert -from [lang::system::timezone] -to "Etc/GMT" -time_value $last_modified]
        set entry_timestamp "[clock format [clock scan $entry_date_ansi] -format "%a, %d %b %Y %H:%M:%S"] GMT"

        lappend items [list \
                           link $entry_url \
                           title $title \
                           description $description \
                           value $content_as_html \
                           timestamp $entry_timestamp]

        if { $counter == 0 } {
            set column_array(channel_lastBuildDate) $entry_timestamp
            incr counter
        }
    }

    set news_title [_ news.system_name_News [list system_name [ad_system_name]]]

    set column_array(channel_title) $news_title
    set column_array(channel_description) $news_title
    set column_array(items) $items
    set column_array(channel_language) ""
    set column_array(channel_copyright) ""
    set column_array(channel_managingEditor) ""
    set column_array(channel_webMaster) ""
    set column_array(channel_rating) ""
    set column_array(channel_skipDays) ""
    set column_array(channel_skipHours) ""
    set column_array(version) 2.0
    set column_array(image) ""
    set column_array(channel_link) "[ad_url]$package_url"
    return [array get column_array]
}

d_proc -private news_update_rss {
    -summary_context_id
} {
    Regenerate RSS feed

    @author Dave Bauer (dave@thedesignexperience.org)
    @creation-date 2005-02-04

    @param summary_context_id

    @return

    @error
} {
    set subscr_id [rss_support::get_subscr_id \
                       -summary_context_id $summary_context_id \
                       -impl_name "news" \
                       -owner "news"]
    rss_gen_report $subscr_id
}

# add news notification
d_proc -public news_notification_get_url {
    news_package_id
} {
    Get package URL from package_id. If this was mounted multiple
    times, only the first occurrence will be returned.

    This proc could be deprecated in the future.

    @see apm_package_url_from_id
} {
    return [apm_package_url_from_id $news_package_id]
}

d_proc -public news_do_notification {
    news_package_id
    news_id
} {
    Sends notifications for specified news item.
} {
    set system_url [parameter::get_from_package_key -package_key acs-kernel -parameter SystemURL]
    set package_url [apm_package_url_from_id $news_package_id]

    set node_id [ad_conn node_id]
    set instance_name [application_group::closest_ancestor_element \
                           -include_self \
                           -node_id $node_id \
                           -element "instance_name"]

    # get the title and teaser for latest news item for the given package id
    if { [db_0or1row get_news {
        select item_id,
               publish_date,
               publish_title as title,
               publish_lead as lead,
               publish_body,
               publish_format
         from news_items_live_or_submitted
        where news_id = :news_id
    }] } {
        set item_url ${system_url}${package_url}item?item_id=$item_id
        set new_content "$title\n\n$lead\n\n[ad_html_text_convert -from $publish_format -to text/plain -- $publish_body]"
        set html_content [ad_html_text_convert -from $publish_format -to text/html -- $publish_body]
        append new_content "\n\n[string repeat - 70]"
        append new_content "\n\n${item_url} \n\n"
        append html_content "<br><br><hr>" [ad_html_text_convert "\n ${item_url}"] "<br><br>"
    }

    # Notifies the users that requested notification for the specific news item
    notification::new \
        -type_id [notification::type::get_type_id -short_name one_news_item_notif] \
        -object_id $news_package_id \
        -notif_subject "\[$instance_name\] #news.Latest_News#" \
        -notif_text $new_content \
        -notif_html $html_content \
        -notif_date $publish_date
}

# Local variables:
#    mode: tcl
#    tcl-indent-level: 4
#    indent-tabs-mode: nil
# End: