← Back to branch summary

~svn/ubuntu/raring/subversion/ppa

« back to all changes in this revision

Viewing changes to contrib/hook-scripts/check-mime-type.pl

  • Committer: Bazaar Package Importer
  • Author(s): Adam Conrad
  • Date: 2005-12-05 01:26:14 UTC
  • mfrom: (1.1.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20051205012614-qom4xfypgtsqc2xq
Tags: 1.2.3dfsg1-3ubuntu1
Merge with the final Debian release of 1.2.3dfsg1-3, bringing in
fixes to the clean target, better documentation of the libdb4.3
upgrade and build fixes to work with swig1.3_1.3.27.

Show diffs side-by-side

added added

removed removed

Lines of Context:
contrib/hook-scripts/check-mime-type.pl
 
1
#!/usr/bin/env perl
 
2
 
 
3
# ====================================================================
 
4
# commit-mime-type-check.pl: check that every added file has the
 
5
# svn:mime-type property set and every added file with a mime-type
 
6
# matching text/* also has svn:eol-style set. If any file fails this
 
7
# test the user is sent a verbose error message suggesting solutions and
 
8
# the commit is aborted.
 
9
#
 
10
# Usage: commit-mime-type-check.pl REPOS TXN-NAME
 
11
# ====================================================================
 
12
# Most of commit-mime-type-check.pl was taken from
 
13
# commit-access-control.pl, Revision 9986, 2004-06-14 16:29:22 -0400.
 
14
# ====================================================================
 
15
# Copyright (c) 2000-2004 CollabNet.  All rights reserved.
 
16
#
 
17
# This software is licensed as described in the file COPYING, which
 
18
# you should have received as part of this distribution.  The terms
 
19
# are also available at http://subversion.tigris.org/license.html.
 
20
# If newer versions of this license are posted there, you may use a
 
21
# newer version instead, at your option.
 
22
#
 
23
# This software consists of voluntary contributions made by many
 
24
# individuals.  For exact contribution history, see the revision
 
25
# history and logs, available at http://subversion.tigris.org/.
 
26
# ====================================================================
 
27
 
 
28
# Turn on warnings the best way depending on the Perl version.
 
29
BEGIN {
 
30
  if ( $] >= 5.006_000)
 
31
    { require warnings; import warnings; }                      
 
32
  else  
 
33
    { $^W = 1; }               
 
34
}           
 
35
 
 
36
use strict;
 
37
use Carp;
 
38
 
 
39
 
 
40
######################################################################
 
41
# Configuration section.
 
42
 
 
43
# Svnlook path.
 
44
my $svnlook = "/usr/bin/svnlook";
 
45
 
 
46
# Since the path to svnlook depends upon the local installation
 
47
# preferences, check that the required program exists to insure that
 
48
# the administrator has set up the script properly.
 
49
{
 
50
  my $ok = 1;
 
51
  foreach my $program ($svnlook)
 
52
    {
 
53
      if (-e $program)
 
54
        {
 
55
          unless (-x $program)
 
56
            {
 
57
              warn "$0: required program `$program' is not executable, ",
 
58
                   "edit $0.\n";
 
59
              $ok = 0;
 
60
            }
 
61
        }
 
62
      else
 
63
        {
 
64
          warn "$0: required program `$program' does not exist, edit $0.\n";
 
65
          $ok = 0;
 
66
        }
 
67
    }
 
68
  exit 1 unless $ok;
 
69
}
 
70
 
 
71
######################################################################
 
72
# Initial setup/command-line handling.
 
73
 
 
74
&usage unless @ARGV == 2;
 
75
 
 
76
my $repos        = shift;
 
77
my $txn          = shift;
 
78
 
 
79
unless (-e $repos)
 
80
  {
 
81
    &usage("$0: repository directory `$repos' does not exist.");
 
82
  }
 
83
unless (-d $repos)
 
84
  {
 
85
    &usage("$0: repository directory `$repos' is not a directory.");
 
86
  }
 
87
 
 
88
# Define two constant subroutines to stand for read-only or read-write
 
89
# access to the repository.
 
90
sub ACCESS_READ_ONLY  () { 'read-only' }
 
91
sub ACCESS_READ_WRITE () { 'read-write' }
 
92
 
 
93
 
 
94
######################################################################
 
95
# Harvest data using svnlook.
 
96
 
 
97
# Change into /tmp so that svnlook diff can create its .svnlook
 
98
# directory.
 
99
my $tmp_dir = '/tmp';
 
100
chdir($tmp_dir)
 
101
  or die "$0: cannot chdir `$tmp_dir': $!\n";
 
102
 
 
103
# Figure out what files have added using svnlook.
 
104
my @files_added;
 
105
foreach my $line (&read_from_process($svnlook, 'changed', $repos, '-t', $txn))
 
106
  {
 
107
                # Add only files that were added to @files_added
 
108
    if ($line =~ /^A.  (.*[^\/])$/)
 
109
      {
 
110
        push(@files_added, $1);
 
111
      }
 
112
  }
 
