Index: openacs-4/packages/acs-tcl/tcl/application-data-link-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/application-data-link-procs.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-tcl/tcl/application-data-link-procs.tcl	27 Jul 2006 01:39:15 -0000	1.3
+++ openacs-4/packages/acs-tcl/tcl/application-data-link-procs.tcl	1 Sep 2006 20:01:23 -0000	1.4
@@ -18,11 +18,43 @@
     object.
     @param target_object_id The ID of the target object.
 } {
+    application_data_link::new_from \
+	-object_id $this_object_id \
+	-target_object_id $target_object_id
+    application_data_link::new_to \
+	-object_id $this_object_id
+        -from_object_id $target_object_id
+}
+
+ad_proc -public application_data_link::new_from {
+    -object_id:required
+    -to_object_id:required
+} {
+    Create a new data link between this_object_id and target_object_id.
+
+    @param object_id ID of the object that you want linked to the target
+    object.
+    @param target_object_id The ID of the target object.
+} {
     set forward_rel_id [db_nextval acs_data_links_seq]
-    set backward_rel_id [db_nextval acs_data_links_seq]
 
     db_dml create_forward_link {}
+}
+
+ad_proc -public application_data_link::new_to {
+    -object_id:required
+    -from_object_id:required
+} {
+    Create a new data link between this_object_id and target_object_id.
+
+    @param object_id ID of the object that you want linked to the target
+    object.
+    @param target_object_id The ID of the target object.
+} {
+    set backward_rel_id [db_nextval acs_data_links_seq]
+
     db_dml create_backward_link {}
+
 }
 
 ad_proc -public application_data_link::delete_links {
@@ -41,6 +73,23 @@
     }
 }
 
+ad_proc -public application_data_link::delete_from_list {
+    -object_id
+    -link_object_id_list 
+} {
+    Delete references
+
+    @param object_id Object to delete links from
+    @link_object_id_list List of linked object_ids to delete
+
+    @author Dave Bauer (dave@solutiongrove.com)
+    @creation-date 2006-08-31
+} {
+    if {[llength $link_object_id_list]} {
+	db_dml delete_links ""
+    }
+}
+
 ad_proc -public application_data_link::get {
     -object_id:required
 } {
@@ -80,3 +129,102 @@
 } {
     return [db_list linked_object {}]
 }
