7 use open qw{:utf8 :std};
11 sub mercurial_log($) {
19 if (/^description:/) {
23 # slurp everything as the description text
24 # until the next changeset
36 $infos[$#infos]{$key} = $value;
40 ($key, $value) = split /: +/, $line, 2;
42 if ($key eq "changeset") {
45 # remove the revision index, which is strictly
46 # local to the repository
50 $infos[$#infos]{$key} = $value;
57 sub rcs_update () { #{{{
58 my @cmdline = ("hg", "-q", "-R", "$config{srcdir}", "update");
59 if (system(@cmdline) != 0) {
60 warn "'@cmdline' failed: $!";
64 sub rcs_prepedit ($) { #{{{
68 sub rcs_commit ($$$;$$) { #{{{
69 my ($file, $message, $rcstoken, $user, $ipaddr) = @_;
72 $user = possibly_foolish_untaint($user);
74 elsif (defined $ipaddr) {
75 $user = "Anonymous from ".possibly_foolish_untaint($ipaddr);
81 $message = possibly_foolish_untaint($message);
82 if (! length $message) {
83 $message = "no message given";
86 my @cmdline = ("hg", "-q", "-R", $config{srcdir}, "commit",
87 "-m", $message, "-u", $user);
88 if (system(@cmdline) != 0) {
89 warn "'@cmdline' failed: $!";
92 return undef; # success
95 sub rcs_add ($) { # {{{
98 my @cmdline = ("hg", "-q", "-R", "$config{srcdir}", "add", "$config{srcdir}/$file");
99 if (system(@cmdline) != 0) {
100 warn "'@cmdline' failed: $!";
104 sub rcs_recentchanges ($) { #{{{
107 my @cmdline = ("hg", "-R", $config{srcdir}, "log", "-v", "-l", $num,
108 "--style", "default");
109 open (my $out, "@cmdline |");
111 eval q{use Date::Parse};
115 foreach my $info (mercurial_log($out)) {
119 foreach my $msgline (split(/\n/, $info->{description})) {
120 push @message, { line => $msgline };
123 foreach my $file (split / /,$info->{files}) {
124 my $diffurl = $config{'diffurl'};
125 $diffurl =~ s/\[\[file\]\]/$file/go;
126 $diffurl =~ s/\[\[r2\]\]/$info->{changeset}/go;
129 page => pagename($file),
134 my $user = $info->{"user"};
135 $user =~ s/\s*<.*>\s*$//;
139 rev => $info->{"changeset"},
141 committype => "mercurial",
142 when => str2time($info->{"date"}),
143 message => [@message],
151 sub rcs_diff ($) { #{{{
155 sub rcs_getctime ($) { #{{{
158 # XXX filename passes through the shell here, should try to avoid
160 my @cmdline = ("hg", "-R", $config{srcdir}, "log", "-v", "-l", '1',
161 "--style", "default", "$config{srcdir}/$file");
162 open (my $out, "@cmdline |");
164 my @log = mercurial_log($out);
166 if (length @log < 1) {
170 eval q{use Date::Parse};
173 my $ctime = str2time($log[0]->{"date"});