add news item for ikiwiki 2.31.2
[ikiwiki.git] / IkiWiki / Rcs / bzr.pm
1 #!/usr/bin/perl
2
3 use warnings;
4 use strict;
5 use IkiWiki;
6 use Encode;
7 use open qw{:utf8 :std};
8
9 package IkiWiki;
10
11 sub bzr_log ($) { #{{{
12         my $out = shift;
13         my @infos = ();
14         my $key = undef;
15
16         while (<$out>) {
17                 my $line = $_;
18                 my ($value);
19                 if ($line =~ /^message:/) {
20                         $key = "message";
21                         $infos[$#infos]{$key} = "";
22                 }
23                 elsif ($line =~ /^(modified|added|renamed|renamed and modified|removed):/) {
24                         $key = "files";
25                         unless (defined($infos[$#infos]{$key})) { $infos[$#infos]{$key} = ""; }
26                 }
27                 elsif (defined($key) and $line =~ /^  (.*)/) {
28                         $infos[$#infos]{$key} .= $1;
29                 }
30                 elsif ($line eq "------------------------------------------------------------\n") {
31                         $key = undef;
32                         push (@infos, {});
33                 }
34                 else {
35                         chomp $line;
36                                 ($key, $value) = split /: +/, $line, 2;
37                         $infos[$#infos]{$key} = $value;
38                 } 
39         }
40         close $out;
41
42         return @infos;
43 } #}}}
44
45 sub rcs_update () { #{{{
46         my @cmdline = ("bzr", $config{srcdir}, "update");
47         if (system(@cmdline) != 0) {
48                 warn "'@cmdline' failed: $!";
49         }
50 } #}}}
51
52 sub rcs_prepedit ($) { #{{{
53         return "";
54 } #}}}
55
56 sub rcs_commit ($$$;$$) { #{{{
57         my ($file, $message, $rcstoken, $user, $ipaddr) = @_;
58
59         if (defined $user) {
60                 $user = possibly_foolish_untaint($user);
61         }
62         elsif (defined $ipaddr) {
63                 $user = "Anonymous from ".possibly_foolish_untaint($ipaddr);
64         }
65         else {
66                 $user = "Anonymous";
67         }
68
69         $message = possibly_foolish_untaint($message);
70         if (! length $message) {
71                 $message = "no message given";
72         }
73
74         my @cmdline = ("bzr", "commit", "-m", $message, "--author", $user,
75                        $config{srcdir}."/".$file);
76         if (system(@cmdline) != 0) {
77                 warn "'@cmdline' failed: $!";
78         }
79
80         return undef; # success
81 } #}}}
82
83 sub rcs_add ($) { # {{{
84         my ($file) = @_;
85
86         my @cmdline = ("bzr", "add", "$config{srcdir}/$file");
87         if (system(@cmdline) != 0) {
88                 warn "'@cmdline' failed: $!";
89         }
90 } #}}}
91
92 sub rcs_recentchanges ($) { #{{{
93         my ($num) = @_;
94
95         eval q{use CGI 'escapeHTML'};
96         error($@) if $@;
97
98         my @cmdline = ("bzr", "log", "-v", "--show-ids", "--limit", $num, 
99                            $config{srcdir});
100         open (my $out, "@cmdline |");
101
102         eval q{use Date::Parse};
103         error($@) if $@;
104
105         my @ret;
106         foreach my $info (bzr_log($out)) {
107                 my @pages = ();
108                 my @message = ();
109         
110                 foreach my $msgline (split(/\n/, $info->{message})) {
111                         push @message, { line => $msgline };
112                 }
113
114                 foreach my $file (split(/\n/, $info->{files})) {
115                         my ($filename, $fileid) = split(/[ \t]+/, $file);
116                         my $diffurl = $config{'diffurl'};
117                         $diffurl =~ s/\[\[file\]\]/$filename/go;
118                         $diffurl =~ s/\[\[file-id\]\]/$fileid/go;
119                         $diffurl =~ s/\[\[r2\]\]/$info->{revno}/go;
120
121                         push @pages, {
122                                 page => pagename($filename),
123                                 diffurl => $diffurl,
124                         };
125                 }
126
127                 my $user = $info->{"committer"};
128                 if (defined($info->{"author"})) { $user = $info->{"author"}; }
129                 $user =~ s/\s*<.*>\s*$//;
130                 $user =~ s/^\s*//;
131
132                 push @ret, {
133                         rev        => $info->{"revno"},
134                         user       => $user,
135                         committype => "bzr",
136                         when       => time - str2time($info->{"timestamp"}),
137                         message    => [@message],
138                         pages      => [@pages],
139                 };
140         }
141
142         return @ret;
143 } #}}}
144
145 sub rcs_getctime ($) { #{{{
146         my ($file) = @_;
147
148         # XXX filename passes through the shell here, should try to avoid
149         # that just in case
150         my @cmdline = ("bzr", "log", "--limit", '1', "$config{srcdir}/$file");
151         open (my $out, "@cmdline |");
152
153         my @log = bzr_log($out);
154
155         if (length @log < 1) {
156                 return 0;
157         }
158
159         eval q{use Date::Parse};
160         error($@) if $@;
161         
162         my $ctime = str2time($log[0]->{"timestamp"});
163         return $ctime;
164 } #}}}
165
166 1