Index: openacs-4/packages/acs-kernel/acs-kernel.info =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-kernel/acs-kernel.info,v diff -u -N -r1.107 -r1.108 --- openacs-4/packages/acs-kernel/acs-kernel.info 11 Jul 2009 23:47:24 -0000 1.107 +++ openacs-4/packages/acs-kernel/acs-kernel.info 4 Jan 2010 19:54:37 -0000 1.108 @@ -7,15 +7,15 @@ t t - + OpenACS Core Team Routines and data models providing the foundation for OpenACS-based Web services. 2009-06-19 OpenACS The OpenACS kernel contains the core datamodel create and drop scripts for such things as objects, groups, partiies and the supporting PL/SQL and PL/pgSQL procedures. 3 - + Index: openacs-4/packages/acs-kernel/sql/oracle/acs-relationships-create.sql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-kernel/sql/oracle/acs-relationships-create.sql,v diff -u -N -r1.11 -r1.12 --- openacs-4/packages/acs-kernel/sql/oracle/acs-relationships-create.sql 26 Sep 2006 14:48:02 -0000 1.11 +++ openacs-4/packages/acs-kernel/sql/oracle/acs-relationships-create.sql 4 Jan 2010 19:54:37 -0000 1.12 @@ -355,12 +355,14 @@ constraint acs_data_links_obj_two_fk references acs_objects (object_id) on delete cascade, + relation_tag varchar2(100), constraint acs_data_links_un unique - (object_id_one, object_id_two) + (object_id_one, object_id_two, relation_tag) ); create index acs_data_links_id_one_idx on acs_data_links (object_id_one); create index acs_data_links_id_two_idx on acs_data_links (object_id_two); +create index acs_data_links_rel_tag_idx on acs_data_links (relation_tag); -------------- Index: openacs-4/packages/acs-kernel/sql/oracle/upgrade/upgrade-5.6.0d3-5.6.0d4.sql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-kernel/sql/oracle/upgrade/upgrade-5.6.0d3-5.6.0d4.sql,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-kernel/sql/oracle/upgrade/upgrade-5.6.0d3-5.6.0d4.sql 4 Jan 2010 19:54:37 -0000 1.1 @@ -0,0 +1,9 @@ +alter table acs_data_links add relation_tag varchar2(100); + +drop index acs_data_links_un; + +create unique index acs_data_links_un on acs_data_links ( + object_id_one, object_id_two, relation_tag +); + +create index acs_data_links_rel_tag_idx on acs_data_links (relation_tag); \ No newline at end of file Index: openacs-4/packages/acs-kernel/sql/postgresql/acs-relationships-create.sql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-kernel/sql/postgresql/acs-relationships-create.sql,v diff -u -N -r1.27 -r1.28 --- openacs-4/packages/acs-kernel/sql/postgresql/acs-relationships-create.sql 7 Jun 2008 20:28:52 -0000 1.27 +++ openacs-4/packages/acs-kernel/sql/postgresql/acs-relationships-create.sql 4 Jan 2010 19:54:37 -0000 1.28 @@ -378,14 +378,15 @@ constraint acs_data_links_obj_two_fk references acs_objects (object_id) on delete cascade, + relation_tag varchar(100), constraint acs_data_links_un unique - (object_id_one, object_id_two) + (object_id_one, object_id_two, relation_tag) ); create index acs_data_links_id_one_idx on acs_data_links (object_id_one); create index acs_data_links_id_two_idx on acs_data_links (object_id_two); +create index acs_data_links_rel_tag_idx on acs_data_links (relation_tag); - -------------- -- TRIGGERS -- -------------- Index: openacs-4/packages/acs-kernel/sql/postgresql/upgrade/upgrade-5.6.0d3-5.6.0d4.sql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-kernel/sql/postgresql/upgrade/upgrade-5.6.0d3-5.6.0d4.sql,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-kernel/sql/postgresql/upgrade/upgrade-5.6.0d3-5.6.0d4.sql 4 Jan 2010 19:54:37 -0000 1.1 @@ -0,0 +1,9 @@ +alter table acs_data_links add column relation_tag varchar(100); + +drop index acs_data_links_un; + +create unique index acs_data_links_un on acs_data_links ( + object_id_one, object_id_two, relation_tag +); + +create index acs_data_links_rel_tag_idx on acs_data_links (relation_tag); \ No newline at end of file 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 -N -r1.9 -r1.10 --- openacs-4/packages/acs-tcl/tcl/application-data-link-procs.tcl 14 May 2007 20:30:26 -0000 1.9 +++ openacs-4/packages/acs-tcl/tcl/application-data-link-procs.tcl 4 Jan 2010 19:54:37 -0000 1.10 @@ -13,25 +13,29 @@ ad_proc -public application_data_link::new { -this_object_id:required -target_object_id:required + {-relation_tag ""} } { Create a new data link between this_object_id and target_object_id. @param this_object_id ID of the object that you want linked to the target object. @param target_object_id The ID of the target object. + @param relation_tag Relationship identifier } { if { [catch { application_data_link::new_from \ -object_id $this_object_id \ - -to_object_id $target_object_id + -to_object_id $target_object_id \ + -relation_tag $relation_tag application_data_link::new_to \ -object_id $this_object_id \ - -from_object_id $target_object_id + -from_object_id $target_object_id \ + -relation_tag $relation_tag }]} { # check if error occured because of existing link - if { [application_data_link::exist_link -object_id $this_object_id -target_object_id $target_object_id] eq "1" } { + if { [application_data_link::exist_link -object_id $this_object_id -target_object_id $target_object_id -relation_tag $relation_tag] eq "1" } { ns_log Debug "application_data_link::new: link already exists" } else { ns_log Error "application_data_link::new: link creation failure" @@ -42,18 +46,20 @@ ad_proc -public application_data_link::new_from { -object_id:required -to_object_id:required + {-relation_tag ""} } { 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 to_object_id The ID of the target object. + @param relation_tag Relationship identifier } { set forward_rel_id [db_nextval acs_data_links_seq] # Flush the cache for both items - util_memoize_flush_regexp "application_data_link::get_linked_not_cached -from_object_id $object_id .*" - util_memoize_flush_regexp "application_data_link::get_linked_not_cached -from_object_id $to_object_id .*" + util_memoize_flush_regexp "application_data_link::get_linked_not_cached -from_object_id $object_id -relation_tag $relation_tag .*" + util_memoize_flush_regexp "application_data_link::get_linked_not_cached -from_object_id $to_object_id -relation_tag $relation_tag .*" util_memoize_flush_regexp "application_data_link::get_linked_content_not_cached -from_object_id $object_id .*" util_memoize_flush_regexp "application_data_link::get_linked_content_not_cached -from_object_id $to_object_id .*" @@ -63,18 +69,20 @@ ad_proc -public application_data_link::new_to { -object_id:required -from_object_id:required + {-relation_tag ""} } { 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 from_object_id The ID of the target object. + @param relation_tag Relationship identifier } { set backward_rel_id [db_nextval acs_data_links_seq] # Flush the cache for both items - util_memoize_flush_regexp "application_data_link::get_linked_not_cached -from_object_id $object_id .*" - util_memoize_flush_regexp "application_data_link::get_linked_not_cached -from_object_id $from_object_id .*" + util_memoize_flush_regexp "application_data_link::get_linked_not_cached -from_object_id $object_id -relation_tag $relation_tag .*" + util_memoize_flush_regexp "application_data_link::get_linked_not_cached -from_object_id $from_object_id -relation_tag $relation_tag .*" util_memoize_flush_regexp "application_data_link::get_linked_content_not_cached -from_object_id $object_id .*" util_memoize_flush_regexp "application_data_link::get_linked_content_not_cached -from_object_id $from_object_id .*" @@ -84,14 +92,17 @@ # created 2006/07/25 nfl exist a link, returns 0 or 1 ad_proc -public application_data_link::exist_link { -object_id:required - -target_object_id:required + -target_object_id:required + {-relation_tag ""} } { - Check for the existence of a link from an object_id to a target_object_id + Check for the existence of a link from an object_id to a target_object_id, + with optional relation_tag. @param object_id The object we're looking for a link from - @param target_object_id THe object we're looking for a link to + @param target_object_id The object we're looking for a link to + @param relation_tag Relationship identifier } { - set linked_objects [ application_data_link::get -object_id $object_id ] + set linked_objects [ application_data_link::get -object_id $object_id -relation_tag $relation_tag] if { [lsearch -exact $linked_objects "$target_object_id"] != -1 } { # found link return 1 @@ -102,12 +113,14 @@ ad_proc -public application_data_link::delete_links { -object_id:required + {-relation_tag ""} } { Delete application data links for all objects linking to the given - object_id. + object_id. Optionally delete by object_id and relation_tag. @param object_id Object ID that you want application data links removed from. + @param relation_tag Relationship identifier. } { set rel_ids [db_list linked_objects {}] @@ -118,12 +131,14 @@ ad_proc -public application_data_link::delete_from_list { -object_id - -link_object_id_list + -link_object_id_list + {-relation_tag ""} } { Delete references @param object_id Object to delete links from - @link_object_id_list List of linked object_ids to delete + @param link_object_id_list List of linked object_ids to delete + @param relation_tag Relationship identifier @author Dave Bauer (dave@solutiongrove.com) @creation-date 2006-08-31 @@ -135,10 +150,13 @@ ad_proc -public application_data_link::get { -object_id:required + {-relation_tag ""} } { Retrieves a list of object_ids for all objects linked to the - given object_id. + given object_id, tagged with the optional relation_tag. + @param object_id Retrieve objects linked to this object_id + @param relation_tag Relationship identifier. @return List of linked object ids. } { return [db_list linked_objects {}] @@ -147,27 +165,31 @@ ad_proc -public application_data_link::get_linked { -from_object_id:required -to_object_type:required + {-relation_tag ""} } { Gets the ID for the object linked to from_object_id and matches the - to_object_type. + to_object_type. Optionally, pass a relationship tag. @param from_object_id Object ID of linked-from object. @param to_object_type Object type of linked-to object. + @param relation_tag Relationship identifier @return object_id of linked object. } { - return [util_memoize [list application_data_link::get_linked_not_cached -from_object_id $from_object_id -to_object_type $to_object_type]] + return [util_memoize [list application_data_link::get_linked_not_cached -from_object_id $from_object_id -to_object_type $to_object_type -relation_tag $relation_tag]] } ad_proc -public application_data_link::get_linked_not_cached { -from_object_id:required -to_object_type:required + {-relation_tag ""} } { Gets the ID for the object linked to from_object_id and matches the - to_object_type. + to_object_type. Optionally, pass a relationship tag. @param from_object_id Object ID of linked-from object. @param to_object_type Object type of linked-to object. + @param relation_tag Relationship identifier @return object_id of linked object. } { @@ -177,25 +199,29 @@ ad_proc -public application_data_link::get_linked_content { -from_object_id:required -to_content_type:required + {-relation_tag ""} } { Gets the content of the linked object. @param from_object_id Object ID of linked-from object. @param to_content_type Content type of linked-to object. + @param relation_tag @return item_id for the content item. } { - return [util_memoize [list application_data_link::get_linked_content_not_cached -from_object_id $from_object_id -to_content_type $to_content_type]] + return [util_memoize [list application_data_link::get_linked_content_not_cached -from_object_id $from_object_id -to_content_type $to_content_type -relation_tag $relation_tag]] } ad_proc -public application_data_link::get_linked_content_not_cached { -from_object_id:required -to_content_type:required + {-relation_tag ""} } { Gets the content of the linked object. @param from_object_id Object ID of linked-from object. @param to_content_type Content type of linked-to object. + @param relation_tag @return item_id for the content item. } { @@ -205,8 +231,10 @@ ad_proc -public application_data_link::get_links_from { -object_id:required {-to_type} + {-relation_tag ""} } { - Get a list of objects that are linked from an object + Get a list of objects that are linked from an object, + possible using the relation_tag. If to_type is a subtype of content_revision, we lookup content_items that have that content_type @@ -258,19 +286,22 @@ -object_id {-text {}} {-link_object_ids {}} + {-relation_tag ""} } { - Update the references to this object in the database + Update the references to this object in the database, + optionally update links using the given relation_tag. @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. + @param relation_tag Relationship identifier @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] + set old_links [application_data_link::get_links_from -object_id $object_id -relation_tag $relation_tag] if {![llength $link_object_ids]} { set link_object_ids [application_data_link::scan_for_links -text $text] } @@ -280,29 +311,48 @@ lappend delete_ids $old_link } } - application_data_link::delete_from_list -object_id $object_id -link_object_id_list $delete_ids + application_data_link::delete_from_list -object_id $object_id -link_object_id_list $delete_ids -relation_tag $relation_tag 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 + -to_object_id $new_link \ + -relation_tag $relation_tag]} { + application_data_link::new_from -object_id $object_id -to_object_id $new_link -relation_tag $relation_tag } } } ad_proc -public application_data_link::link_exists { -from_object_id -to_object_id + {-relation_tag ""} } { Check if a link exists, only checks in the directon requested. + Optionally check if the link has the given tag. @param from_object_id @param to_object_id - + @param relation_tag + @return 0 or 1 @author Dave Bauer (dave@solutiongrove.com) @creation-date 2006-08-31 } { return [db_0or1row link_exists ""] } + +ad_proc -public application_data_link::relation_tag_where_clause { + {-relation_tag ""} +} { + Utility proc to return relation tag where clause fragment. + We show all object links regardless of tag if relation_tag is empty string. + + @param relation_tag Relationship identifier +} { + if {$relation_tag eq ""} { + return "" + } else { + return [db_map where_clause] + } +} \ No newline at end of file Index: openacs-4/packages/acs-tcl/tcl/application-data-link-procs.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/application-data-link-procs.xql,v diff -u -N -r1.5 -r1.6 --- openacs-4/packages/acs-tcl/tcl/application-data-link-procs.xql 14 May 2007 20:30:26 -0000 1.5 +++ openacs-4/packages/acs-tcl/tcl/application-data-link-procs.xql 4 Jan 2010 19:54:37 -0000 1.6 @@ -3,15 +3,15 @@ - insert into acs_data_links (rel_id, object_id_one, object_id_two) - values (:forward_rel_id, :object_id, :to_object_id) + insert into acs_data_links (rel_id, object_id_one, object_id_two, relation_tag) + values (:forward_rel_id, :object_id, :to_object_id, :relation_tag) - insert into acs_data_links (rel_id, object_id_one, object_id_two) - values (:backward_rel_id, :from_object_id, :object_id) + insert into acs_data_links (rel_id, object_id_one, object_id_two, relation_tag) + values (:backward_rel_id, :from_object_id, :object_id, :relation_tag) @@ -21,6 +21,7 @@ from acs_data_links where (object_id_one = :object_id or object_id_two = :object_id) + [application_data_link::relation_tag_where_clause -relation_tag $relation_tag] @@ -36,6 +37,7 @@ select object_id_two from acs_data_links where object_id_one = :object_id + [application_data_link::relation_tag_where_clause -relation_tag $relation_tag] order by object_id_two @@ -45,7 +47,10 @@ select o.object_id from acs_objects o where o.object_type = :to_object_type - and o.object_id in (select object_id_two from acs_data_links where object_id_one = :from_object_id) + and o.object_id in (select object_id_two + from acs_data_links + where object_id_one = :from_object_id + [application_data_link::relation_tag_where_clause -relation_tag $relation_tag]) order by o.object_id @@ -55,7 +60,10 @@ select i.item_id from cr_items i where i.content_type = :to_content_type - and i.item_id in (select object_id_two from acs_data_links where object_id_one = :from_object_id) + and i.item_id in (select object_id_two + from acs_data_links + where object_id_one = :from_object_id + [application_data_link::relation_tag_where_clause -relation_tag $relation_tag]) order by i.item_id @@ -68,6 +76,7 @@ $content_type_from_clause where object_id_one = :object_id and object_id = object_id_two + [application_data_link::relation_tag_where_clause -relation_tag $relation_tag] $to_type_where_clause @@ -95,6 +104,7 @@ delete from acs_data_links where object_id_one=:object_id and object_id_two in ([template::util::tcl_to_sql_list $link_object_id_list]) + [application_data_link::relation_tag_where_clause -relation_tag $relation_tag] @@ -103,6 +113,7 @@ select 1 from acs_data_links where object_id_one = :from_object_id and object_id_two = :to_object_id + [application_data_link::relation_tag_where_clause -relation_tag $relation_tag] @@ -111,4 +122,10 @@ select object_id from acs_objects where object_id in ([template::util::tcl_to_sql_list $refs]) + + + + and relation_tag = :relation_tag + + 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 -N -r1.3 -r1.4 --- openacs-4/packages/acs-tcl/tcl/test/application-data-link-procs.tcl 14 May 2009 13:39:15 -0000 1.3 +++ openacs-4/packages/acs-tcl/tcl/test/application-data-link-procs.tcl 4 Jan 2010 19:54:37 -0000 1.4 @@ -85,4 +85,153 @@ [expr {$new_correct_links eq $links}] } } +} + +aa_register_case -cats api data_links_scan_links_with_tag { + Test scanning content for object URLs with relation tag +} { + # get a new object_id from the sequence, this object will not exist + set nonexistant_object_id [db_nextval "acs_object_id_seq"] + set text {Some random text + Some More Random Text /o/10 /file/11 /image/12 + /o/[junk] /file/[junk] /image/[junk] + /o/" /file/" /image/" + /o/[ /file/[ /image/[ + + } + append text " " + aa_log "ad_url = '[ad_url]'" + set links [application_data_link::scan_for_links -text $text] + set correct_links [list 0] + 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_with_tag { + Test updating references, + tests scan_for_links + and delete_links in the process. + Uses relation tags +} { + 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) Link \n" + } + # update the links + foreach n [array names o] { + application_data_link::update_links_from \ + -object_id $o($n) \ + -text $text \ + -relation_tag tag + } + # 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) -relation_tag tag]] + 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 \ + -relation_tag tag + } + 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) \ + -relation_tag tag]] + aa_true "Object \#${i} updated references correct" \ + [expr {$new_correct_links eq $links}] + } + } +} + + +aa_register_case -cats api data_links_with_tag { + Test creating new link, exists test, get, get_linked and delete. Uses relation tags. +} { + aa_run_with_teardown \ + -rollback \ + -test_code \ + { + # create some test objects + set name [ns_mktemp "cr_item__XXXXXX"] + + for {set i 0} {$i<6} {incr i} { + set o($i) [content::item::new \ + -name ${name}_$i \ + -title ${name}_$i] + } + + aa_log "Creating link between objects" + application_data_link::new -this_object_id $o(0) -target_object_id $o(1) -relation_tag tag + + aa_true "Verify objects are linked" \ + [application_data_link::link_exists \ + -from_object_id $o(0) \ + -to_object_id $o(1) \ + -relation_tag tag] + + aa_log "Deleting links attached to first object" + application_data_link::delete_links -object_id $o(0) + + aa_false "Verify objects are deleted" \ + [application_data_link::link_exists \ + -from_object_id $o(0) \ + -to_object_id $o(1) \ + -relation_tag tag] + + aa_log "Creating many links between objects" + application_data_link::new -this_object_id $o(0) -target_object_id $o(1) -relation_tag tag1 + application_data_link::new -this_object_id $o(0) -target_object_id $o(2) -relation_tag tag1 + application_data_link::new -this_object_id $o(0) -target_object_id $o(3) -relation_tag tag2 + application_data_link::new -this_object_id $o(3) -target_object_id $o(4) -relation_tag tag2 + application_data_link::new -this_object_id $o(3) -target_object_id $o(5) -relation_tag tag2 + + aa_true "Verify link for tag1" [expr [llength [application_data_link::get_linked -from_object_id $o(0) \ + -to_object_type [acs_object_type $o(0)] -relation_tag tag1]] == 2] + + aa_true "Verify link for tag2" [expr [llength [application_data_link::get_linked -from_object_id $o(3) \ + -to_object_type [acs_object_type $o(3)] -relation_tag tag2]] == 3] + + aa_true "Verify content link" [expr [llength [application_data_link::get_linked_content -from_object_id $o(0) \ + -to_content_type content_revision -relation_tag tag1]] == 2] + + aa_true "Verify links to one object with multiple link tags" \ + [expr [llength [application_data_link::get -object_id $o(0) -relation_tag tag1]] == 2] + + aa_true "Verify links to one object with multiple link tags" \ + [expr [llength [application_data_link::get -object_id $o(0) -relation_tag tag2]] == 1] + + } } \ No newline at end of file