]> git.vanrenterghem.biz Git - git.ikiwiki.info.git/blob - IkiWiki/Plugin/svn.pm
update for rename of recentchanges.mdwn to __8226____9__Get_CAll___64___1__42__855...
[git.ikiwiki.info.git] / IkiWiki / Plugin / svn.pm
1 #!/usr/bin/perl
2 package IkiWiki::Plugin::svn;
4 use warnings;
5 use strict;
6 use IkiWiki;
7 use POSIX qw(setlocale LC_CTYPE);
8 use URI::Escape q{uri_escape_utf8};
10 sub import {
11         hook(type => "checkconfig", id => "svn", call => \&checkconfig);
12         hook(type => "getsetup", id => "svn", call => \&getsetup);
13         hook(type => "rcs", id => "rcs_update", call => \&rcs_update);
14         hook(type => "rcs", id => "rcs_prepedit", call => \&rcs_prepedit);
15         hook(type => "rcs", id => "rcs_commit", call => \&rcs_commit);
16         hook(type => "rcs", id => "rcs_commit_staged", call => \&rcs_commit_staged);
17         hook(type => "rcs", id => "rcs_add", call => \&rcs_add);
18         hook(type => "rcs", id => "rcs_remove", call => \&rcs_remove);
19         hook(type => "rcs", id => "rcs_rename", call => \&rcs_rename);
20         hook(type => "rcs", id => "rcs_recentchanges", call => \&rcs_recentchanges);
21         hook(type => "rcs", id => "rcs_diff", call => \&rcs_diff);
22         hook(type => "rcs", id => "rcs_getctime", call => \&rcs_getctime);
23         hook(type => "rcs", id => "rcs_getmtime", call => \&rcs_getmtime);
24 }
26 sub checkconfig () {
27         if (! defined $config{svnpath}) {
28                 $config{svnpath}="trunk";
29         }
30         if (exists $config{svnpath}) {
31                 # code depends on the path not having extraneous slashes
32                 $config{svnpath}=~tr#/#/#s;
33                 $config{svnpath}=~s/\/$//;
34                 $config{svnpath}=~s/^\///;
35         }
36         if (defined $config{svn_wrapper} && length $config{svn_wrapper}) {
37                 push @{$config{wrappers}}, {
38                         wrapper => $config{svn_wrapper},
39                         wrappermode => (defined $config{svn_wrappermode} ? $config{svn_wrappermode} : "04755"),
40                 };
41         }
42 }
44 sub getsetup () {
45         return
46                 plugin => {
47                         safe => 0, # rcs plugin
48                         rebuild => undef,
49                         section => "rcs",
50                 },
51                 svnrepo => {
52                         type => "string",
53                         example => "/svn/wiki",
54                         description => "subversion repository location",
55                         safe => 0, # path
56                         rebuild => 0,
57                 },
58                 svnpath => {
59                         type => "string",
60                         example => "trunk",
61                         description => "path inside repository where the wiki is located",
62                         safe => 0, # paranoia
63                         rebuild => 0,
64                 },
65                 svn_wrapper => {
66                         type => "string",
67                         example => "/svn/wikirepo/hooks/post-commit",
68                         description => "svn post-commit hook to generate",
69                         safe => 0, # file
70                         rebuild => 0,
71                 },
72                 svn_wrappermode => {
73                         type => "string",
74                         example => '04755',
75                         description => "mode for svn_wrapper (can safely be made suid)",
76                         safe => 0,
77                         rebuild => 0,
78                 },
79                 historyurl => {
80                         type => "string",
81                         example => "http://svn.example.org/trunk/[[file]]",
82                         description => "viewvc url to show file history ([[file]] substituted)",
83                         safe => 1,
84                         rebuild => 1,
85                 },
86                 diffurl => {
87                         type => "string",
88                         example => "http://svn.example.org/trunk/[[file]]?root=wiki&r1=[[r1]]&r2=[[r2]]",
89                         description => "viewvc url to show a diff ([[file]], [[r1]], and [[r2]] substituted)",
90                         safe => 1,
91                         rebuild => 1,
92                 },
93 }
95 # svn needs LC_CTYPE set to a UTF-8 locale, so try to find one. Any will do.
96 sub find_lc_ctype() {
97         my $current = setlocale(LC_CTYPE());
98         return $current if $current =~ m/UTF-?8$/i;
100         # Make some obvious attempts to avoid calling `locale -a`
101         foreach my $locale ("$current.UTF-8", "en_US.UTF-8", "en_GB.UTF-8") {
102                 return $locale if setlocale(LC_CTYPE(), $locale);
103         }
105         # Try to get all available locales and pick the first UTF-8 one found.
106         if (my @locale = grep(/UTF-?8$/i, `locale -a`)) {
107                 chomp @locale;
108                 return $locale[0] if setlocale(LC_CTYPE(), $locale[0]);
109         }
111         # fallback to the current locale
112         return $current;
114 $ENV{LC_CTYPE} = $ENV{LC_CTYPE} || find_lc_ctype();
116 sub svn_info ($$) {
117         my $field=shift;
118         my $file=shift;
120         my $info=`LANG=C svn info $file`;
121         my ($ret)=$info=~/^$field: (.*)$/m;
122         return $ret;
125 sub rcs_update () {
126         if (system("svn", "update", "--quiet", $config{srcdir}) != 0) {
127                 warn("svn update failed\n");
128         }
131 sub rcs_prepedit ($) {
132         # Prepares to edit a file under revision control. Returns a token
133         # that must be passed into rcs_commit when the file is ready
134         # for committing.
135         # The file is relative to the srcdir.
136         my $file=shift;
137         
138         # For subversion, return the revision of the file when
139         # editing begins.
140         my $rev=svn_info("Revision", "$config{srcdir}/$file");
141         return defined $rev ? $rev : "";
144 sub commitmessage (@) {
145         my %params=@_;
147         if (defined $params{session}) {
148                 if (defined $params{session}->param("name")) {
149                         return "web commit by ".
150                                 IkiWiki::cloak($params{session}->param("name")).
151                                 (length $params{message} ? ": $params{message}" : "");
152                 }
153                 elsif (defined $params{session}->remote_addr()) {
154                         return "web commit from ".
155                                 IkiWiki::cloak($params{session}->remote_addr()).
156                                 (length $params{message} ? ": $params{message}" : "");
157                 }
158         }
159         return $params{message};
162 sub rcs_commit (@) {
163         # Tries to commit the page; returns undef on _success_ and
164         # a version of the page with the rcs's conflict markers on failure.
165         # The file is relative to the srcdir.
166         my %params=@_;
168         # Check to see if the page has been changed by someone
169         # else since rcs_prepedit was called.
170         my ($oldrev)=$params{token}=~/^([0-9]+)$/; # untaint
171         my $rev=svn_info("Revision", "$config{srcdir}/$params{file}");
172         if (defined $rev && defined $oldrev && $rev != $oldrev) {
173                 # Merge their changes into the file that we've
174                 # changed.
175                 if (system("svn", "merge", "--quiet", "-r$oldrev:$rev",
176                            "$config{srcdir}/$params{file}", "$config{srcdir}/$params{file}") != 0) {
177                         warn("svn merge -r$oldrev:$rev failed\n");
178                 }
179         }
181         if (system("svn", "commit", "--quiet", 
182                    "--encoding", "UTF-8", "-m",
183                    IkiWiki::possibly_foolish_untaint(commitmessage(%params)),
184                    $config{srcdir}) != 0) {
185                 my $conflict=readfile("$config{srcdir}/$params{file}");
186                 if (system("svn", "revert", "--quiet", "$config{srcdir}/$params{file}") != 0) {
187                         warn("svn revert failed\n");
188                 }
189                 return $conflict;
190         }
192         return undef # success
195 sub rcs_commit_staged (@) {
196         # Commits all staged changes. Changes can be staged using rcs_add,
197         # rcs_remove, and rcs_rename.
198         my %params=@_;
199         
200         if (system("svn", "commit", "--quiet",
201                    "--encoding", "UTF-8", "-m",
202                    IkiWiki::possibly_foolish_untaint(commitmessage(%params)),
203                    $config{srcdir}) != 0) {
204                 warn("svn commit failed\n");
205                 return 1; # failure     
206         }
207         return undef # success
210 sub rcs_add ($) {
211         # filename is relative to the root of the srcdir
212         my $file=shift;
214         if (system("svn", "add", "--parents", "--quiet", "$config{srcdir}/$file") != 0) {
215                 warn("svn add failed\n");
216         }
219 sub rcs_remove ($) {
220         # filename is relative to the root of the srcdir
221         my $file=shift;
223         if (system("svn", "rm", "--force", "--quiet", "$config{srcdir}/$file") != 0) {
224                 warn("svn rm failed\n");
225         }
228 sub rcs_rename ($$) {
229         # filenames relative to the root of the srcdir
230         my ($src, $dest)=@_;
231         
232         if (system("svn", "mv", "--parents", "--force", "--quiet", 
233             "$config{srcdir}/$src", "$config{srcdir}/$dest") != 0) {
234                 warn("svn rename failed\n");
235         }
238 sub rcs_recentchanges ($) {
239         my $num=shift;
240         my @ret;
241         
242         eval q{
243                 use Date::Parse;
244                 use XML::SAX;
245                 use XML::Simple;
246         };
247         error($@) if $@;
249         # avoid using XML::SAX::PurePerl, it's buggy with UTF-8 data
250         my @parsers = map { ${$_}{Name} } @{XML::SAX->parsers()};
251         do {
252                 $XML::Simple::PREFERRED_PARSER = pop @parsers;
253         } until $XML::Simple::PREFERRED_PARSER ne 'XML::SAX::PurePerl';
255         # --limit is only supported on Subversion 1.2.0+
256         my $svn_version=`svn --version -q`;
257         my $svn_limit='';
258         $svn_limit="--limit $num"
259                 if $svn_version =~ /\d\.(\d)\.\d/ && $1 >= 2;
261         my $svn_url=svn_info("URL", $config{srcdir});
262         my $xml = XMLin(scalar `svn $svn_limit --xml -v log '$svn_url'`,
263                 ForceArray => [ 'logentry', 'path' ],
264                 GroupTags => { paths => 'path' },
265                 KeyAttr => { path => 'content' },
266         );
267         foreach my $logentry (@{$xml->{logentry}}) {
268                 my (@pages, @message);
270                 my $rev = $logentry->{revision};
271                 my $user = $logentry->{author};
273                 my $when=str2time($logentry->{date}, 'UTC');
275                 foreach my $msgline (split(/\n/, $logentry->{msg})) {
276                         push @message, { line => $msgline };
277                 }
279                 my $committype="web";
280                 if (defined $message[0] &&
281                     $message[0]->{line}=~/$config{web_commit_regexp}/) {
282                         $user=defined $2 ? "$2" : "$3";
283                         $message[0]->{line}=$4;
284                 }
285                 else {
286                         $committype="svn";
287                 }
289                 foreach my $file (keys %{$logentry->{paths}}) {
290                         if (length $config{svnpath}) {
291                                 next unless $file=~/^\/\Q$config{svnpath}\E\/([^ ]+)(?:$|\s)/;
292                                 $file=$1;
293                         }
295                         my $diffurl=defined $config{diffurl} ? $config{diffurl} : "";
296                         my $efile = uri_escape_utf8($file);
297                         $diffurl=~s/\[\[file\]\]/$efile/g;
298                         $diffurl=~s/\[\[r1\]\]/$rev - 1/eg;
299                         $diffurl=~s/\[\[r2\]\]/$rev/g;
301                         push @pages, {
302                                 page => pagename($file),
303                                 diffurl => $diffurl,
304                         } if length $file;
305                 }
306                 push @ret, {
307                         rev => $rev,
308                         user => $user,
309                         committype => $committype,
310                         when => $when,
311                         message => [@message],
312                         pages => [@pages],
313                 } if @pages;
314                 return @ret if @ret >= $num;
315         }
317         return @ret;
320 sub rcs_diff ($;$) {
321         my $rev=IkiWiki::possibly_foolish_untaint(int(shift));
322         my $maxlines=shift;
323         return `svnlook diff $config{svnrepo} -r$rev --no-diff-deleted`;
328 my ($lastfile, $lastmtime, $lastctime);
330 sub findtimes ($) {
331         my $file=shift;
333         if (defined $lastfile && $lastfile eq $file) {
334                 return $lastmtime, $lastctime;
335         }
336         $lastfile=$file;
338         my $svn_log_infoline=qr/^r\d+\s+\|\s+[^\s]+\s+\|\s+(\d+-\d+-\d+\s+\d+:\d+:\d+\s+[-+]?\d+).*/;
339                 
340         my $child = open(SVNLOG, "-|");
341         if (! $child) {
342                 exec("svn", "log", "$config{srcdir}/$file") || error("svn log failed to run");
343         }
345         my ($cdate, $mdate);
346         while (<SVNLOG>) {
347                 if (/$svn_log_infoline/) {
348                         $cdate=$1;
349                         $mdate=$1 unless defined $mdate;
350                 }
351         }
352         close SVNLOG || error "svn log exited $?";
354         if (! defined $cdate) {
355                 error "failed to parse svn log for $file";
356         }
357                 
358         eval q{use Date::Parse};
359         error($@) if $@;
360         
361         $lastctime=str2time($cdate);
362         $lastmtime=str2time($mdate);
363         return $lastmtime, $lastctime;
368 sub rcs_getctime ($) {
369         my $file=shift;
371         return (findtimes($file))[1];
374 sub rcs_getmtime ($) {
375         my $file=shift;
377         return (findtimes($file))[0];