Thread stündliches Wegschreiben von Dateien auf andere Platte (6 answers)
Opened by JoeMiller at 2011-04-20 10:13

topeg
 2011-04-20 11:46
#147886 #147886
User since
2006-07-10
2611 Artikel
BenutzerIn

user image
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)

View full thread stündliches Wegschreiben von Dateien auf andere Platte