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 @@ + 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 " - - weblogUpdates.ping - - - [ad_quotehtml $blog_title] - - - [ad_quotehtml $blog_url] - - -" - - # 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 + } } } - -