113
 
 
114
my @errors;
 
115
foreach my $path ( @files_added ) 
 
116
        {
 
117
                my $mime_type;
 
118
                my $eol_style;
 
119
 
 
120
                # Parse the complete list of property values of the file $path to extract
 
121
                # the mime-type and eol-style
 
122
                foreach my $prop (&read_from_process($svnlook, 'proplist', $repos, '-t', 
 
123
                                  $txn, '--verbose', $path))
 
124
                        {
 
125
                                if ($prop =~ /^\s*svn:mime-type : (\S+)/)
 
126
                                        {
 
127
                                                $mime_type = $1;
 
128
                                        }
 
129
                                elsif ($prop =~ /^\s*svn:eol-style : (\S+)/)
 
130
                                        {
 
131
                                                $eol_style = $1;
 
132
                                        }
 
133
                        }
 
134
 
 
135
                # Detect error conditions and add them to @errors
 
136
                if (not $mime_type)
 
137
                        {
 
138
                                push @errors, "$path : svn:mime-type is not set";
 
139
                        }
 
140
                elsif ($mime_type =~ /^text\// and not $eol_style)
 
141
                        {
 
142
                                push @errors, "$path : svn:mime-type=$mime_type but svn:eol-style is not set";
 
143
                        }
 
144
        }
 
145
 
 
146
# If there are any errors list the problem files and give information
 
147
# on how to avoid the problem. Hopefully people will set up auto-props
 
148
# and will not see this verbose message more than once.
 
149
if (@errors)
 
150
  {
 
151
    warn "$0:\n\n",
 
152
         join("\n", @errors), "\n\n",
 
153
                                 <<EOS;
 
154
 
 
155
    Every added file must have the svn:mime-type property set. In
 
156
    addition text files must have the svn:eol-style property set.
 
157
    
 
158
    For binary files try running
 
159
    svn propset svn:mime-type application/octet-stream path/of/file
 
160
    
 
161
    For text files try
 
162
    svn propset svn:mime-type text/plain path/of/file
 
163
    svn propset svn:eol-style native path/of/file
 
164
    
 
165
    You may want to consider uncommenting the auto-props section
 
166
    in your ~/.subversion/config file. Read the Subversion book
 
167
    (http://svnbook.red-bean.com/), Chapter 7, Properties section,
 
168
    Automatic Property Setting subsection for more help.
 
169
EOS
 
170
    exit 1;
 
171
  }
 
172
else
 
173
  {
 
174
    exit 0;
 
175
  }
 
176
 
 
177
sub usage
 
178
{
 
179
  warn "@_\n" if @_;
 
180
  die "usage: $0 REPOS TXN-NAME\n";
 
181
}
 
182
 
 
183
sub safe_read_from_pipe
 
184
{
 
185
  unless (@_)
 
186
    {
 
187
      croak "$0: safe_read_from_pipe passed no arguments.\n";
 
188
    }
 
189
  print "Running @_\n";
 
190
  my $pid = open(SAFE_READ, '-|');
 
191
  unless (defined $pid)
 
192
    {
 
193
      die "$0: cannot fork: $!\n";
 
194
    }
 
195
  unless ($pid)
 
196
    {
 
197
      open(STDERR, ">&STDOUT")
 
198
        or die "$0: cannot dup STDOUT: $!\n";
 
199
      exec(@_)
 
200
        or die "$0: cannot exec `@_': $!\n";
 
201
    }
 
202
  my @output;
 
203
  while (<SAFE_READ>)
 
204
    {
 
205
      chomp;
 
206
      push(@output, $_);
 
207
    }
 
208
  close(SAFE_READ);
 
209
  my $result = $?;
 
210
  my $exit   = $result >> 8;
 
211
  my $signal = $result & 127;
 
212
  my $cd     = $result & 128 ? "with core dump" : "";
 
213
  if ($signal or $cd)
 
214
    {
 
215
      warn "$0: pipe from `@_' failed $cd: exit=$exit signal=$signal\n";
 
216
    }
 
217
  if (wantarray)
 
218
    {
 
219
      return ($result, @output);
 
220
    }
 
221
  else
 
222
    {
 
223
      return $result;
 
224
    }
 
225
}
 
226
 
 
227
sub read_from_process
 
228
  {
 
229
  unless (@_)
 
230
    {
 
231
      croak "$0: read_from_process passed no arguments.\n";
 
232
    }
 
233
  my ($status, @output) = &safe_read_from_pipe(@_);
 
234
  if ($status)
 
235
    {
 
236
      if (@output)
 
237
        {
 
238
          die "$0: `@_' failed with this output:\n", join("\n", @output), "\n";
 
239
        }
 
240
      else
 
241
        {
 
242
          die "$0: `@_' failed with no output.\n";
 
243
        }
 
244
    }
 
245
  else
 
246
    {
 
247
      return @output;
 
248
    }
 
249
}