Alte Versionen und Protokolleinträge löschen

Alte archivierte Versionen von Dateien verbrauchen oft viel Speicherplatz und können die Performance des CMS verringern. Mit Hilfe des folgenden Skripts können diese Versionen gelöscht werden. Dieses Skript löscht ferner die zu den gelöschten Versionen gehörenden Protokoll-Einträge.

Legen Sie das Skript bitte in einer Datei mit dem Namen cutHistory.tcl ab. Anschließend können Sie sie mit dem Tcl-Client Ihres CMS einlesen und die Prozedur cutHistory ausführen:

CM>source /pfad/zu/cutHistory.tcl
CM>cutHistory Datei_ID Verbleibende_Einträge

Hier nun das Skript:

# Modified: 2010-04-13
# cutHistory.tcl for Fiona 6.x
#
# Purpose:
# Reduce (cut) the number of archived (i.e. previously released) versions 
# to the given number. Furthermore, remove the associated log enries.
#
# Parameters:
# - File ID or path
# - Number of released versions to remain in the system

proc cutHistory {id cutLength} {
    set objectId [findObjectId $id]
    # CMS Fiona 6.5 or later: exclude mirrors
    if {[obj withId $objectId get isMirror] eq "1"} {
        puts "\nMirror files ($objectId) don't have versions..."
    } else {
        set contents [lsort -integer -decreasing \
            [obj withId $objectId get archivedContentIds]]
        set versionLength [llength $contents]
        set logLength [llength [logEntry where logTypes action_release_obj \
            objectId $objectId]]
        puts "Cut by Length:\t$cutLength"
        puts "Log-Size:\t$logLength"
        puts "Versions:\t$versionLength"
        if {[catch {set cutByDate [content withId [lindex $contents $cutLength] \
            get lastChanged]}]} {
            puts "\nFile $objectId has no archived versions..."
        } else {
            foreach i [lrange $contents $cutLength $versionLength] {
                content withId $i delete
                puts "content $i deleted"
            }
            if {[catch {logEntry deleteWhere objectId $objectId \
                    untilDate $cutByDate} msg]} {
                puts "\nCouldn't delete log entries of file $objectId: \n$msg"
            }
        }
    }
}