The idea behind this module is to parallelize several file copies to possibly save time. Instead of this: ====== file copy sourcefile1 destfile1 file copy sourcefile2 destfile2 file copy sourcefile3 destfile3 ====== one can use something like this: ====== bgCopy::bgCopySchedule sourcefile1 destfile1 bgCopy::bgCopySchedule sourcefile2 destfile2 bgCopy::bgCopySchedule sourcefile3 destfile3 bgCopy::bgCopyWaitAll; # <---- eventloop is needed ====== ====== ######################################################################################################################## # Module: bgCopy.tcl # Stand : 11.10.2018 # Autor : Matthias Hoffmann # Zweck : Ein Wrapper für fcopy # namespace eval bgCopy { package require Tcl 8.6; # try variable activeCopies 0 variable allCopies 0 ##### # Initiiert einen Kopiervorgang # Argumente: Eingabedatei Ausgabedatei ?-mkdir 1? ?-force 1? ?-exitcmd ? ?-limit ? ?-idlecmd ? # Was passiert bei Dingen wie 'Diskfull', 'I/O-Error'? -> bgerror! # proc bgCopySchedule {src dst args} { variable activeCopies variable allCopies variable options [dict create -mkdir 0 -force 0 -exitcmd {} -limit 0 -idlecmd {}] set keys [dict keys $options] # später in Library auslagern foreach {arg val} $args { set key [lsearch -glob -nocase -inline $keys $arg*] if {$key ne ""} { dict set options $key $val } else { return -code error "invalid option $arg. Allowed are: $keys" } } if {[dict get $options -force] == 0 && [file exists $dst]} { return -code error "destination exists: $dst" } set dstDir [file dirname $dst] if {![file isdirectory $dstDir] && [dict get $options -mkdir]} { # Directory nicht vorhanden, oder ist eine Datei -> versuchen, anzulegen, # wenn dies eingestellt ist file mkdir $dstDir; # nicht anlegbar, als Datei vorhanden -> propagieren } set out [open $dst wb]; # brummt auf, wenn z.B. dir nicht da, keine Rechte etc. try { set in [open $src rb] } on error {result options} { close $out; # war schon geöffnet -> schliessen return -options $options $result; # repropagate error } # Resource-Bremse; ACHTUNG: Files sind schon geöffnet! while {[dict get $options -limit] > 0 && $activeCopies >= [dict get $options -limit]} { bgCopyWaitOne } fcopy $in $out -command [namespace code [list bgCopyClose $src $dst $in $out [dict get $options -exitcmd]]] incr activeCopies incr allCopies; # := handle return [list $activeCopies $allCopies $src $in $dst $out] } ##### # Generischer Callback; Wird aufgerufen mit Abschluss des Hintergrund-Kopierens. # Ruft, wenn definiert, den benutzerdefinierten Handler -exitcmd. # schlecht: # "If either inchan or outchan get closed while the copy is in progress, the current # copy is stopped and the command callback is NOT made." # proc bgCopyClose {src dst in out exitcmd args} { variable activeCopies catch { close $in close $out } incr activeCopies -1 if {[llength $exitcmd]} { catch {uplevel 1 [list {*}$exitcmd $src $dst {*}$args]}; # Fehler hier ignorieren! } } ##### # Wartet, bis EIN Kopiervorgang abgeschlossen ist # Optional für den Aufrufer, fall dieser eigene while{}-Schleife aufbaut. # Ein mit -idlecmd definierter Handler wird zuvor aufgerufen. # proc bgCopyWaitOne {} { variable options if {[llength [dict get $options -idlecmd]]} { catch {uplevel 1 [list {*}[dict get $options -idlecmd]]}; # Fehler hier ignorieren! } vwait bgCopy::activeCopies } ##### # Wartet, bis ALLE Kopiervorgäge abgeschlossen sind # Ein mit -idlecmd definierter Handler wird vor jedem Kopierabschluss aufgerufen. # proc bgCopyWaitAll {} { variable activeCopies while {$activeCopies > 0} { bgCopyWaitOne } } ##### # Liefert für den Aufrufer die Anzahl aktiver Kopiervorgänge # (erspart direkten Zugriff auf die Variable) # proc bgCopyActiveCopies {} { variable activeCopies return $activeCopies } package provide bgCopy 0.1 } # # Tests # if {[info exists argv0] && [file tail [info script]] eq [file tail $argv0]} { proc reportResult {args} { puts "reportResult-Callback: $args (aktiv: [bgCopy::bgCopyActiveCopies])" } proc step {args} { puts "step-Callback: $args (aktiv: [bgCopy::bgCopyActiveCopies])" } foreach {src dst} $argv { catch {bgCopy::bgCopySchedule $src $dst -mkdir 0 -exitcmd reportResult -force 1 -limit 3 -idlecmd {step hugo}} reslt puts $reslt } bgCopy::bgCopyWaitAll puts "fertig!" } ====== <>