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