source: tags/arb-7.0/SOURCE_TOOLS/svn_apply_ignores.pl

Last change on this file was 17662, checked in by westram, 5 years ago
  • fix svn_apply_ignores.pl:
    • did only work with old svn versions. now uses 'svn list' to find entries.
    • document that we need to commit new library directory before svn_apply_ignores.pl can be used.
  • Property svn:executable set to *
File size: 4.8 KB
Line 
1#!/usr/bin/perl
2# ============================================================ #
3#                                                              #
4#   File      : svn_apply_ignores.pl                           #
5#   Purpose   : apply SVN default ignores for ARB              #
6#                                                              #
7#   Coded by Ralf Westram (coder@reallysoft.de) in July 2011   #
8#   Institute of Microbiology (Technical University Munich)    #
9#   http://www.arb-home.de/                                    #
10#                                                              #
11# ============================================================ #
12
13# configure here
14my $dump = 0;
15# configure here
16
17
18my $ARBHOME = $ENV{ARBHOME};
19if (not -d $ARBHOME) { die "no ARBHOME"; }
20
21my $SELF = $ARBHOME.'/SOURCE_TOOLS/svn_apply_ignores.pl';
22
23sub apply_dir($$) {
24  my ($full,$rel) = @_;
25
26  my $cmd = "svn pe svn:ignore $rel --editor-cmd \"$SELF --dopropedit $full \"";
27  system($cmd)==0 || die "can't execute '$cmd' (Reason: $?)";
28}
29
30sub getSvnSubdirs($\@) {
31  my ($dir,$entry_r) = @_;
32  my $cmd = "(cd '$dir';svn list --recursive)";
33  open(INFO,$cmd.'|') || die "failed to execute '$cmd'";
34  foreach my $line (<INFO>) {
35    chomp($line);
36    if ($line =~ /\/$/o) { # push only directories
37      push @$entry_r, $`; # also skip trailing '/'
38    }
39  }
40  close(INFO);
41}
42
43sub apply_recursive($$) {
44  my ($full,$rel) = @_;
45
46  my @subdirs  = ();
47  getSvnSubdirs($full,@subdirs);
48
49  apply_dir($full,$rel); # apply in ARBHOME
50  foreach (@subdirs) {
51    apply_dir($full.'/'.$_,$rel.'/'.$_); # apply in svn subdirectories
52  }
53}
54
55sub dumpContent($\@) {
56  my ($tag,$content_r) = @_;
57  print "------------------------------ [$tag start]\n";
58  foreach (@$content_r) { print "$_\n"; }
59  print "------------------------------ [$tag end]\n";
60}
61
62sub scanFilesExtensions($\%\%) {
63  my ($dir,$files_r,$ext_r) = @_;
64  opendir(DIR,$dir) || die "can't read directory '$dir' (Reason: $!)";
65  foreach (readdir(DIR)) {
66    my $full = $dir.'/'.$_;
67    if (-f $full) {
68      $$files_r{$_} = 1;
69      if (/\.([^.]+)$/) { $$ext_r{$1} = 1; }
70    }
71  }
72  closedir(DIR);
73}
74
75sub propedit_dir($$$) {
76  # called as editor from svn-command
77
78  my ($rel,$full,$propfile) = @_;
79
80  open(IN,'<'.$propfile) || die "can't load '$propfile' (Reason: $!)";
81  my @content = ();
82  my $line;
83  while (defined($line=<IN>)) { chomp($line); push @content, $line; }
84  close(IN);
85
86  my %have = ();
87  sub add_missing($) {
88    my ($want) = @_;
89    if (not defined $have{$want}) {
90      print "Added '$want'\n";
91      push @content, $want;
92    }
93  }
94
95  $dump==0 || dumpContent('old', @content);
96
97  my %file = ();
98  my %ext = ();
99  scanFilesExtensions($full,%file,%ext);
100
101  # ---------------------------------------- conditions
102
103  my $creates_gcov = (defined $ext{c} or defined $ext{cpp} or defined $ext{cxx});
104  my $creates_bak = (defined $file{Makefile});
105  my $is_root = ($rel eq '.');
106
107  %have = map { $_ => 1; } @content;
108
109  # ---------------------------------------- remove ignores
110
111  my @unwanted = (
112                  'Makefile.bak',
113                  '*.gcda',
114                 );
115
116  if (not $creates_gcov) { push @unwanted, '*.gcno'; }
117  if (not $creates_bak) { push @unwanted, '*.bak'; }
118  if (not $is_root) { push @unwanted, 'ChangeLog'; }
119
120  # ---------------------------------------- remove ignores
121
122  my %unwanted = map { $_ => 1; } @unwanted;
123
124  foreach (@content) {
125    if (defined $unwanted{$_}) { print "Removed '$_'\n"; }
126  }
127  @content = map {
128    if (defined $unwanted{$_}) { ; }
129    else { $_; }
130  } @content;
131
132  %have = map { $_ => 1; } @content;
133
134  # ---------------------------------------- add ignores
135
136  if ($creates_bak) { add_missing('*.bak'); }
137  if ($creates_gcov) { add_missing('*.gcno'); }
138
139  # ---------------------------------------- add ignores
140
141  $dump==0 || dumpContent('new', @content);
142
143
144  open(OUT,'>'.$propfile) || die "can't save '$propfile' (Reason: $!)";
145  foreach (@content) { print OUT $_."\n"; }
146  close(OUT);
147}
148
149sub show_usage() {
150  print "Usage: svn_apply_ignores.pl --apply\n";
151  print "       Apply all\n";
152  print "Usage: svn_apply_ignores.pl --dopropedit DIR PROPFILE\n";
153  print "       Edit property for directory 'DIR'\n";
154}
155
156sub main() {
157  my $args = scalar(@ARGV);
158
159  if ($args==0) {
160    show_usage();
161  }
162  else {
163    if ($ARGV[0] eq '--apply') {
164      chdir($ARBHOME);
165      apply_recursive($ARBHOME,'.');
166    }
167    elsif ($ARGV[0] eq '--dopropedit') {
168      my $DIR = $ARGV[1];
169      my $PROPFILE = $ARGV[2];
170      my ($REL,$FULL);
171      if ($DIR =~ /^$ARBHOME(\/)?/) {
172        ($REL,$FULL) = ($',$DIR);
173        if ($REL eq '') { $REL = '.'; }
174      }
175      else {
176        ($REL,$FULL) = ($DIR,$ARBHOME.'/'.$DIR);
177      }
178      if (not -d $FULL) { die "No such directory '$FULL'"; }
179      if (not -f $PROPFILE) { die "No such directory '$PROPFILE'"; }
180
181      propedit_dir($REL,$FULL,$PROPFILE);
182    }
183  }
184}
185main();
186
Note: See TracBrowser for help on using the repository browser.