Merge branch 'master' into autoconfig
[ikiwiki.git] / IkiWiki / Plugin / bzr.pm
1 #!/usr/bin/perl
2 package IkiWiki::Plugin::bzr;
3
4 use warnings;
5 use strict;
6 use IkiWiki;
7 use Encode;
8 use open qw{:utf8 :std};
9
10 sub import { #{{{
11         hook(type => "checkconfig", id => "bzr", call => \&checkconfig);
12         hook(type => "getsetup", id => "bzr", 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 } #}}}
24
25 sub checkconfig () { #{{{
26         if (! defined $config{diffurl}) {
27                 $config{diffurl}="";
28         }
29         if (defined $config{bzr_wrapper} && length $config{bzr_wrapper}) {
30                 push @{$config{wrappers}}, {
31                         wrapper => $config{bzr_wrapper},
32                         wrappermode => (defined $config{bzr_wrappermode} ? $config{bzr_wrappermode} : "06755"),
33                 };
34         }
35 } #}}}
36
37 sub getsetup () { #{{{
38         return
39                 bzr_wrapper => {
40                         type => "string",
41                         #example => "", # FIXME add example
42                         description => "bzr post-commit executable to generate",
43                         safe => 0, # file
44                         rebuild => 0,
45                 },
46                 bzr_wrappermode => {
47                         type => "string",
48                         example => '06755',
49                         description => "mode for bzr_wrapper (can safely be made suid)",
50                         safe => 0,
51                         rebuild => 0,
52                 },
53                 historyurl => {
54                         type => "string",
55                         #example => "", # FIXME add example
56                         description => "url to show file history, using loggerhead ([[file]] substituted)",
57                         safe => 1,
58                         rebuild => 1,
59                 },
60                 diffurl => {
61                         type => "string",
62                         example => "http://example.com/revision?start_revid=[[r2]]#[[file]]-s",
63                         description => "url to view a diff, using loggerhead ([[file]] and [[r2]] substituted)",
64                         safe => 1,
65                         rebuild => 1,
66                 },
67 } #}}}
68
69 sub bzr_log ($) { #{{{
70         my $out = shift;
71         my @infos = ();
72         my $key = undef;
73
74         while (<$out>) {
75                 my $line = $_;
76                 my ($value);
77                 if ($line =~ /^message:/) {
78                         $key = "message";
79                         $infos[$#infos]{$key} = "";
80                 }
81                 elsif ($line =~ /^(modified|added|renamed|renamed and modified|removed):/) {
82                         $key = "files";
83                         unless (defined($infos[$#infos]{$key})) { $infos[$#infos]{$key} = ""; }
84                 }
85                 elsif (defined($key) and $line =~ /^  (.*)/) {
86                         $infos[$#infos]{$key} .= "$1\n";
87                 }
88                 elsif ($line eq "------------------------------------------------------------\n") {
89                         $key = undef;
90                         push (@infos, {});
91                 }
92                 else {
93                         chomp $line;
94                                 ($key, $value) = split /: +/, $line, 2;
95                         $infos[$#infos]{$key} = $value;
96                 } 
97         }
98         close $out;
99
100         return @infos;
101 } #}}}
102
103 sub rcs_update () { #{{{
104         my @cmdline = ("bzr", "update", "--quiet", $config{srcdir});
105         if (system(@cmdline) != 0) {
106                 warn "'@cmdline' failed: $!";
107         }
108 } #}}}
109
110 sub rcs_prepedit ($) { #{{{
111         return "";
112 } #}}}
113
114 sub bzr_author ($$) { #{{{
115         my ($user, $ipaddr) = @_;
116
117         if (defined $user) {
118                 return IkiWiki::possibly_foolish_untaint($user);
119         }
120         elsif (defined $ipaddr) {
121                 return "Anonymous from ".IkiWiki::possibly_foolish_untaint($ipaddr);
122         }
123         else {
124                 return "Anonymous";
125         }
126 } #}}}
127
128 sub rcs_commit ($$$;$$) { #{{{
129         my ($file, $message, $rcstoken, $user, $ipaddr) = @_;
130
131         $user = bzr_author($user, $ipaddr);
132
133         $message = IkiWiki::possibly_foolish_untaint($message);
134         if (! length $message) {
135                 $message = "no message given";
136         }
137
138         my @cmdline = ("bzr", "commit", "--quiet", "-m", $message, "--author", $user,
139                        $config{srcdir}."/".$file);
140         if (system(@cmdline) != 0) {
141                 warn "'@cmdline' failed: $!";
142         }
143
144         return undef; # success
145 } #}}}
146
147 sub rcs_commit_staged ($$$) {
148         # Commits all staged changes. Changes can be staged using rcs_add,
149         # rcs_remove, and rcs_rename.
150         my ($message, $user, $ipaddr)=@_;
151
152         $user = bzr_author($user, $ipaddr);
153
154         $message = IkiWiki::possibly_foolish_untaint($message);
155         if (! length $message) {
156                 $message = "no message given";
157         }
158
159         my @cmdline = ("bzr", "commit", "--quiet", "-m", $message, "--author", $user,
160                        $config{srcdir});
161         if (system(@cmdline) != 0) {
162                 warn "'@cmdline' failed: $!";
163         }
164
165         return undef; # success
166 } #}}}
167
168 sub rcs_add ($) { # {{{
169         my ($file) = @_;
170
171         my @cmdline = ("bzr", "add", "--quiet", "$config{srcdir}/$file");
172         if (system(@cmdline) != 0) {
173                 warn "'@cmdline' failed: $!";
174         }
175 } #}}}
176
177 sub rcs_remove ($) { # {{{
178         my ($file) = @_;
179
180         my @cmdline = ("bzr", "rm", "--force", "--quiet", "$config{srcdir}/$file");
181         if (system(@cmdline) != 0) {
182                 warn "'@cmdline' failed: $!";
183         }
184 } #}}}
185
186 sub rcs_rename ($$) { # {{{
187         my ($src, $dest) = @_;
188
189         my $parent = IkiWiki::dirname($dest);
190         if (system("bzr", "add", "--quiet", "$config{srcdir}/$parent") != 0) {
191                 warn("bzr add $parent failed\n");
192         }
193
194         my @cmdline = ("bzr", "mv", "--quiet", "$config{srcdir}/$src", "$config{srcdir}/$dest");
195         if (system(@cmdline) != 0) {
196                 warn "'@cmdline' failed: $!";
197         }
198 } #}}}
199
200 sub rcs_recentchanges ($) { #{{{
201         my ($num) = @_;
202
203         my @cmdline = ("bzr", "log", "-v", "--show-ids", "--limit", $num, 
204                            $config{srcdir});
205         open (my $out, "@cmdline |");
206
207         eval q{use Date::Parse};
208         error($@) if $@;
209
210         my @ret;
211         foreach my $info (bzr_log($out)) {
212                 my @pages = ();
213                 my @message = ();
214         
215                 foreach my $msgline (split(/\n/, $info->{message})) {
216                         push @message, { line => $msgline };
217                 }
218
219                 foreach my $file (split(/\n/, $info->{files})) {
220                         my ($filename, $fileid) = ($file =~ /^(.*?) +([^ ]+)$/);
221
222                         # Skip directories
223                         next if ($filename =~ /\/$/);
224
225                         # Skip source name in renames
226                         $filename =~ s/^.* => //;
227
228                         my $diffurl = $config{'diffurl'};
229                         $diffurl =~ s/\[\[file\]\]/$filename/go;
230                         $diffurl =~ s/\[\[file-id\]\]/$fileid/go;
231                         $diffurl =~ s/\[\[r2\]\]/$info->{revno}/go;
232
233                         push @pages, {
234                                 page => pagename($filename),
235                                 diffurl => $diffurl,
236                         };
237                 }
238
239                 my $user = $info->{"committer"};
240                 if (defined($info->{"author"})) { $user = $info->{"author"}; }
241                 $user =~ s/\s*<.*>\s*$//;
242                 $user =~ s/^\s*//;
243
244                 push @ret, {
245                         rev        => $info->{"revno"},
246                         user       => $user,
247                         committype => "bzr",
248                         when       => time - str2time($info->{"timestamp"}),
249                         message    => [@message],
250                         pages      => [@pages],
251                 };
252         }
253
254         return @ret;
255 } #}}}
256
257 sub rcs_getctime ($) { #{{{
258         my ($file) = @_;
259
260         # XXX filename passes through the shell here, should try to avoid
261         # that just in case
262         my @cmdline = ("bzr", "log", "--limit", '1', "$config{srcdir}/$file");
263         open (my $out, "@cmdline |");
264
265         my @log = bzr_log($out);
266
267         if (length @log < 1) {
268                 return 0;
269         }
270
271         eval q{use Date::Parse};
272         error($@) if $@;
273         
274         my $ctime = str2time($log[0]->{"timestamp"});
275         return $ctime;
276 } #}}}
277
278 1