sventon subversion web client - http://www.sventon.org
[show recent changes]
 
  Help
Rev: HEAD (16683) - svn://svn.freehep.org/svn / config / svn_integrity_check.pl
Show File - svn_integrity_check.pl  [show properties]
Search for Help
spinner
#!/usr/bin/env perl
#
#
# @Author Mark Donszelmann
# @version $Id: svn_integrity_check.pl 8649 2006-08-21 20:13:11Z duns $
# Turn on warnings the best way depending on the Perl version.
BEGIN {
 if ( $] >= 5.006_000) {
10    require warnings; import warnings;
11   } else {
12    $^W = 1;
13   }
14  }
15 
16  use strict;
17  use Carp;
18  use vars qw/ %opt /;
19 
20  use Getopt::Std;
21  my $opt_string = 'chpi';
22  getopts( "$opt_string", \%opt ) or usage();
23  usage() if $opt{h};
24 
25  my $SVN = "/usr/local/bin/svn";
26 
27  # find path to config file
28  my $config = ".";
29  if ($0 =~ /(.*)\/.*/) {
30   $config = $1;
31  }
32 
33  my $correct = $opt{c};
34  my $html = !$opt{p};
35  my $interactive = $opt{i};
36 
37  my %extensions = ();
38 
39  foreach my $line (&read_from_process('cat', "$config/svn-mime-types.txt")) {
40   my $name;
41   my @value;
42   my $prop;
43 
44   if ($line =~ /(\S+)\s*=\s*(.*)/) {
45    $name = $1;
46    @value = split(/;/, $2);
47    foreach $prop (@value) {
48     if ($prop =~ /(\S+)\s*=\s*(.*)/) {
49      $extensions{$name}{$1}=$2;
50     }
51    }
52   }
53  }
54 
55  # Figure out what files to check
56  my @files;
57  foreach my $line (&read_from_process('find', '.', '-print')) {
58  # Only add if
59  # 1. does not contain /.svn directory
60  # 2. is not a directory
61      if (!($line =~ /\/\.svn/) && !(-d $line)) {
62    push(@files, $line);
63   }
64  }
65 
66  my $noOfFiles = @files;
67  if ($interactive) {
68   print "Checking $noOfFiles files...\n";
69  }
70 
71  my @errors;
72  my $count = 0;
73  foreach my $path ( @files ) {
74   $count++;
75   if ($interactive && !($count % 10)) {
76    print ".";
77   }
78 
79   my $mime_type;
80   my $eol_style;
81   my $keywords;
82 
83   # Parse the complete list of property values of the file $path to extract
84   # the mime-type and eol-style
85   foreach my $prop (&read_from_process($SVN, 'proplist',
86                                    '--verbose', $path)) {
87       if ($prop =~ /^\s*svn:mime-type : (\S+)/) {
88           $mime_type = $1;
89          } elsif ($prop =~ /^\s*svn:eol-style : (\S+)/) {
90              $eol_style = $1;
91          } elsif ($prop =~ /^\s*svn:keywords : (\S+)/) {
92              $keywords = $1;
93          }
94   }
95 
96   my $file;
97   my $name;
98   my $ext;
99 
100   if ($path =~ /.*\/(.*)/) {
101    $file = $1;
102    if ($file =~ /(.*)(\..*)/) {
103     $name = $1;
104     $ext = $2;
105    } else {
106     $name = $file;
107     $ext = "";
108    }
109   } else {
110    push @errors, "WARNING: Cannot find filename in $path\n";
111   }
112 
113   # Detect error conditions and add them to @errors
114      if (not $mime_type) {
115    if (exists $extensions{$file}{"svn:mime-type"}) {
116     $mime_type = $extensions{$file}{"svn:mime-type"};
117     push @errors, "$path : Set svn:mime-type to '$mime_type'.";
118     if ($correct) {
119      push @errors, &read_from_process($SVN, 'propset',
120                                    '--non-interactive', '-q',
121                                    'svn:mime-type', $mime_type, $path);
122     }
123    } elsif (exists $extensions{"*$ext"}{"svn:mime-type"}) {
124     $mime_type = $extensions{"*$ext"}{"svn:mime-type"};
125     push @errors, "$path : Set svn:mime-type to '$mime_type'.";
126     if ($correct) {
127      push @errors, &read_from_process($SVN, 'propset',
128                                    '--non-interactive', '-q',
129                                    'svn:mime-type', $mime_type, $path);
130     }
131    } else {
132     $mime_type = "dummy";
133     push @errors, "$path : No svn:mime-type registered.";
134    }
135   }
136 
137   if ($mime_type =~ /^text\// and not $eol_style) {
138    if (exists $extensions{$file}{"svn:eol-style"}) {
139     $eol_style = $extensions{$file}{"svn:eol-style"};
140    } elsif (exists $extensions{"*$ext"}{"svn:eol-style"}) {
141     $eol_style = $extensions{"*$ext"}{"svn:eol-style"};
142    } else {
143     $eol_style = "native";
144    }
145    push @errors, "$path : Set svn:eol-style to '$eol_style'.";
146    if ($correct) {
147     push @errors, &read_from_process($SVN, 'propset',
148                                    '--non-interactive', '-q',
149                                    'svn:eol-style', $eol_style, $path);
150    }
151   }
152 
153   if ($mime_type =~ /^text\// and not $keywords) {
154    if (exists $extensions{$file}{"svn:keywords"}) {
155     $keywords = $extensions{$file}{"svn:keywords"};
156    } elsif (exists $extensions{"*$ext"}{"svn:keywords"}) {
157     $keywords = $extensions{"*$ext"}{"svn:keywords"};
158    } else {
159     $keywords = '"Author Date Id Revision"';
160    }
161    push @errors, "$path : Set keywords to '$keywords'.";
162    if ($correct) {
163     push @errors, &read_from_process($SVN, 'propset',
164                                    '--non-interactive', '-q',
165                                    'svn:keywords', $keywords, $path);
166    }
167      }
168  }
169  if ($interactive) {
170   print "\n";
171  }
172 
173  if (@errors) {
174   if ($html) {
175    print "<html>\n";
176    print "<h1>FreeHEP SVN Integrity Report</h1>\n";
177    print "<p>Checked $noOfFiles files in all repositories</p>\n";
178       print "<h2>Errors</h2>\n";
179       print "<dl>\n";
180       foreach my $error (@errors) {
181        my @parts = split(/:/, $error, 2);
182        print "<dt>$parts[0]</dt>\n";
183        if (@parts > 1) {
184         print "<dd>$parts[1]</dd>\n";
185        } else {
186         print "<dd></dd>\n";
187        }
188       }
189       print "</dl>\n";
190       print "\n\n", <<EOS;
191  <p>
192      Every file must have the svn:mime-type property set. In
193      addition text files must have the svn:eol-style and svn:keywords
194      properties set.
195  </p>
196  <p>
197      For binary files try running
198  <pre>
199      svn propset svn:mime-type application/octet-stream path/of/file
200  </pre>
201  </p>
202 
203      For text files try
204  <pre>
205      svn propset svn:mime-type text/plain path/of/file
206      svn propset svn:eol-style native path/of/file
207      svn propset svn:keywords 'Author Date Id Revision' path/of/file
208  </pre>
209 
210  <p>
211      You may want to consider uncommenting the auto-props section
212      in your ~/.subversion/config file. Read the Subversion book
213      (http://svnbook.red-bean.com/), Chapter 7, Properties section,
214      Automatic Property Setting subsection for more help.
215  </p>
216  </html>
217  EOS
218   } else {
219       print "$0:\n\n",
220            join("\n", @errors), "\n\n";
221   }
222      exit 1;
223  } else {
224      exit 0;
225  }
226 
227  #
228  # Subroutines below
229  #
230  sub usage {
231      print STDERR << "EOF";
232 
233      This program checks the integrity of the SVN repositories.
234 
235      usage: $0 [-hcpi]
236 
237       -h : this (help) message
238       -c : correct integrity w/o committing changes
239       -p : plain text output
240       -i : interactive
241 
242  EOF
243      exit;
244  }
245 
246 
247  sub safe_read_from_pipe
248  {
249    unless (@_)
250      {
251        croak "$0: safe_read_from_pipe passed no arguments.\n";
252      }
253  # print "Running @_\n";
254    my $pid = open(SAFE_READ, '-|');
255    unless (defined $pid)
256      {
257        die "$0: cannot fork: $!\n";
258      }
259    unless ($pid)
260      {
261        open(STDERR, ">&STDOUT")
262          or die "$0: cannot dup STDOUT: $!\n";
263        exec(@_)
264          or die "$0: cannot exec `@_': $!\n";
265      }
266    my @output;
267    while (<SAFE_READ>)
268      {
269        chomp;
270        push(@output, $_);
271      }
272    close(SAFE_READ);
273    my $result = $?;
274    my $exit = $result >> 8;
275    my $signal = $result & 127;
276    my $cd = $result & 128 ? "with core dump" : "";
277    if ($signal or $cd)
278      {
279        warn "$0: pipe from `@_' failed $cd: exit=$exit signal=$signal\n";
280      }
281    if (wantarray)
282      {
283        return ($result, @output);
284      }
285    else
286      {
287        return $result;
288      }
289  }
290 
291  sub read_from_process
292    {
293    unless (@_)
294      {
295        croak "$0: read_from_process passed no arguments.\n";
296      }
297    my ($status, @output) = &safe_read_from_pipe(@_);
298    if ($status)
299      {
300        if (@output)
301          {
302            return join("\n", @output), "\n";
303          }
304        else
305          {
306            return "ERROR: `@_' failed with no output.\n";
307          }
308      }
309    else
310      {
311        return @output;
312      }
313  }


feed icon

sventon 2.5.1