Thread stündliches Wegschreiben von Dateien auf andere Platte
(6 answers)
Opened by JoeMiller at 2011-04-20 10:13
Lange nichts mehr für perl4 geschrieben. Aber ich meine das sollte funktionieren:
Code (perl): (dl
)
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 #!/usr/bin/perl -w $source='/test/in'; $destin='/web/out'; $copy_count=60; $disk_full=90; @files=(); # read files if disk full if(disk_full($source) > $disk_full) { unless(opendir(DIR,$source)) { die("ERROR open $source ($!)"); } local $file; while($file=readdir(DIR)) { # hier nicht nötig # ignore '.' and '..' #if($file=~/^\.\.?$/) { next; } # ignore dir etc. unless(-f "$source/$file") { next; } push(@files,$file); } close(DIR); } if(@files) { # sort by age @files=sort{-M "$source/$a" <=> -M "$source/$b"}@files; # only $copy_count files while(@files > $copy_count) { shift(@files); } } # move file foreach(@files) { move("$source/$_","$destin/$_"); } ######################################################################## ######################################################################## sub disk_full { local $file=$_[0]; local $ret=0; local $line=''; unless(open(DF, 'df $file |')) { die("ERROR run df $file\n"); } # ignore first line <DF>; # next line is the disk $line=<DF>; if($line=~/(\d+)%/) { $ret=$1; } close(DF); return $ret; } sub move { local ($s,$d)=@_; if( system("move '$s' '$d' > /dev/null 2>&1") ) { die("error move $s $d"); } } Edit: Code auf perl4 getrimmt, danke für die Hinweise. Last edited: 2011-04-21 03:47:39 +0200 (CEST) |