Die folgenden beiden Prozeduren, copySubtree
und copySubtreeAndLinks
, kopieren eine Ordnerhierarchie an eine andere Stelle. Im Unterschied zu copySubtree
, passt copySubtreeAndLinks
nach dem Kopiervorgang die Links, die auf Dateien in der ursprünglichen Hierarchie zeigen, so an, dass sie auf die neuen, kopierten Dateien zeigen.
# $Id: copySubtree.tcl,v 1.2 2002/03/27 15:51:06 # # Last changed: 2009-09-25 # Purpose: # copySubtreeAndLinks: Copy a file tree and re-generate the links # copySubtree: Simple tree-copying without linkage # Parameters: # File ID or name of the folder to copy, # File ID or name of the destination folder # [keepStatus] # keepStatus (optional) tries to assign the same status to the copied files # as they had before and prints a warning if a file has a released and a # draft/committed version. In this case only the released version will be copied. proc copySubtreeAndLinks {{objId ""} {destination ""} {option ""} } { if {$destination==""} { global copySubtree_usage puts $copySubtree_usage return } if {($option!="") && ($option!="keepStatus")} { puts "$option is a not allowed option!" return } set to_release 0 set objId [findObjectId $objId] set destination [findObjectId $destination] set oldPath [obj withId $objId get path] set newPath [obj withId $destination get path] set newPath $newPath/[obj withId $objId get name] if {[catch {findObjectId $newPath}] == 0} { set newPath [obj withId [obj withId $destination create objClass \ [obj withId $objId get objClass] name [obj withId $objId get name]] get path] obj withPath $newPath delete } puts "Copying files ..." copySubtree $objId $destination $option puts "\nSubtree successfully copied, now links will be adapted ..." set newId [obj withPath $newPath get id] foreach i [listSubtree $newId] { if !{[obj withId $i get isMirror]} { if {[obj withId $i get isReleased] == 1} { obj withId $i unrelease set to_release 1 } foreach j [obj withId $i get subLinks] { set dest [link withId $j get destinationUrl] if {[regexp "^$oldPath" $dest]} { regsub $oldPath $dest $newPath dest link withId $j set destinationUrl $dest } } if {$to_release == 1} { obj withId $i release set to_release 0 } } } puts "done" } proc copySubtree {{objId ""} {destination ""} {option ""} } { if {$destination==""} { global copySubtree_usage puts $copySubtree_usage return } set objId [findObjectId $objId] set destination [findObjectId $destination] if {$objId == $destination} { puts "You can't copy a file to itself" return } set newId [obj withId $objId copy parent $destination] puts -nonewline "\r$objId" flush stdout if {$option=="keepStatus"} { if {[obj withId $objId get isCommitted]=="1"} { obj withId $newId commit } if {[obj withId $objId get isReleased]=="1"} { obj withId $newId release if {([obj withId $objId get isCommitted]=="1") || ([obj withId $objId get isEdited]=="1")} { puts "\nFile $objId has a released and a draft version.\ Only the released version was copied" } } } if {[obj withId $objId get objType] == "publication" && ![obj withId $objId get isMirror]} { foreach i [obj withId $objId get children] { copySubtree $i $newId $option } } }
Speichern Sie bitte beide Skripte in einer einzigen Tcl-Datei ab. Öffnen Sie eine Tcl-Shell, stellen Sie eine Verbindung zum Content Manager her und lesen Sie die Tcl-Datei mit dem Befehl source
ein. Nun können Sie die beiden Prozeduren verwenden. Das folgende Beispiel kopiert den Ordner /de/news
komplett nach /internet/de/news
:
copySubtreeAndLinks /de/news /internet/de