Index: openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl,v diff -u -r1.19.2.2 -r1.19.2.3 --- openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl 8 Dec 2002 15:50:04 -0000 1.19.2.2 +++ openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl 9 Dec 2002 17:42:19 -0000 1.19.2.3 @@ -2736,7 +2736,81 @@ return $out } +ad_proc -public util_text_to_url { + {-existing_urls {}} + {-resolve_conflicts_p:boolean 1} + {-replacement "-"} + text +} { + Modify a string so that it is suited as a well formatted URL path element. + for example given "Foo Bar" and it will return "foo-bar". Also, + if given a list of existing urls it can catch duplicate or optionally + create an unambiguous url by appending -N. + @param text the text to modify, e.g. "Foo Bar" + + @param existing_urls a list of URLs that already exist on the same level and would cause a conflict + + @param resolve_conflicts_p automatically generate "foo-bar-2" if "foo-bar" is already in existing_urls. If set to false it throws an error in case of a conflict. + + @param replacement the character that is used to replace illegal characters + + @author Tillman Singer +} { + set original_text $text + set text [string trim [string tolower $original_text]] + + # Save some german and french characters from removal by replacing + # them with their ascii counterparts. + set text [string map { \x00e4 ae \x00f6 oe \x00fc ue \x00df ss \x00f8 o \x00e0 a \x00e1 a \x00e8 e \x00e9 e } $text] + + # substitute all non-word characters + regsub -all {([^a-z0-9])+} $text $replacement text + + set text [string trim $text $replacement] + + # throw an error when the resulting string is empty + if { [empty_string_p $text] } { + error "Cannot compute a URL of this string: \"$original_text\" because after removing all illegal characters it's an empty string." + } + + # check if the resulting url is already present + if { [lsearch -exact $existing_urls $text] > -1 } { + + if { !$resolve_conflicts_p } { + # URL is already present in the existing_urls list and we + # are asked to not automatically resolve the collision + error "The url $text is already present" + } else { + # URL is already present in the existing_urls list - + # compute an unoccupied replacement using a pattern like + # this: if foo is taken, try foo-2, then foo-3 etc. + + # Holes will not be re-occupied. E.g. if there's foo-2 and + # foo-4, a foo-5 will be created instead of foo-3. This + # way confusion through replacement of deleted content + # with new stuff is avoided. + + set number 2 + + foreach url $existing_urls { + + if { [regexp "${text}${replacement}(\\d+)\$" $url match n] } { + # matches the foo-123 pattern + if { $n >= $number } { set number [expr $n + 1] } + } + } + + set text "$text$replacement$number" + } + } + + return $text + +} + + + ad_proc util_unlist { list args } { Places the nth element of list into the variable named by