| View previous topic :: View next topic |
| Author |
Message |
leprechau Voice
Joined: 03 Oct 2008 Posts: 2
|
Posted: Sat Oct 04, 2008 12:11 am Post subject: Replace random words in a string of text with asterisks |
|
|
I'm not sure exactly who it was, and I can't find the exact post now, but hopefully whoever needed it will find it here. This was a topic I read awhile ago and just thought I would post something I threw together in TCLSH this evening. Hope it helps someone.
| Code: | proc wordMask {text {num {1}}} {
set txtl [expr {[llength $text] -1}]; set rlist [list]
if {$num > [llength $text]} {set num [llength $text]}
while {[llength $rlist] < $num} {
set x [expr {round(rand()*$txtl)}]
lappend rlist $x; set rlist [lsort -unique $rlist]
}
set outs [split $text]; foreach idx $rlist {
set outs [lreplace $outs $idx $idx [regsub -all -- {[[:alnum:]]} [set rep [lindex $outs $idx]] {*}]]
lappend reps [regsub -all -- {[\!\.\?\;\:\"]} $rep {}]
}; return [list [join $outs] [join $reps]]
} |
Usage example:
| Code: | | foreach {mask reps} [wordMask $text 5] {} |
This gives you two variables you can use later on as follows....
| Code: | | puts "Masked Text -> $mask" |
Will give you: Masked Text -> Hello **** *'** ** **** ****!
| Code: | | puts "Replaced Words -> $reps" |
Will give you: Replaced Words -> dear I'll be home soon
That's it...pretty simple and if you read the code in the proc declaration you can see the script will default to replacing 1 word in the passed text, but any other number can be specified if desired. _________________ leprechau@EFnet |
|
| Back to top |
|
 |
TCL_no_TK Owner

Joined: 25 Aug 2006 Posts: 509 Location: England, Yorkshire
|
|
| Back to top |
|
 |
|