source: branches/profile/SOURCE_TOOLS/arb_cleanup_patches.pl

Last change on this file was 8607, checked in by westram, 12 years ago

merge from e4fix [8135] [8136] [8137] [8138] [8139] [8140] [8141] [8142] [8143] [8144] [8222]
(this revives the reverted patches [8129] [8130] [8131] [8132]; see [8133])

  • fixes
    • some free/delete mismatches
    • wrong definition of ORF objects (Level was no bit value)
    • amino consensus (failed for columns only containing 'C')
  • rename
    • AA_sequence_term → orf_term
    • ED4_sequence_terminal_basic → ED4_abstract_sequence_terminal
  • cleaned up hierarchy dumps
  • tweaked is_terminal()/to_terminal()
  • Property svn:executable set to *
File size: 4.4 KB
Line 
1#!/usr/bin/perl
2
3use strict;
4
5# --------------------------------------------------------------------------------
6
7sub getModtimeAndSize($) {
8  my ($file_or_dir) = @_;
9  if (-f $file_or_dir or -d $file_or_dir) {
10    my @st = stat($file_or_dir);
11    if (not @st) { die "can't stat '$file_or_dir' ($!)"; }
12    return ($st[9],$st[7]); # (stamp,size)
13  }
14  return (0,0); # does not exist -> use (epoch,zerosize)
15}
16
17sub getAgeAndSize($) {
18  my ($file_or_dir) = @_;
19  my ($mod,$size) = getModtimeAndSize($file_or_dir);
20  return (time-$mod,$size);
21}
22
23# --------------------------------------------------------------------------------
24
25sub scanPatches($$\@) {
26  my ($patchDir,$mask,$patch_r) = @_;
27  my $reg = qr/$mask/;
28  opendir(DIR,$patchDir) || die "can't read directory '$patchDir' (Reason: $!)";
29  foreach (readdir(DIR)) { if ($_ =~ $reg) { push @$patch_r, $_; } }
30  closedir(DIR);
31}
32
33sub patchesDiffer($$$) {
34  my ($patchDir,$patch,$otherpatch) = @_;
35  my $diff = `diff $patchDir/$patch $patchDir/$otherpatch | wc -l`;
36  return ($diff>0);
37}
38
39sub getOldDuplicates($\@\%\%) {
40  my ($patchDir,$patch_r,$age_r,$size_r) = @_;
41  my @oldDups = ();
42
43  my %size2patch = ();
44  foreach my $patch (@$patch_r) {
45    my $size = $$size_r{$patch};
46    my $otherpatch = $size2patch{$size};
47    if (defined $otherpatch) { # got another patch with same size
48      my $diff = patchesDiffer($patchDir,$patch,$otherpatch);
49
50      if ($diff) {
51      }
52      else { # no diff -> removed older
53        if ($$age_r{$otherpatch} > $$age_r{$patch}) {
54          push @oldDups, $otherpatch;
55          $size2patch{$size} = $patch;
56        }
57        else {
58          push @oldDups, $patch;
59        }
60      }
61    }
62    else {
63      $size2patch{$size} = $patch;
64    }
65  }
66  return @oldDups;
67}
68
69sub readableSize($) {
70  my ($size) = @_;
71  if ($size<1024) { $size.'b'; }
72  else {
73    $size = int($size/1024);
74    if ($size<1024) { $size.'k'; }
75    else {
76      $size = int($size/1024);
77      if ($size<1024) { $size.'M'; }
78      else {
79        $size = int($size/1024);
80        $size.'G';
81      }
82    }
83  }
84}
85
86sub countAndSize($$$) {
87  my ($name,$count,$size) = @_;
88  return $count.' '.$name.' patches ('.readableSize($size).')  ';
89}
90
91sub main() {
92  my $args = scalar(@ARGV);
93  if ($args!=3) {
94    print "Usage: arb_cleanup_patches.sh name hours minkeep\n";
95    print "       deletes all patches matching 'name_*.patch' if\n";
96    print "       - they are older than 'hours' and\n";
97    print "       - at least 'minkeep' patches remain present.\n";
98    die "missing arguments";
99  }
100
101  my $mask           = $ARGV[0].'.*\.patch';
102  my $olderThanHours = $ARGV[1];
103  my $minKeep        = $ARGV[2];
104
105  my $ARBHOME = $ENV{ARBHOME};
106  if (not defined $ARBHOME) { die "environment variable 'ARBHOME' is not defined"; }
107
108  my $patchDir = $ARBHOME.'/patches.arb';
109  if (not -d $patchDir) { die "directory '$patchDir' does not exist"; }
110
111
112  my @patch = ();
113  scanPatches($patchDir,$mask,@patch);
114
115  my %age = ();
116  my %size = ();
117  foreach (@patch) { ($age{$_},$size{$_}) = getAgeAndSize($patchDir.'/'.$_); }
118
119  my %unlink_patch = (); # key=patchname, value=why unlink
120  {
121    my @oldDups = getOldDuplicates($patchDir,@patch,%age,%size);
122    foreach (@oldDups) { $unlink_patch{$_} = 'duplicate'; }
123  }
124
125  @patch = sort { $age{$a} <=> $age{$b}; } @patch;
126
127  my $olderThanSeconds = $olderThanHours*60*60;
128  my $patchCount = scalar(@patch);
129
130  for (my $i=$minKeep; $i<$patchCount; $i++) {
131    my $patch = $patch[$i];
132    if ($age{$patch}>$olderThanSeconds) { $unlink_patch{$patch} = 'old'; }
133  }
134
135  my $all_size      = 0;
136  my $unlinked_size = 0;
137
138  foreach (@patch) { $all_size += $size{$_}; }
139
140  foreach (sort keys %unlink_patch) {
141    my $fullPatch = $patchDir.'/'.$_;
142    unlink($fullPatch) || die "Failed to unlink '$fullPatch' (Reason: $!)";
143    print "- unlinked ".$unlink_patch{$_}." '$_'\n";
144    $unlinked_size += $size{$_};
145  }
146
147  my $summary = '';
148  {
149    my $unlinked_patches = scalar(keys %unlink_patch);
150    my $all_patches      = scalar(@patch);
151
152    if ($unlinked_patches>0) {
153      my $left_patches = $all_patches - $unlinked_patches;
154      my $left_size    = $all_size - $unlinked_size;
155
156      $summary .= countAndSize('removed',$unlinked_patches,$unlinked_size);
157      $summary .= countAndSize('kept',$left_patches,$left_size);
158    }
159    else {
160      $summary .= countAndSize('existing',$all_patches,$all_size);
161    }
162  }
163  print $summary."\n";
164}
165
166eval { main(); };
167if ($@) { die "arb_cleanup_patches.pl: Error: $@\n"; }
Note: See TracBrowser for help on using the repository browser.