Initial Import

lib/trackback-chunk.adp

+<rdf:RDF xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
+         xmlns:dc="http://purl.org/dc/elements/1.1/"
+         xmlns:trackback="http://madskills.com/public/xml/rss/module/trackback/">
+<rdf:Description
+    rdf:about="@base_url@@url@"
+    dc:identifer="@base_url@@url@"
+    dc:title="@title@"
+    trackback:ping="@base_url@@trackback_url@" />
+</rdf:RDF>

lib/trackback-chunk.tcl

+# /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

sql/oracle/trackback-create.sql

+-- 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),
+	name	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);
+	

sql/oracle/trackback-drop.sql

+-- 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_row in select comment_id from trackback_pings
+    acs_message.delete(v_row.comment_id);
+loop;
+end;
+/
+show errors
+
+drop table trackback_pings;
+ 
\ No newline at end of file

sql/postgresql/trackback-create.sql

+-- 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),
+	name	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

sql/postgresql/trackback-drop.sql

+-- 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

tcl/test/trackback-procs.tcl

+ad_library {
+    Automated tests.
+
+    @author Simon Carstensen
+    @creation-date 11 November 2003
+    @cvs-id $Id$
+}
+
+aa_register_case trackback_new {
+    Test the trackback::new proc.
+} {    
+
+    aa_run_with_teardown \
+        -rollback \
+        -test_code {
+
+            set tb_url "http://foobar.com"
+            set object_id [ad_conn path_info]
+            set comment_id [db_nextval acs_object_id_seq]
+            
+            # Add trackback
+            trackback::new \
+                -tb_url $tb_url \
+                -blog_name "Foo" \
+                -object_id $object_id \
+                -comment_id $comment_id \
+                -user_id [ad_conn user_id] \
+                -creation_ip [ad_conn peeraddr] \
+                -content "Foo" \
+                -comment_mime_type "text/plain" \
+                -is_live f \
+                -title "Foo" \
+                -context_id $object_id
+
+            set success_p [db_string success_p {
+                select 1 from trackback_pings where tb_url = :tb_url
+            } -default "0"]
+
+            aa_equals "trackback was added succesfully" $success_p 1
+        }
+}

tcl/trackback-procs.tcl

+#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]
+       ns_log Debug "Trackback tb_url=$tb_url blog_name=$blog_name"
+       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
+
+@return 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 {<rdf:Description.*?/>} $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]
+        ns_log debug "trackback: trackback returned: $result"
+    } 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
+	}
+
+	if {[catch {[ns_httppost $ping_url "" $query_set]} result]} {
+            ns_log debug "trackback: trackback returned: $result"
+	}
+    }
+    return $result
+}
\ No newline at end of file

tcl/trackback-procs.xql

+<?xml version="1.0"?>
+
+<queryset>
+	
+    <fullquery name="trackback::new.add_trackback">
+	<querytext>
+            insert into trackback_pings
+	    (tb_url, comment_id, name)
+	    values
+	    (:tb_url, :comment_id, :blog_name)
+	</querytext>
+   </fullquery>
+
+</queryset>
\ No newline at end of file

trackback.info

+<?xml version="1.0"?>
+<!-- Generated by the OpenACS Package Manager -->
+
+<package key="trackback" url="http://openacs.org/repository/apm/packages/trackback" type="apm_service">
+    <package-name>Trackback</package-name>
+    <pretty-plural>Trackbacks</pretty-plural>
+    <initial-install-p>f</initial-install-p>
+    <singleton-p>t</singleton-p>
+    <auto-mount>tb</auto-mount>
+
+    <version name="0.1d3" url="http://openacs.org/repository/download/apm/trackback-0.1d3.apm">
+        <owner url="mailto:dave@thedesignexperience.org">Dave Bauer</owner>
+        <summary>Support for sending and receiving trackback pings.</summary>
+        <release-date>2003-09-30</release-date>
+        <description format="text/html">Implements the trackback ping specification 
+&lt;a href="http://www.movabletype.org/docs/mttrackback.html"&gt;http://www.movabletype.org/docs/mttrackback.html&lt;/a&gt;,
+for use with lars-blogger.
+</description>
+
+        <provides url="trackback" version="0.1d3"/>
+        <requires url="general-comments" version="4.0"/>
+
+        <callbacks>
+        </callbacks>
+        <parameters>
+        <!-- No version parameters -->
+        </parameters>
+
+    </version>
+</package>

www/doc/index.html

+<html>
+<head>
+<title>Trackback Package Documentation for OpenACS</title>
+</head>
+<h2>Trackback Package Documentation for OpenACS</h2>
+<h3>Background</h3>
+<p>
+This is an implementation of the <a href="http://www.movabletype.org/docs/mttrackback.html">trackback specification</a> for use in OpenACS.
+</p>
+<p>
+Trackback is a method of notifying a web site that you have linked to it. It is most commonly used to link between weblogs. It allows writers to comment on posts on other web sites from their own page instead of visiting the other site. Besides this, it generally allows writers to learn who is reading and commenting on their posts and helps build community.
+</p>
+<p>A good guide to how it all works is <a href="http://www.movabletype.org/trackback/beginners/" target="new">A Beginner's Guide to Trackback (opens in new window)</a> by Mena and Ben Trott, the original designers of the Trackback specificaion.</p>
+<h3>How it works</h3>
+<p>
+Trackback pings are stored as general-comments. Because general_comment is anot a content repostiory content_type, trackback is not a seperate object_type. This will be fixed in a future version. Additional information about the weblog that sent the ping is stored in the trackback_pings table.
+</p>
+<p>
+Currently any object_id that allows general_comment_create for the "Unregistered Vistor" user (user_id 0) can receive a trackback ping. That is the only activity required to allow trackback to be sent to an object.
+</p>
+<p>
+A sample implementation is in the lars-blogger package. To display trackbrack information along with comment information, include the /packages/trackback/lib/trackback-chunk template in the page you wish to display comments and trackback pings. The parameters to the include are:
+
+<pre>
+# /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
+</pre>
+
+</p>
+
+<h3>TODO</h3>
+<p>
+Pending cleanup of general comments to remove dependence on acs_messaging, trackback_ping should be a subtype of a general_comment object type.
+</p>
\ No newline at end of file

www/index.vuh

+# 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 error_p 1
+		set error_message "<message>You must specify a URL</message>"
+		ns_return 200 text/html "
+<?xml version=\"1.0\" encoding=\"iso-8859-1\"?>
+<response>
+<error>$error_p</error>
+$error_message
+</response>"
+		ad_script_abort
+		}
+	}
+}
+
+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 "<message>Trackback not accepted for this item</message>"
+}
+
+
+ns_return 200 text/html "
+<?xml version=\"1.0\" encoding=\"iso-8859-1\"?>
+<response>
+<error>$error_p</error>
+$error_message
+</response>
+"