← Back to branch summary

~svn/ubuntu/raring/subversion/ppa

« back to all changes in this revision

Viewing changes to contrib/client-side/svn_all_diffs.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/client-side/svn_all_diffs.pl
 
1
#!/usr/bin/perl -w
 
2
 
 
3
# $HeadURL: http://svn.collab.net/repos/svn/branches/1.2.x/contrib/client-side/svn_all_diffs.pl $
 
4
# $LastChangedDate: 2004-09-22 12:20:49 -0400 (Wed, 22 Sep 2004) $
 
5
# $LastChangedBy: blair $
 
6
# $LastChangedRevision: 11065 $
 
7
 
 
8
use strict;
 
9
use Carp;
 
10
use Getopt::Long 2.25;
 
11
 
 
12
# Process the command line options.
 
13
 
 
14
# Print the log message along with the modifications made in a
 
15
# particular revision.
 
16
my $opt_print_log_message;
 
17
 
 
18
GetOptions('log' => \$opt_print_log_message)
 
19
  or &usage;
 
20
 
 
21
&usage("$0: too many arguments") if @ARGV > 1;
 
22
 
 
23
# If there is no file or directory specified on the command line, use
 
24
# the current working directory as a default path.
 
25
my $file_or_dir = @ARGV ? shift : '.';
 
26
 
 
27
unless (-e $file_or_dir)
 
28
  {
 
29
    die "$0: file or directory `$file_or_dir' does not exist.\n";
 
30
  }
 
31
 
 
32
# Get the entire log for this file or directory.  Parse the log into
 
33
# two separate lists.  The first is a list of the revision numbers
 
34
# when this file or directory was modified.  The second is a hash of
 
35
# log messages for each revision.
 
36
my @revisions;
 
37
my %log_messages;
 
38
{
 
39
  my $current_revision;
 
40
  foreach my $log_line (read_from_process('svn', 'log', $file_or_dir))
 
41
    {
 
42
      # Ignore any of the lines containing only -'s.
 
43
      next if $log_line =~ /^-+$/;
 
44
 
 
45
      if (my ($r) = $log_line =~ /^r(\d+)/)
 
46
        {
 
47
          $current_revision                = $r;
 
48
          $log_messages{$current_revision} = "";
 
49
          push(@revisions, $r);
 
50
        }
 
51
 
 
52
      if (defined $current_revision)
 
53
        {
 
54
          $log_messages{$current_revision} .= "$log_line\n";
 
55
        }
 
56
    }
 
57
}
 
58
 
 
59
# Run all the diffs.
 
60
while (@revisions > 1)
 
61
  {
 
62
    my $new_rev = shift @revisions;
 
63
    my $old_rev = $revisions[0];
 
64
 
 
65
    &print_revision($new_rev);
 
66
 
 
67
    my @diff = read_from_process('svn', 'diff',
 
68
                                 "-r$old_rev:$new_rev", $file_or_dir);
 
69
 
 
70
    if ($opt_print_log_message)
 
71
      {
 
72
        print $log_messages{$new_rev};
 
73
      }
 
74
    print join("\n", @diff, "\n");
 
75
  }
 
76
 
 
77
# Print the log message for the last revision.  There is no diff for
 
78
# this revision, because according to svn log, the file or directory
 
79
# did not exist previously.
 
80
{
 
81
  my $last_revision = shift @revisions;
 
82
  if ($opt_print_log_message)
 
83
    {
 
84
      &print_revision($last_revision);
 
85
      print $log_messages{$last_revision};
 
86
    }
 
87
}
 
88
 
 
89
exit 0;
 
90
 
 
91
sub usage
 
92
{
 
93
  warn "@_\n" if @_;
 
94
  die "usage: $0 [file_or_dir]\n";
 
95
}
 
96
 
 
97
sub print_revision
 
98
{
 
99
  my $revision = shift;
 
100
 
 
101
  print "\n\n\nRevision $revision\n";
 
102
}
 
103
 
 
104
# Start a child process safely without using /bin/sh.
 
105
sub safe_read_from_pipe
 
106
{
 
107
  unless (@_)
 
108
    {
 
109
      croak "$0: safe_read_from_pipe passed no arguments.\n";
 
110
    }
 
111
  print "Running @_\n";
 
112
  my $pid = open(SAFE_READ, '-|');
 
113
  unless (defined $pid)
 
114
    {
 
115
      die "$0: cannot fork: $!\n";
 
116
    }
 
117
  unless ($pid)
 
118
    {
 
119
      open(STDERR, ">&STDOUT")
 
120
        or die "$0: cannot dup STDOUT: $!\n";
 
121
      exec(@_)
 
122
        or die "$0: cannot exec `@_': $!\n";
 
123
    }
 
124
  my @output;
 
125
  while (<SAFE_READ>)
 
126
    {
 
127
      chomp;
 
128
      push(@output, $_);
 
129
    }
 
130
  close(SAFE_READ);
 
131
  my $result = $?;
 
132
  my $exit   = $result >> 8;
 
133
  my $signal = $result & 127;
 
134
  my $cd     = $result & 128 ? "with core dump" : "";
 
135
  if ($signal or $cd)
 
136
    {
 
137
      warn "$0: pipe from `@_' failed $cd: exit=$exit signal=$signal\n";
 
138
    }
 
139
  if (wantarray)
 
140
    {
 
141
      return ($result, @output);
 
142
    }
 
143
  else
 
144
    {
 
145
      return $result;
 
146
    }
 
147
}
 
148
 
 
149
# Use safe_read_from_pipe to start a child process safely and exit the
 
150
# script if the child failed for whatever reason.
 
151
sub read_from_process
 
152
{
 
153
  unless (@_)
 
154
    {
 
155
      croak "$0: read_from_process passed no arguments.\n";
 
156
    }
 
157
  my ($status, @output) = &safe_read_from_pipe(@_);
 
158
  if ($status)
 
159
    {
 
160
      die "$0: @_ failed with this output:\n", join("\n", @output), "\n";
 
161
    }
 
162
  else
 
163
    {
 
164
      return @output;
 
165
    }
 
166
}