9 use open qw{:utf8 :std};
11 sub bzr_log ($) { #{{{
19 if ($line =~ /^message:/) {
21 $infos[$#infos]{$key} = "";
23 elsif ($line =~ /^(modified|added|renamed|renamed and modified|removed):/) {
25 unless (defined($infos[$#infos]{$key})) { $infos[$#infos]{$key} = ""; }
27 elsif (defined($key) and $line =~ /^ (.*)/) {
28 $infos[$#infos]{$key} .= $1;
30 elsif ($line eq "------------------------------------------------------------\n") {
36 ($key, $value) = split /: +/, $line, 2;
37 $infos[$#infos]{$key} = $value;
45 sub rcs_update () { #{{{
46 my @cmdline = ("bzr", "update", "--quiet", $config{srcdir});
47 if (system(@cmdline) != 0) {
48 warn "'@cmdline' failed: $!";
52 sub rcs_prepedit ($) { #{{{
56 sub bzr_author ($$) { #{{{
57 my ($user, $ipaddr) = @_;
60 return possibly_foolish_untaint($user);
62 elsif (defined $ipaddr) {
63 return "Anonymous from ".possibly_foolish_untaint($ipaddr);
70 sub rcs_commit ($$$;$$) { #{{{
71 my ($file, $message, $rcstoken, $user, $ipaddr) = @_;
73 $user = bzr_author($user, $ipaddr);
75 $message = possibly_foolish_untaint($message);
76 if (! length $message) {
77 $message = "no message given";
80 my @cmdline = ("bzr", "commit", "--quiet", "-m", $message, "--author", $user,
81 $config{srcdir}."/".$file);
82 if (system(@cmdline) != 0) {
83 warn "'@cmdline' failed: $!";
86 return undef; # success
89 sub rcs_commit_staged ($$$) {
90 # Commits all staged changes. Changes can be staged using rcs_add,
91 # rcs_remove, and rcs_rename.
92 my ($message, $user, $ipaddr)=@_;
94 $user = bzr_author($user, $ipaddr);
96 $message = possibly_foolish_untaint($message);
97 if (! length $message) {
98 $message = "no message given";
101 my @cmdline = ("bzr", "commit", "--quiet", "-m", $message, "--author", $user,
103 if (system(@cmdline) != 0) {
104 warn "'@cmdline' failed: $!";
107 return undef; # success
110 sub rcs_add ($) { # {{{
113 my @cmdline = ("bzr", "add", "--quiet", "$config{srcdir}/$file");
114 if (system(@cmdline) != 0) {
115 warn "'@cmdline' failed: $!";
119 sub rcs_remove ($) { # {{{
122 my @cmdline = ("bzr", "rm", "--force", "--quiet", "$config{srcdir}/$file");
123 if (system(@cmdline) != 0) {
124 warn "'@cmdline' failed: $!";
128 sub rcs_rename ($$) { # {{{
129 my ($src, $dest) = @_;
131 my @cmdline = ("bzr", "mv", "--quiet", "$config{srcdir}/$src", "$config{srcdir}/$dest");
132 if (system(@cmdline) != 0) {
133 warn "'@cmdline' failed: $!";
137 sub rcs_recentchanges ($) { #{{{
140 my @cmdline = ("bzr", "log", "-v", "--show-ids", "--limit", $num,
142 open (my $out, "@cmdline |");
144 eval q{use Date::Parse};
148 foreach my $info (bzr_log($out)) {
152 foreach my $msgline (split(/\n/, $info->{message})) {
153 push @message, { line => $msgline };
156 foreach my $file (split(/\n/, $info->{files})) {
157 my ($filename, $fileid) = split(/[ \t]+/, $file);
158 my $diffurl = $config{'diffurl'};
159 $diffurl =~ s/\[\[file\]\]/$filename/go;
160 $diffurl =~ s/\[\[file-id\]\]/$fileid/go;
161 $diffurl =~ s/\[\[r2\]\]/$info->{revno}/go;
164 page => pagename($filename),
169 my $user = $info->{"committer"};
170 if (defined($info->{"author"})) { $user = $info->{"author"}; }
171 $user =~ s/\s*<.*>\s*$//;
175 rev => $info->{"revno"},
178 when => time - str2time($info->{"timestamp"}),
179 message => [@message],
187 sub rcs_getctime ($) { #{{{
190 # XXX filename passes through the shell here, should try to avoid
192 my @cmdline = ("bzr", "log", "--limit", '1', "$config{srcdir}/$file");
193 open (my $out, "@cmdline |");
195 my @log = bzr_log($out);
197 if (length @log < 1) {
201 eval q{use Date::Parse};
204 my $ctime = str2time($log[0]->{"timestamp"});