9 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_remove ($) { # {{{
107 error("rcs_remove not implemented for mercurial"); # TODO
110 sub rcs_recentchanges ($) { #{{{
113 my @cmdline = ("hg", "-R", $config{srcdir}, "log", "-v", "-l", $num,
114 "--style", "default");
115 open (my $out, "@cmdline |");
117 eval q{use Date::Parse};
121 foreach my $info (mercurial_log($out)) {
125 foreach my $msgline (split(/\n/, $info->{description})) {
126 push @message, { line => $msgline };
129 foreach my $file (split / /,$info->{files}) {
130 my $diffurl = $config{'diffurl'};
131 $diffurl =~ s/\[\[file\]\]/$file/go;
132 $diffurl =~ s/\[\[r2\]\]/$info->{changeset}/go;
135 page => pagename($file),
140 my $user = $info->{"user"};
141 $user =~ s/\s*<.*>\s*$//;
145 rev => $info->{"changeset"},
147 committype => "mercurial",
148 when => str2time($info->{"date"}),
149 message => [@message],
157 sub rcs_diff ($) { #{{{
161 sub rcs_getctime ($) { #{{{
164 # XXX filename passes through the shell here, should try to avoid
166 my @cmdline = ("hg", "-R", $config{srcdir}, "log", "-v", "-l", '1',
167 "--style", "default", "$config{srcdir}/$file");
168 open (my $out, "@cmdline |");
170 my @log = mercurial_log($out);
172 if (length @log < 1) {
176 eval q{use Date::Parse};
179 my $ctime = str2time($log[0]->{"date"});