Index: openacs-4/packages/lars-blogger/lars-blogger.info
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/lars-blogger/lars-blogger.info,v
diff -u -r1.26 -r1.27
--- openacs-4/packages/lars-blogger/lars-blogger.info 8 Dec 2003 05:15:04 -0000 1.26
+++ openacs-4/packages/lars-blogger/lars-blogger.info 8 Dec 2003 05:19:50 -0000 1.27
@@ -21,6 +21,7 @@
<requires url="notifications" version="5.0.0a5"/>
<requires url="rss-support" version="0.3d1"/>
<requires url="trackback" version="0.1d"/>
+ <requires url="xml-rpc" version="0.1"/>
<callbacks>
<callback type="after-instantiate" proc="lars_blogger::install::package_instantiate"/>
Index: openacs-4/packages/lars-blogger/tcl/entry-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/lars-blogger/tcl/entry-procs.tcl,v
diff -u -r1.9 -r1.10
--- openacs-4/packages/lars-blogger/tcl/entry-procs.tcl 1 Nov 2003 08:45:38 -0000 1.9
+++ openacs-4/packages/lars-blogger/tcl/entry-procs.tcl 8 Dec 2003 05:19:49 -0000 1.10
@@ -48,9 +48,9 @@
# Notifications
lars_blogger::entry::do_notifications -entry_id $entry_id
-
+
# Ping weblogs.com
- lars_blog_weblogs_com_update_ping
+ lars_blog_weblogs_com_update_ping -package_id $package_id
# trackback
lars_blogger::entry::trackback -entry_id $entry_id
@@ -175,8 +175,8 @@
-entry_id
{-multirow "comments"}
} {
- @ param entry_id
- @ param multirow
+ @param entry_id
+ @param multirow
upvars a multirow in the caller to display comments
} {
Index: openacs-4/packages/lars-blogger/tcl/weblogs-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/lars-blogger/tcl/weblogs-procs.tcl,v
diff -u -r1.5 -r1.6
--- openacs-4/packages/lars-blogger/tcl/weblogs-procs.tcl 1 Nov 2003 08:45:38 -0000 1.5
+++ openacs-4/packages/lars-blogger/tcl/weblogs-procs.tcl 8 Dec 2003 05:19:49 -0000 1.6
@@ -9,109 +9,57 @@
ad_proc -private lars_blog_weblogs_com_update_ping {
{-package_id ""}
{-location}
- {-timeout 30}
- {-depth 0}
} {
- Sends the xml/rpc message weblogUpldates.ping to weblogs.com
+ Sends the xml/rpc message weblogUpdates.ping to weblogs.com
returns 1 if successful and logs the result.
@author Jerry Asher (jerry@theashergroup.com)
@author Lars Pind (lars@pinds.com)
} {
- set package_url [lars_blog_public_package_url -package_id $package_id]
-
if { ![exists_and_not_null package_id] } {
set package_id [ad_conn package_id]
}
+ set package_url [lars_blog_public_package_url -package_id $package_id]
+
# Should we ping?
- set ping_p [ad_parameter -package_id $package_id "weblogs_update_ping_p" "lars-blogger" 0]
+ set ping_p [parameter::get -boolean \
+ -package_id $package_id \
+ -parameter "weblogs_update_ping_p" \
+ -default 0]
+
if { !$ping_p } {
return
}
if { ![info exists location] } {
- set location [ad_parameter -package_id $package_id "weblogs_ping_url"]
+ set location [parameter::get -package_id $package_id \
+ -parameter "weblogs_ping_url"]
}
if { [empty_string_p $location] } {
ns_log Error "lars_blog_weblogs_com_update_ping: No URL to ping"
return
}
- set blog_title [db_string package_name { *SQL* }]
-
+ set blog_title [db_string package_name {}]
set blog_url "[ad_url]$package_url"
ns_log debug "lars_blog_weblogs_com_update_ping:"
- if [catch {
- if {[incr depth] > 10} {
- return -code error "rss_weblogUpdatesping: Recursive redirection: $location"
- }
- set req_hdrs [ns_set create]
-
- set message "<?xml version=\"1.0\"?>
-<methodCall>
- <methodName>weblogUpdates.ping</methodName>
- <params>
- <param>
- <value>[ad_quotehtml $blog_title]</value>
- </param>
- <param>
- <value>[ad_quotehtml $blog_url]</value>
- </param>
- </params>
-</methodCall>"
-
- # headers necesary for a post and the form variables
- ns_set put $req_hdrs "Content-type" "text/xml"
- ns_set put $req_hdrs "Content-length" [string length $message]
- set http [ns_httpopen POST $location $req_hdrs 30 $message]
- set rfd [lindex $http 0]
- set wfd [lindex $http 1]
- set rpset [lindex $http 2]
-
- flush $wfd
- close $wfd
-
- ns_log debug "lars_blog_weblogs_com_update_ping: pinging for blog $blog_title and url $blog_url"
- ns_log debug "message: \"$message\""
-
- set headers $rpset
- set response [ns_set name $headers]
- set status [lindex $response 1]
-if {$status == 302} {
- set location [ns_set iget $headers location]
- if {$location != ""} {
- ns_set free $headers
- close $rfd
- return [lars_blog_weblogs_com_update_ping -package_id $package_id -location $location -timeout $timeout -depth $depth]
- }
-}
- set length [ns_set iget $headers content-length]
-if [string match "" $length] {set length -1}
- set err [catch {
- while 1 {
- set buf [_ns_http_read $timeout $rfd $length]
- append page $buf
- if [string match "" $buf] break
- if {$length > 0} {
- incr length -[string length $buf]
- if {$length <= 0} break
- }
- }
- } errMsg]
- ns_set free $headers
- close $rfd
- if $err {
- global errorInfo
- return -code error -errorinfo $errorInfo $errMsg
- }
- } errmsg ] {
+ if { [catch {xmlrpc::remote_call \
+ $location weblogUpdates.ping \
+ -string [ad_quotehtml $blog_title] \
+ -string [ad_quotehtml $blog_url] } errmsg ] } {
ns_log warning "lars_blog_weblogs_com_update_ping error: $errmsg"
return -1
} else {
- ns_log debug "lars_blog_weblogs_com_update_ping: $page"
- return 1
+ array set result $errmsg
+ if { $result(flerror) } {
+ # got an error
+ ns_log warning "lars_blog_weblogs_com_update_ping error: $result(message)"
+ return -1
+ } else {
+ # success
+ ns_log debug "lars_blog_weblogs_com_update_ping success: $result(message)"
+ return 1
+ }
}
}
-
-