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