1package SVN::Log;
2
3# $Id: Log.pm 729 2006-01-11 08:20:09Z nik $
4
5use strict;
6use warnings;
7
8our $VERSION = 0.03;
9
10=head1 NAME
11
12SVN::Log - Extract change logs from a Subversion server.
13
14=head1 SYNOPSIS
15
16  use SVN::Log;
17
18  my $revs = SVN::Log::retrieve ("svn://host/repos", 1);
19
20  print Dumper ($revs);
21
22=head1 DESCRIPTION
23
24SVN::Log retrieves and parses the commit logs from Subversion repositories.
25
26=head1 VARIABLES
27
28=head2 $FORCE_COMMAND_LINE_SVN
29
30If this is true SVN::Log will use the command line svn client instead of
31the subversion perl bindings when it needs to access the repository.
32
33=cut
34
35our $FORCE_COMMAND_LINE_SVN = 0;
36
37=head1 FUNCTIONS
38
39=head2 retrieve
40
41  retrieve('svn://host/repos', $start_rev, $end_rev);
42
43Retrieve one or more log messages from a repository. If a second revision
44is not specified, the revision passed will be retrieved, otherwise the range
45of revisions from $start_rev to $end_rev will be retrieved.
46
47One or both of $start_rev and $end_rev may be given as C<HEAD>, meaning
48the most recent (youngest) revision in the repository.  To retrieve all
49the log messages in the repository.
50
51  retrieve('svn://host/repos', 1, 'HEAD');
52
53To do the same thing, but retrieve the log messages in reverse order (i.e.,
54most recent log message first):
55
56  retrieve('svn://host/repos, 'HEAD', 1);
57
58The revisions are returned as a reference to an array of hashes.  Each hash
59contains the following keys:
60
61=over
62
63=item revision
64
65The number of the revision.
66
67=item paths
68
69A hashref indicating the paths modified by this revision.  Each key is the
70name of the path modified in this revision.  The value is a reference to
71another hash, with the following possible keys.
72
73=over
74
75=item action
76
77The activity that happened to this path.  One of C<A>, C<M>, or C<D>, for
78C<Added>, C<Modified>, or C<Deleted> respectively.  This key is always
79present.
80
81=item copyfrom_path
82
83If the action was C<A> or C<M> then this path may have been copied from
84another path in the repository.  If it was then this key contains the path
85in the repository that the file was originally copied from.
86
87=item copyfrom_rev
88
89If C<copyfrom_path> is set then this value contains the revision that the
90path in C<copyfrom_path> was copied from.
91
92=back
93
94=item author
95
96The author of the revision.  May legitimately be undefined if the
97repository allows unauthenticated commits (e.g., over WebDAV).
98
99=item date
100
101The date of this revision.
102
103=item message
104
105The commit message from this revision.
106
107=back
108
109Alternatively, you can pass C<retrieve()> a hash containing the repository,
110start and end revisions, and a callback function which will be called for
111each revision, like this:
112
113  retrieve ({ repository => "svn://svn.example.org/repos",
114              start => 1,
115              end => 2,
116              callback => sub { print @_; } });
117
118The callback will be passed a reference to a hash of paths modified, the
119revision, the author, the date, and the message associated with the revision.
120
121See L<SVN::Log::Index> for the cannonical example of how to do this.
122
123=cut
124
125sub retrieve {
126  my ($repos, $start_rev, $end_rev, $callback);
127
128  if (scalar @_ == 1 and ref $_[0] eq 'HASH') {
129    $repos = $_[0]->{repository};
130
131    $start_rev = $_[0]->{start};
132
133    $start_rev = $_[0]->{revision} unless defined $start_rev;
134
135    $end_rev = $_[0]->{end};
136
137    $callback = $_[0]->{callback};
138  } else {
139    ($repos, $start_rev, $end_rev) = @_;
140  }
141
142  die "need at least a repository and a revision"
143    unless defined $repos and defined $start_rev;
144
145  my $revs = [];
146
147  $callback = sub { _handle_log ($revs, @_); } unless defined $callback;
148
149  $end_rev = $start_rev unless defined $end_rev;
150
151  unless ($repos =~ m/^(http|https|svn|file|svn\+ssh):\/\//) {
152    $repos = "file://$repos";
153  }
154
155  _do_log ($repos, $start_rev, $end_rev, $callback);
156
157  return $revs;
158}
159
160sub _do_log {
161  # we only pull this in here so that the search portions of this module
162  # can be used in environments where the svn libs can't be linked against.
163  #
164  # this can happen, for example, when apache and mod_perl2 are linked
165  # against different versions of the APR libraries than subversion is.
166  #
167  # not that i happen to have a system like that or anything...
168  unless ($FORCE_COMMAND_LINE_SVN) {
169    eval {
170      require SVN::Core;
171      require SVN::Ra;
172    };
173  }
174
175  if ($@ || $FORCE_COMMAND_LINE_SVN) {
176    # oops, we don't have the SVN perl libs installed, so instead we need
177    # to fall back to using the command line client the old fashioned way
178    goto &_do_log_commandline;
179  } else {
180    goto &_do_log_bindings;
181  }
182}
183
184sub _do_log_bindings {
185  my ($repos, $start_rev, $end_rev, $callback) = @_;
186
187  my $r = SVN::Ra->new (url => $repos) or die "error opening RA layer: $!";
188
189  if($start_rev eq 'HEAD') {
190    $start_rev = $r->get_latest_revnum();
191  }
192
193  if($end_rev eq 'HEAD') {
194    $end_rev = $r->get_latest_revnum();
195  }
196
197  $r->get_log (['/'], $start_rev, $end_rev, 0, 1, 0,
198               sub { _handle_log_bindings($callback, @_); });
199}
200
201sub _do_log_commandline {
202  my ($repos, $start_rev, $end_rev, $callback) = @_;
203
204  open my $log, "svn log -v -r $start_rev:$end_rev $repos|"
205    or die "couldn't open pipe to svn process: $!";
206
207  my ($paths, $rev, $author, $date, $msg);
208
209  my $state = 'start';
210
211  my $seprule  = qr/^-{72}$/;
212  my $headrule = qr/r(\d+) \| (\w+) \| (\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2})/;
213
214  # XXX i'm sure this can be made much much cleaner...
215  while (<$log>) {
216    if ($state eq 'start' or $state eq 'message' and m/$seprule/) {
217      if ($state eq 'start') {
218        $state = 'head';
219      } elsif ($state eq 'message') {
220        $state = 'head';
221        $callback->($paths, $rev, $author, $date, $msg);
222      }
223    } elsif ($state eq 'head' and m/$headrule/) {
224      $rev = $1;
225      $author = $2;
226      $date = $3;
227      $paths = {};
228      $msg = "";
229
230      $state = 'paths';
231    } elsif ($state eq 'paths') {
232      unless (m/^Changed paths:$/) {
233        if (m/^$/) {
234          $state = 'message';
235        } else {
236          if (m/^\s+(\w+) (.+)$/) {
237	    my $action = $1;
238	    my $str    = $2;
239
240	    # If a copyfrom_{path,rev} is listed then include it,
241	    # otherwise just note the path and the action.
242	    if($str =~ /^(.*?) \(from (.*?):(\d+)\)$/) {
243	      $paths->{$1}{action} = $action;
244	      $paths->{$1}{copyfrom_path} = $2;
245	      $paths->{$1}{copyfrom_rev} = $3;
246	    } else {
247	      $paths->{$str}{action} = $action;
248	    }
249          }
250        }
251      }
252    } elsif ($state eq 'message') {
253      $msg .= $_;
254    }
255  }
256}
257
258my @fields = qw(paths revision author date message);
259
260# Unpack the svn_log_changed_path_t parameters.  _do_log_command_line()
261# can call the user-supplied callback directly.  _do_log_bindings() can't,
262# because the list of changed paths (and what was changed) are implemented
263# as objects when using the bindings.
264#
265# This sub calls the relevant methods on the log_changed_path object, and
266# replaces the object reference with the methods' return values.  Then it
267# calls the user supplied callback.
268#
269# This way the user callbacks don't need to know whether we're using the
270# bindings or the command line client.
271sub _handle_log_bindings {
272  my $callback = shift;
273  my %revision;
274
275  @revision{@fields} = @_;
276
277  if(exists $revision{paths}) {
278    foreach my $path (keys %{$revision{paths}}) {
279      my $lcp = $revision{paths}{$path};
280
281      delete $revision{paths}{$path};
282
283      $revision{paths}{$path}{action} = $lcp->action();
284      if(defined $lcp->copyfrom_path()) {
285	$revision{paths}{$path}{copyfrom_path} = $lcp->copyfrom_path();
286	$revision{paths}{$path}{copyfrom_rev} = $lcp->copyfrom_rev();
287      }
288    }
289  }
290
291  $callback->(@revision{@fields});
292}
293
294sub _handle_log {
295  my $revs = shift;
296  my %revision;
297
298  @revision{@fields} = @_;
299  push @$revs, \%revision;
300}
301
3021;
303__END__
304
305=head1 SEE ALSO
306
307L<SVN::Log::Index>
308
309=head1 BUGS
310
311Please report any bugs or feature requests to
312C<bug-svn-log@rt.cpan.org>, or through the web interface at
313L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=SVN-Log>.
314I will be notified, and then you'll automatically be notified of progress on
315your bug as I make changes.
316
317=head1 AUTHOR
318
319The current maintainer is Nik Clayton, <nikc@cpan.org>.
320
321The original author was Garrett Rooney, <rooneg@electricjellyfish.net>.
322Originally extracted from from SVN::Log::Index by Richard Clamp,
323<richardc@unixbeard.net>
324
325=head1 COPYRIGHT
326
327Copyright 2005 Nik Clayton.  All Rights Reserved.
328
329Copyright 2004 Garrett Rooney.  All Rights Reserved.
330
331Copyright 2004 Richard Clamp.  All Rights Reserved.
332
333This program is free software; you can redistribute it
334and/or modify it under the same terms as Perl itself.
335
336=cut
337