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