9 use open qw{:utf8 :std};
11 hook(type => "getsetup", id => "bzr", call => sub { #{{{
16 #example => "", # FIXME add example
17 description => "url to show file history, using loggerhead ([[file]] substituted)",
24 example => "http://example.com/revision?start_revid=[[r2]]#[[file]]-s",
25 description => "url to view a diff, using loggerhead ([[file]] and [[r2]] substituted)",
31 sub bzr_log ($) { #{{{
39 if ($line =~ /^message:/) {
41 $infos[$#infos]{$key} = "";
43 elsif ($line =~ /^(modified|added|renamed|renamed and modified|removed):/) {
45 unless (defined($infos[$#infos]{$key})) { $infos[$#infos]{$key} = ""; }
47 elsif (defined($key) and $line =~ /^ (.*)/) {
48 $infos[$#infos]{$key} .= "$1\n";
50 elsif ($line eq "------------------------------------------------------------\n") {
56 ($key, $value) = split /: +/, $line, 2;
57 $infos[$#infos]{$key} = $value;
65 sub rcs_update () { #{{{
66 my @cmdline = ("bzr", "update", "--quiet", $config{srcdir});
67 if (system(@cmdline) != 0) {
68 warn "'@cmdline' failed: $!";
72 sub rcs_prepedit ($) { #{{{
76 sub bzr_author ($$) { #{{{
77 my ($user, $ipaddr) = @_;
80 return possibly_foolish_untaint($user);
82 elsif (defined $ipaddr) {
83 return "Anonymous from ".possibly_foolish_untaint($ipaddr);
90 sub rcs_commit ($$$;$$) { #{{{
91 my ($file, $message, $rcstoken, $user, $ipaddr) = @_;
93 $user = bzr_author($user, $ipaddr);
95 $message = possibly_foolish_untaint($message);
96 if (! length $message) {
97 $message = "no message given";
100 my @cmdline = ("bzr", "commit", "--quiet", "-m", $message, "--author", $user,
101 $config{srcdir}."/".$file);
102 if (system(@cmdline) != 0) {
103 warn "'@cmdline' failed: $!";
106 return undef; # success
109 sub rcs_commit_staged ($$$) {
110 # Commits all staged changes. Changes can be staged using rcs_add,
111 # rcs_remove, and rcs_rename.
112 my ($message, $user, $ipaddr)=@_;
114 $user = bzr_author($user, $ipaddr);
116 $message = possibly_foolish_untaint($message);
117 if (! length $message) {
118 $message = "no message given";
121 my @cmdline = ("bzr", "commit", "--quiet", "-m", $message, "--author", $user,
123 if (system(@cmdline) != 0) {
124 warn "'@cmdline' failed: $!";
127 return undef; # success
130 sub rcs_add ($) { # {{{
133 my @cmdline = ("bzr", "add", "--quiet", "$config{srcdir}/$file");
134 if (system(@cmdline) != 0) {
135 warn "'@cmdline' failed: $!";
139 sub rcs_remove ($) { # {{{
142 my @cmdline = ("bzr", "rm", "--force", "--quiet", "$config{srcdir}/$file");
143 if (system(@cmdline) != 0) {
144 warn "'@cmdline' failed: $!";
148 sub rcs_rename ($$) { # {{{
149 my ($src, $dest) = @_;
151 my $parent = dirname($dest);
152 if (system("bzr", "add", "--quiet", "$config{srcdir}/$parent") != 0) {
153 warn("bzr add $parent failed\n");
156 my @cmdline = ("bzr", "mv", "--quiet", "$config{srcdir}/$src", "$config{srcdir}/$dest");
157 if (system(@cmdline) != 0) {
158 warn "'@cmdline' failed: $!";
162 sub rcs_recentchanges ($) { #{{{
165 my @cmdline = ("bzr", "log", "-v", "--show-ids", "--limit", $num,
167 open (my $out, "@cmdline |");
169 eval q{use Date::Parse};
173 foreach my $info (bzr_log($out)) {
177 foreach my $msgline (split(/\n/, $info->{message})) {
178 push @message, { line => $msgline };
181 foreach my $file (split(/\n/, $info->{files})) {
182 my ($filename, $fileid) = ($file =~ /^(.*?) +([^ ]+)$/);
185 next if ($filename =~ /\/$/);
187 # Skip source name in renames
188 $filename =~ s/^.* => //;
190 my $diffurl = $config{'diffurl'};
191 $diffurl =~ s/\[\[file\]\]/$filename/go;
192 $diffurl =~ s/\[\[file-id\]\]/$fileid/go;
193 $diffurl =~ s/\[\[r2\]\]/$info->{revno}/go;
196 page => pagename($filename),
201 my $user = $info->{"committer"};
202 if (defined($info->{"author"})) { $user = $info->{"author"}; }
203 $user =~ s/\s*<.*>\s*$//;
207 rev => $info->{"revno"},
210 when => time - str2time($info->{"timestamp"}),
211 message => [@message],
219 sub rcs_getctime ($) { #{{{
222 # XXX filename passes through the shell here, should try to avoid
224 my @cmdline = ("bzr", "log", "--limit", '1', "$config{srcdir}/$file");
225 open (my $out, "@cmdline |");
227 my @log = bzr_log($out);
229 if (length @log < 1) {
233 eval q{use Date::Parse};
236 my $ctime = str2time($log[0]->{"timestamp"});