Index: openacs-4/packages/trackback/trackback.info
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/trackback/trackback.info,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/trackback/trackback.info 29 Sep 2003 17:56:24 -0000 1.1
@@ -0,0 +1,28 @@
+
+
+
+
+ Trackback
+ Trackbacks
+ f
+ f
+
+
+ Dave Bauer
+ Support for sending and receiving trackback pings.
+ Implements the trackback ping specification: http://www.movabletype.org/docs/mttrackback.html
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: openacs-4/packages/trackback/lib/trackback-chunk.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/trackback/lib/trackback-chunk.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/trackback/lib/trackback-chunk.adp 29 Sep 2003 17:56:24 -0000 1.1
@@ -0,0 +1,9 @@
+
+
+
Index: openacs-4/packages/trackback/lib/trackback-chunk.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/trackback/lib/trackback-chunk.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/trackback/lib/trackback-chunk.tcl 29 Sep 2003 17:56:24 -0000 1.1
@@ -0,0 +1,8 @@
+# /packages/lars-blogger/www/trackback-chunk.tcl
+# generates rdf fragment to indentify trackback URL for a weblog entry
+# @param url url of object to trackback (relative to page root)
+# @param object_id entry_id of entry
+# @param title title of entry
+
+set base_url [ad_url]
+set trackback_url [trackback::object_url -object_id $object_id]
\ No newline at end of file
Index: openacs-4/packages/trackback/sql/oracle/trackback-create.sql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/trackback/sql/oracle/trackback-create.sql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/trackback/sql/oracle/trackback-create.sql 29 Sep 2003 17:56:24 -0000 1.1
@@ -0,0 +1,17 @@
+-- trackback
+-- Dave Bauer dave@thedesignexperience.org
+-- 2003-04-17
+
+-- table to extend general comments to record
+-- trackback specific information
+
+create table trackback_pings (
+ tb_url varchar(1000),
+ comment_id integer
+ constraint
+ tb_pings_comment_id_fk
+ references general_comments
+);
+
+create index tbp_comment_id_fk_idx on trackback_pings(comment_id);
+
\ No newline at end of file
Index: openacs-4/packages/trackback/sql/oracle/trackback-drop.sql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/trackback/sql/oracle/trackback-drop.sql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/trackback/sql/oracle/trackback-drop.sql 29 Sep 2003 17:56:24 -0000 1.1
@@ -0,0 +1,20 @@
+-- trackback
+-- Dave Bauer dave@thedesignexperience.org
+-- 2003-09-29
+
+-- loop through all trackbacked comments
+
+delete from general_comments gc where exists
+ (select 1 from trackback_pings tb
+ where tb.comment_id=gc.comment_id);
+
+begin
+for v_id in select comment_id from trackback_pings
+ acs_message.delete(v_id);
+loop;
+end;
+/
+show errors
+
+drop table trackback_pings;
+
\ No newline at end of file
Index: openacs-4/packages/trackback/sql/postgresql/trackback-create.sql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/trackback/sql/postgresql/trackback-create.sql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/trackback/sql/postgresql/trackback-create.sql 29 Sep 2003 17:56:24 -0000 1.1
@@ -0,0 +1,17 @@
+-- trackback
+-- Dave Bauer dave@thedesignexperience.org
+-- 2003-04-17
+
+-- table to extend general comments to record
+-- trackback specific information
+
+create table trackback_pings (
+ tb_url varchar(1000),
+ comment_id integer
+ constraint
+ tb_pings_comment_id_fk
+ references general_comments
+);
+
+create index tbp_comment_id_fk_idx on trackback_pings(comment_id);
+
\ No newline at end of file
Index: openacs-4/packages/trackback/sql/postgresql/trackback-drop.sql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/trackback/sql/postgresql/trackback-drop.sql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/trackback/sql/postgresql/trackback-drop.sql 29 Sep 2003 17:56:24 -0000 1.1
@@ -0,0 +1,28 @@
+-- trackback
+-- Dave Bauer dave@thedesignexperience.org
+-- 2003-09-29
+
+-- loop through all trackbacked comments
+
+delete from general_comments gc where exists
+ (select 1 from trackback_pings tb
+ where tb.comment_id=gc.comment_id);
+
+create function inline_0() returns integer as '
+
+declare v_row record;
+begin
+
+for v_row in select comment_id from trackback_pings
+
+ perform acs_message__delete(v_row.comment_id);
+loop;
+
+return 0;
+end;' language 'plpgsql';
+
+select inline_0();
+drop function inline_0();
+
+drop table trackback_pings;
+
\ No newline at end of file
Index: openacs-4/packages/trackback/tcl/trackback-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/trackback/tcl/trackback-procs.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/trackback/tcl/trackback-procs.tcl 29 Sep 2003 17:56:24 -0000 1.1
@@ -0,0 +1,191 @@
+#packages/trackback?/tcl/trackback-procs.tcl
+
+ad_library {
+
+}
+
+namespace eval trackback {}
+
+ad_proc -public trackback::new {
+ -tb_url
+ -blog_name
+ -object_id
+ -comment_id
+ -user_id
+ -creation_ip
+ -content
+ -comment_mime_type
+ -is_live
+ -title
+ -context_id
+} {
+ add new trackback
+} {
+
+
+ set revision_id [general_comment_new \
+ -object_id $object_id \
+ -comment_id $comment_id \
+ -user_id "" \
+ -creation_ip $creation_ip \
+ -content $content \
+ -comment_mime_type $comment_mime_type \
+ -category "" \
+ -is_live $is_live \
+ -title $title \
+ -context_id $object_id]
+
+ db_dml add_trackback ""
+ return $comment_id
+}
+
+
+ad_proc -public trackback::package_url {} {
+ returns url of mount location for trackback package
+} {
+ return [apm_package_url_from_key "trackback"]
+}
+
+ad_proc -public trackback::object_url { -object_id } {
+ returns a fully qualified URL for trackback
+} {
+
+ return [trackback::package_url]${object_id}
+}
+
+
+ad_proc -public trackback::auto_ping {
+ -url
+ -content
+ {-blog_name ""}
+ {-title ""}
+ {-excerpt ""}
+} {
+ searches and entry for links and checks them for
+ trackback support. If trackback is supported, the parameters are
+ user to make a trackback ping.
+
+ http://www.movabletype.org/docs/mttrackback.html
+
+ @param url permanent url of weblog entry
+ @param title title of weblog entry
+ @param excerpt part of weblog entry
+} {
+
+ # loop through links
+ # hopefully this will grab anthing starting with http://
+ # maybe we need to check other stuff?
+ set links_list [regexp -all -inline {http://[^\"^\s]*} $content]
+ ns_log debug "trackback: List of links $links_list"
+ # get trackback url
+ foreach link $links_list {
+ set result_list [ad_httpget -url $link]
+ ns_log debug "trackback: results $result_list"
+ array set link_array $result_list
+ if {[string equal $link_array(status) 200 ]} {
+ #get trackback_info if available
+ set ping_url_args [trackback::get_ping_url -data $link_array(page) -link $link]
+ set ping_url [lindex $ping_url_args 0]
+ set ping_method [lindex $ping_url_args 1]
+ if {![empty_string_p $ping_url]} {
+ trackback::send_ping -ping_url $ping_url \
+ -excerpt $excerpt \
+ -url $url \
+ -title $title \
+ -blog_name $blog_name \
+ -method $ping_method
+ }
+
+ }
+
+ }
+
+}
+
+
+ad_proc -public trackback::get_ping_url {
+ -data
+ -link
+} {
+ searches for trackback information
+ @author Dave Bauer dave@thedesignexperience.org
+ @creation-date 2003-04-14
+ @param data html content to search
+ @param link URL of item linked to, used to find the correct trackback URL if more than one trackback RDF section is in data
+
+@returns ping_url URL of trackback link for the content provided or empty string if no trackabck info is found
+} {
+ set ping_url ""
+ set method ""
+ foreach rdf_data [regexp -all -inline {} $data] {
+ # find dc:identifier tag and compare to link passed in
+ # if it matches, look for trackback:ping or fall back to
+ # about
+
+ ns_log debug " trackback::get_ping_url rdf_data $rdf_data"
+ if {[regexp {trackback:ping=\"([^"]+)\"} $rdf_data extra result]} {
+ set ping_url $result
+ set method POST
+ } elseif {[regexp {about=\"([^"]+)\"} $rdf_data extra result]} {
+ set ping_url $result
+ set method GET
+
+ } else {
+ set ping_url "none"
+ set method "none"
+ }
+
+ }
+ return [list $ping_url $method]
+}
+
+ad_proc -public trackback::send_ping {
+ -ping_url
+ -url
+ {-excerpt ""}
+ {-title "" }
+ {-blog_name ""}
+ {-method "POST"}
+} {
+ sends a trackback ping. returns status code if sucessful, or error message
+ if unsucessful
+
+ @author Dave Bauer dave@thedesignexperience.org
+ @creation-date 2003-04-14
+ @param ping_url URL to send ping to
+ @param url URL ping is from
+ @param excerpt Short text from URL referring to ping_url
+ @param title title of URL
+} {
+ ns_log debug "trackback: ping_url=$ping_url method=$method"
+
+ # POST or GET to trackback ping url
+
+ set query_set [ns_set create]
+ ns_set put $query_set url $url
+
+
+ if {[string equal $method GET]} {
+ set form_vars [export_vars -url {url excerpt title blog_name}]
+ ns_log debug "trackback: full url = ${ping_url}&${form_vars}"
+ # old style GET
+ set result [ns_httpget ${ping_url}&${form_vars} 60]
+ } else {
+ #must be POST
+
+ set form_vars [export_vars -url { url }]
+ if {![empty_string_p excerpt]} {
+ ns_set put $query_set excerpt $excerpt
+ }
+ if {![empty_string_p title]} {
+ ns_set put $query_set title $title
+ }
+ if {![empty_string_p blog_name]} {
+ ns_set put $query_set blog_name $blog_name
+ }
+
+ set result [ns_httppost $ping_url "" $query_set]
+ }
+ ns_log debug "trackback: trackback returned: $result"
+ return $result
+}
\ No newline at end of file
Index: openacs-4/packages/trackback/tcl/trackback-procs.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/trackback/tcl/trackback-procs.xql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/trackback/tcl/trackback-procs.xql 29 Sep 2003 17:56:24 -0000 1.1
@@ -0,0 +1,14 @@
+
+
+
+
+
+
+ insert into trackback_pings
+ (tb_url, comment_id, name)
+ values
+ (:tb_url, :comment_id, :blog_name)
+
+
+
+
\ No newline at end of file
Index: openacs-4/packages/trackback/www/index.vuh
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/trackback/www/index.vuh,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/trackback/www/index.vuh 29 Sep 2003 17:56:24 -0000 1.1
@@ -0,0 +1,87 @@
+# handle trackback pings
+# we add them as general comments
+# the rest of the URL should be the object_id
+
+ad_page_contract {
+ handle trackback pings
+} {
+ {title ""}
+ {url ""}
+ {excerpt ""}
+ {blog_name ""}
+} -validate {
+ url_not_empty { if { [empty_string_p $url] } {
+ # return formatted error here
+ }
+ }
+}
+
+set object_id [ad_conn path_info]
+
+# check for public allowed comments
+set party_id [acs_magic_object "the_public"]
+set user_id [ad_conn user_id]
+set permission_p [permission::permission_p -object_id $object_id \
+ -party_id $user_id \
+ -privilege general_comments_create]
+if { $permission_p } {
+
+# we might want to request the URL to see if they really link to us
+# this will eventually be a parameter
+set check_url 0
+
+ if {[string equal $check_url 1]} {
+ #how big might this be?
+ set url_content [util_httpget $url]
+ }
+
+ # can we add a person for people to keep the email straight? That's an
+ # interesting idea
+
+ set error_p 0
+ set error_message ""
+
+ set is_live [ad_parameter AutoApproveCommentsP {general-comments} {t}]
+
+ set creation_ip [ad_conn peeraddr]
+
+ set comment_id [db_nextval acs_object_id_seq]
+ set content "$excerpt"
+ set comment_mime_type text/html
+
+ if {[empty_string_p $blog_name]} {
+ set blog_name $url
+ }
+ if {[empty_string_p $title]} {
+ set title "Trackback from $blog_name"
+ }
+ trackback::new \
+ -tb_url $url \
+ -blog_name $blog_name \
+ -object_id $object_id \
+ -comment_id $comment_id \
+ -user_id "" \
+ -creation_ip $creation_ip \
+ -content $content \
+ -comment_mime_type $comment_mime_type \
+ -is_live $is_live \
+ -title $title \
+ -context_id $object_id
+ if {[empty_string_p $comment_id]} {
+ set error_p 1
+ set error_message "Error creating trackback entry"
+ }
+
+} else {
+ set error_p 1
+ set error_message "Trackback not accepted for this item"
+}
+
+
+ns_return 200 text/html "
+
+
+$error_p
+$error_message
+
+"
\ No newline at end of file