We are looking for some TCL/TK help.
We need a small app that will look through a folder of files, find every unique file extension, then create a folder for each extension and move the respective files into that folder.
I am trying to learn TCL/TK myself so I am looking to learn from your code so it should be heavily documented.
MHo 2011-04-13: Here's a quick try; not tested yet, not complete, just a first idea quickly hacked in. Sure there are errors in the code - perhaps someone with more time could assist, or show a different approach. And there is a good chance that I completely missinterpreted the task...
set srcFolder [lindex $argv 0]; # Argument Nr. 1 gives the name of the folder to process
# (1)
# Loop over all files in the folder which is given as argument 1
# assumption: no recursive search for now
# Note: hidden files are ignored for now
#
foreach file [glob -dir $srcFolder -types f -tails -- *] {
# filling an array, using file extension as the index. Each element holds the names of all files of that type
# Note: -tails saves a little memory in just giving back the name portion, not the path of the file, as we already know the path
lappend buf([file extension $file]) $file
}
# (2)
# Now looping through all the extensions, and for each extension looping through all the files, doin' a little action
# Note: no catching for errors until then...
#
foreach key [array names buf] {
# assumption: folder should be created in the same folder as the files stay in. In reality this could be given as 2nd arg etc.
set newFolder [file join $srcFolder $key]
file mkdir $newFolder; # create a subfolder which is named after the extension just once below the original source folder
foreach file $buf($key) {
# move all the files belonging to that extension into the new subfolder
file rename [file join $srcFolder $file] $newFolder; # hm... I'm always unsure if one have to give the filename in dest, too.....
}
}RLE (2011-04-14) If you can presume at least Tcl 8.5 being available, and you wanted to use a bit more memory, you could write it this way (comments removed to save space, but same comments as above apply):
set srcFolder [lindex $argv 0]
foreach file [glob -dir $srcFolder -types f -- *] {
lappend buf([file extension $file]) $file
}
foreach key [array names buf] {
set newFolder [file join $srcFolder $key]
file mkdir $newFolder
# move all the files belonging to that extension into the new subfolder
file rename {*}$buf($key) $newfolder
}