+
+ad_proc -public application_data_link::get_links_from {
+    -object_id:required
+    {-to_type}
+} {
+    Get a list of objects that are linked from an object
+    If to_type is a subtype of content_revision, we lookup 
+    content_items that have that content_type
+
+    @param object_id object_id one, get objects linked from this object
+    @param to_type object_type of the objects to get links to
+} {
+    set to_type_where_clause ""
+    set content_type_from_clause ""
+
+    if {[info exists to_type] && $to_type ne ""} {
+	set to_type_clause [db_map to_type_where_clause]
+        if {[content::type::is_content_type -content_type $to_type]} {
+	    set to_type_clause [db_map content_type_where_clause]
+	    set content_type_from_clause [db_map content_type_from_clause]
+	}
+    }
+    return [db_list links_from {}]
+}
+
+ad_proc -public application_data_link::scan_for_links {
+    -text
+} {
+    Search for object references within text
+    Supports /o/ /file/ /image/ object URL formats
+
+    @param text Text to scan for object links 
+
+    @return List of linked object_ids
+
+    @author Dave Bauer (dave@solutiongrove.com)
+    @creation-date 2006-08-31
+
+} {
+    set refs [list]
+    set ref_data [regexp -inline -all {/(?:o|image|file)/(\d{1,8})} $text]
+    foreach {discard ref} $ref_data {
+	lappend refs $ref
+    } 
+    return $refs
+}
+
+ad_proc -public application_data_link::update_links_from {
+    -object_id
+    {-text {}}
+    {-link_object_ids {}}
+} {
+    Update the references to this object in the database
+
+    @param object_id Object_id to update
+    @param text Text to scan for references
+    @param linked_object_ids List of object ids to update the links to. Links not in this list will be deleted, and any in this list that are not in teh database will be added.
+
+    @return List of updated linked object_ids
+
+    @author Dave Bauer (dave@solutiongrove.com)
+    @creation-date 2006-08-31
+} {
+    set old_links [application_data_link::get_links_from -object_id $object_id]
+    if {![llength $link_object_ids]} {
+	set link_object_ids [application_data_link::scan_for_links -text $text]
+    }
+    set delete_ids [list]
+    foreach old_link $old_links {
+	if {[lsearch $link_object_ids $old_link] < 0} {
+	    lappend delete_ids $old_link
+	}
+    }
+    application_data_link::delete_from_list -object_id $object_id -link_object_id_list $delete_ids
+    foreach new_link $link_object_ids {
+	if {![application_data_link::link_exists \
+		  -from_object_id $object_id \
+		  -to_object_id $new_link]} {
+	    application_data_link::new_from -object_id $object_id -to_object_id $new_link
+	}
+    }
+}
+
+ad_proc -public application_data_link::link_exists {
+    -from_object_id
+    -to_object_id
+} {
+    Check if a link exists, only checks in the directon requested.
+
+    @param from_object_id
+    @param to_object_id
+
+    @return 0 or 1
+
+    @author Dave Bauer (dave@solutiongrove.com)
+    @creation-date 2006-08-31
+} {
+    return [db_0or1row link_exists ""]
+}
Index: openacs-4/packages/acs-tcl/tcl/test/application-data-link-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/test/application-data-link-procs.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/acs-tcl/tcl/test/application-data-link-procs.tcl	1 Sep 2006 20:01:23 -0000	1.1
@@ -0,0 +1,84 @@
+ad_library {
+    Tests for applicaiton data links
+}
+
+aa_register_case -cats api data_links_scan_links {
+    Test scanning content for object URLs
+} {
+    set text {Some random text /o/1 /file/2 /image/3 /image/4/ /image/5/thumbnail /image/6/info
+              Some More Random Text /o/junk /file/junk /image/junk
+	/o/[junk] /file/[junk] /image/[junk]
+        /o/" /file/" /image/"
+        /o/[ /file/[ /image/[
+    }
+    
+    set links [application_data_link::scan_for_links -text $text]
+    set correct_links [list 1 2 3 4 5 6]
+    aa_log "Links = '${links}'"
+    aa_true "Number of links found is correct" \
+        [expr {[llength $correct_links] eq [llength $links]}]
+
+}
+
+aa_register_case -cats api data_links_update_links {
+    Test updating references,
+    tests scan_for_links
+    and delete_links in the process
+} {
+    aa_run_with_teardown \
+	-rollback \
+	-test_code \
+	{
+	    # create some test objects
+	    set name [ns_mktemp "cr_item__XXXXXX"]
+	    
+	    for {set i 0} {$i<10} {incr i} {
+		set o($i) [content::item::new \
+			       -name ${name}_$i \
+			       -title ${name}_$i]
+	    }
+	    
+	    # generate some text with links between the objects
+	    foreach n [array names o] {
+		append text "\nTest Content Link to $o($n) /o/$o($n) \n"
+	    }
+	    # update the links
+	    foreach n [array names o] {
+		application_data_link::update_links_from \
+		    -object_id $o($n) \
+		    -text $text
+	    }
+	    # scan for links and compare
+	    set correct_links [lsort \
+				  [application_data_link::scan_for_links \
+				       -text $text]]
+	    aa_true "Correct links is not empty" [llength $correct_links]
+	    foreach n [array names o] {
+		set links [lsort \
+			      [application_data_link::get_links_from \
+				   -object_id $o($n)]]
+		aa_true "Object \#${n} references correct" \
+		    [expr {$correct_links eq $links}]
+	    }
+	    # now change the text and update one of the objects
+	    for {set i 0} {$i < 5} {incr i} {
+		    append new_text "\nTest Content Link to $o($i) /o/$o($i) \n"
+	    }
+	    for {set i 0} {$i < 5} {incr i} {
+		application_data_link::update_links_from \
+		    -object_id $o($i) \
+		    -text $new_text
+	    }
+	    set new_correct_links [lsort \
+				      [application_data_link::scan_for_links \
+					   -text $new_text]]
+
+	    for {set i 0} {$i < 5} {incr i} {
+		set links [lsort \
+			      [application_data_link::get_links_from \
+				   -object_id $o($i)]]
+		aa_true "Object \#${i} updated references correct" \
+		    [expr {$new_correct_links eq $links}]
+	    }
+	}
+}
\ No newline at end of file