← Back to branch summary

~ubuntu-branches/debian/jessie/arb/jessie

« back to all changes in this revision

Viewing changes to SOURCE_TOOLS/arb_cleanup_patches.pl

  • Committer: Package Import Robot
  • Author(s): Elmar Pruesse, Andreas Tille, Elmar Pruesse
  • Date: 2014-09-02 15:15:06 UTC
  • mfrom: (1.1.6)
  • Revision ID: package-import@ubuntu.com-20140902151506-jihq58b3iz342wif
Tags: 6.0.2-1
http://bugs.debian.org/741890
http://bugs.debian.org/757497
[ Andreas Tille ]
* New upstream version
  Closes: #741890
* debian/upstream -> debian/upstream/metadata
* debian/control:
   - Build-Depends: added libglib2.0-dev
   - Depends: added mafft, mrbayes
* debian/rules
   - Add explicite --remove-section=.comment option to manual strip call
* cme fix dpkg-control
* arb-common.dirs: Do not create unneeded lintian dir
* Add turkish debconf translation (thanks for the patch to Mert Dirik
  <mertdirik@gmail.com>)
  Closes: #757497

[ Elmar Pruesse ]
* patches removed:
   - 10_config.makefiles.patch,
     80_no_GL.patch
       removed in favor of creating file from config.makefile.template via 
       sed in debian/control
   - 20_Makefile_main.patch
       merged upstream
   - 21_Makefiles.patch
       no longer needed
   - 30_tmpfile_CVE-2008-5378.patch: 
       merged upstream
   - 50_fix_gcc-4.8.patch:
       merged upstream
   - 40_add_libGLU.patch:
       libGLU not needed for arb_ntree)
   - 60_use_debian_packaged_raxml.patch:
       merged upstream
   - 70_hardening.patch
       merged upstream
   - 72_add_math_lib_to_linker.patch
       does not appear to be needed
* patches added:
   - 10_upstream_r12793__show_db_load_progress:
       backported patch showing progress while ARB is loading a database
       (needed as indicator/splash screen while ARB is launching)
   - 20_upstream_r12794__socket_permissions:
       backported security fix
   - 30_upstream_r12814__desktop_keywords:
       backported add keywords to desktop (fixes lintian warning)
   - 40_upstream_r12815__lintian_spelling:
       backported fix for lintian reported spelling errors
   - 50_private_nameservers
       change configuration to put nameservers into users home dirs
       (avoids need for shared writeable directory)
   - 60_use_debian_phyml
       use phyml from debian package for both interfaces in ARB
* debian/rules:
   - create config.makefile from override_dh_configure target
   - use "make tarfile" in override_dh_install
   - remove extra cleaning not needed for ARB 6
   - use "dh_install --list-missing" to avoid missing files
   - added override_dh_fixperms target
* debian/control:
   - added libarb-dev package
   - Depends: added phyml, xdg-utils
   - Suggests: removed phyml
   - fix lintian duplicate-short-description (new descriptions)
* debian/*.install:
   - "unrolled" confusing globbing to select files
   - pick files from debian/tmp
   - moved all config files to /etc/arb
* debian/arb-common.templates: updated
* scripts:
   - removed arb-add-pt-server
   - launch-wrapper: 
     - only add demo.arb to newly created $ARBUSERDATA
     - pass commandline arguments through bin/arb wrapper
   - preinst: removing old PT server index files on upgrade from 5.5*
   - postinst: set setgid on shared PT dir
* rewrote arb.1 manfile
* added file icon for ARB databases
* using upstream arb_tcp.dat

Show diffs side-by-side

added added

removed removed

Lines of Context:
SOURCE_TOOLS/arb_cleanup_patches.pl
 
1
#!/usr/bin/perl
 
2
 
 
3
use strict;
 
4
 
 
5
# --------------------------------------------------------------------------------
 
6
 
 
7
sub 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
 
 
17
sub getAgeAndSize($) {
 
18
  my ($file_or_dir) = @_;
 
19
  my ($mod,$size) = getModtimeAndSize($file_or_dir);
 
20
  return (time-$mod,$size);
 
21
}
 
22
 
 
23
# --------------------------------------------------------------------------------
 
24
 
 
25
sub 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
 
 
33
sub patchesDiffer($$$) {
 
34
  my ($patchDir,$patch,$otherpatch) = @_;
 
35
  my $diff = `diff $patchDir/$patch $patchDir/$otherpatch | wc -l`;
 
36
  return ($diff>0);
 
37
}
 
38
 
 
39
sub 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
 
 
69
sub 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
 
 
86
sub countAndSize($$$) {
 
87
  my ($name,$count,$size) = @_;
 
88
  return $count.' '.$name.' patches ('.readableSize($size).')  ';
 
89
}
 
90
 
 
91
sub 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
 
 
166
eval { main(); };
 
167
if ($@) { die "arb_cleanup_patches.pl: Error: $@\n"; }