2 package IkiWiki::Plugin::bzr;
8 use open qw{:utf8 :std};
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);
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"),
37 safe => 0, # rcs plugin
43 #example => "", # FIXME add example
44 description => "bzr post-commit hook to generate",
51 description => "mode for bzr_wrapper (can safely be made suid)",
57 #example => "", # FIXME add example
58 description => "url to show file history, using loggerhead ([[file]] substituted)",
64 example => "http://example.com/revision?start_revid=[[r2]]#[[file]]-s",
65 description => "url to view a diff, using loggerhead ([[file]] and [[r2]] substituted)",
80 if ($line =~ /^message:/) {
84 elsif ($line =~ /^(modified|added|renamed|renamed and modified|removed):/) {
86 unless (defined($$hash{$key})) { $$hash{$key} = ""; }
88 elsif (defined($key) and $line =~ /^ (.*)/) {
89 $$hash{$key} .= "$1\n";
91 elsif ($line eq "------------------------------------------------------------\n") {
98 elsif ($line =~ /: /) {
100 if ($line =~ /^revno: (\d+)/) {
104 ($key, $value) = split /: +/, $line, 2;
106 $$hash{$key} = $value;
115 my @cmdline = ("bzr", "update", "--quiet", $config{srcdir});
116 if (system(@cmdline) != 0) {
117 warn "'@cmdline' failed: $!";
121 sub rcs_prepedit ($) {
125 sub bzr_author ($$) {
126 my ($user, $ipaddr) = @_;
129 return IkiWiki::possibly_foolish_untaint($user);
131 elsif (defined $ipaddr) {
132 return "Anonymous from ".IkiWiki::possibly_foolish_untaint($ipaddr);
139 sub rcs_commit ($$$;$$) {
140 my ($file, $message, $rcstoken, $user, $ipaddr) = @_;
142 $user = bzr_author($user, $ipaddr);
144 $message = IkiWiki::possibly_foolish_untaint($message);
145 if (! length $message) {
146 $message = "no message given";
149 my @cmdline = ("bzr", "commit", "--quiet", "-m", $message, "--author", $user,
150 $config{srcdir}."/".$file);
151 if (system(@cmdline) != 0) {
152 warn "'@cmdline' failed: $!";
155 return undef; # success
158 sub rcs_commit_staged ($$$) {
159 # Commits all staged changes. Changes can be staged using rcs_add,
160 # rcs_remove, and rcs_rename.
161 my ($message, $user, $ipaddr)=@_;
163 $user = bzr_author($user, $ipaddr);
165 $message = IkiWiki::possibly_foolish_untaint($message);
166 if (! length $message) {
167 $message = "no message given";
170 my @cmdline = ("bzr", "commit", "--quiet", "-m", $message, "--author", $user,
172 if (system(@cmdline) != 0) {
173 warn "'@cmdline' failed: $!";
176 return undef; # success
182 my @cmdline = ("bzr", "add", "--quiet", "$config{srcdir}/$file");
183 if (system(@cmdline) != 0) {
184 warn "'@cmdline' failed: $!";
191 my @cmdline = ("bzr", "rm", "--force", "--quiet", "$config{srcdir}/$file");
192 if (system(@cmdline) != 0) {
193 warn "'@cmdline' failed: $!";
197 sub rcs_rename ($$) {
198 my ($src, $dest) = @_;
200 my $parent = IkiWiki::dirname($dest);
201 if (system("bzr", "add", "--quiet", "$config{srcdir}/$parent") != 0) {
202 warn("bzr add $parent failed\n");
205 my @cmdline = ("bzr", "mv", "--quiet", "$config{srcdir}/$src", "$config{srcdir}/$dest");
206 if (system(@cmdline) != 0) {
207 warn "'@cmdline' failed: $!";
211 sub rcs_recentchanges ($) {
214 my @cmdline = ("bzr", "log", "-v", "--show-ids", "--limit", $num,
216 open (my $out, "@cmdline |");
218 eval q{use Date::Parse};
222 foreach my $info (bzr_log($out)) {
226 foreach my $msgline (split(/\n/, $info->{message})) {
227 push @message, { line => $msgline };
230 foreach my $file (split(/\n/, $info->{files})) {
231 my ($filename, $fileid) = ($file =~ /^(.*?) +([^ ]+)$/);
234 next if ($filename =~ /\/$/);
236 # Skip source name in renames
237 $filename =~ s/^.* => //;
239 my $diffurl = defined $config{'diffurl'} ? $config{'diffurl'} : "";
240 $diffurl =~ s/\[\[file\]\]/$filename/go;
241 $diffurl =~ s/\[\[file-id\]\]/$fileid/go;
242 $diffurl =~ s/\[\[r2\]\]/$info->{revno}/go;
245 page => pagename($filename),
250 my $user = $info->{"committer"};
251 if (defined($info->{"author"})) { $user = $info->{"author"}; }
252 $user =~ s/\s*<.*>\s*$//;
256 rev => $info->{"revno"},
259 when => str2time($info->{"timestamp"}),
260 message => [@message],
269 my $taintedrev=shift;
270 my ($rev) = $taintedrev =~ /^(\d+(\.\d+)*)$/; # untaint
272 my $prevspec = "before:" . $rev;
273 my $revspec = "revno:" . $rev;
274 my @cmdline = ("bzr", "diff", "--old", $config{srcdir},
275 "--new", $config{srcdir},
276 "-r", $prevspec . ".." . $revspec);
277 open (my $out, "@cmdline |");
284 return join("", @lines);
288 sub rcs_getctime ($) {
291 # XXX filename passes through the shell here, should try to avoid
293 my @cmdline = ("bzr", "log", "--limit", '1', "$config{srcdir}/$file");
294 open (my $out, "@cmdline |");
296 my @log = bzr_log($out);
298 if (length @log < 1) {
302 eval q{use Date::Parse};
305 my $ctime = str2time($log[0]->{"timestamp"});