updates
[ikiwiki.git] / IkiWiki / Rcs / mercurial.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 mercurial_log($) {
12         my $out = shift;
13         my @infos;
14
15         while (<$out>) {
16                 my $line = $_;
17                 my ($key, $value);
18
19                 if (/^description:/) {
20                         $key = "description";
21                         $value = "";
22
23                         # slurp everything as the description text 
24                         # until the next changeset
25                         while (<$out>) {
26                                 if (/^changeset: /) {
27                                         $line = $_;
28                                         last;
29                                 }
30
31                                 $value .= $_;
32                         }
33
34                         local $/ = "";
35                         chomp $value;
36                         $infos[$#infos]{$key} = $value;
37                 }
38
39                 chomp $line;
40                 ($key, $value) = split /: +/, $line, 2;
41
42                 if ($key eq "changeset") {
43                         push @infos, {};
44
45                         # remove the revision index, which is strictly 
46                         # local to the repository
47                         $value =~ s/^\d+://;
48                 }
49
50                 $infos[$#infos]{$key} = $value;
51         }
52         close $out;
53
54         return @infos;
55 }
56
57 sub rcs_update () { #{{{
58         my @cmdline = ("hg", "-R", "$config{srcdir}", "update");
59         if (system(@cmdline) != 0) {
60                 warn "'@cmdline' failed: $!";
61         }
62 } #}}}
63
64 sub rcs_prepedit ($) { #{{{
65         return "";
66 } #}}}
67
68 sub rcs_commit ($$$) { #{{{
69         my ($file, $message, $rcstoken, $user, $ipaddr) = @_;
70
71         if (defined $user) {
72                 $message="web commit by $user".(length $message ? ": $message" : "");
73         }
74         elsif (defined $ipaddr) {
75                 $message="web commit from $ipaddr".(length $message ? ": $message" : "");
76         }
77
78         $message = possibly_foolish_untaint($message);
79
80         my @cmdline = ("hg", "-R", "$config{srcdir}", "commit", "-m", "$message");
81         if (system(@cmdline) != 0) {
82                 warn "'@cmdline' failed: $!";
83         }
84
85         return undef; # success
86 } #}}}
87
88 sub rcs_add ($) { # {{{
89         my ($file) = @_;
90
91         my @cmdline = ("hg", "-R", "$config{srcdir}", "add", "$file");
92         if (system(@cmdline) != 0) {
93                 warn "'@cmdline' failed: $!";
94         }
95 } #}}}
96
97 sub rcs_recentchanges ($) { #{{{
98         my ($num) = @_;
99
100         eval q{use CGI 'escapeHTML'};
101         error($@) if $@;
102
103         my @cmdline = ("hg", "-R", $config{srcdir}, "log", "-v", "-l", $num);
104         open (my $out, "@cmdline |");
105
106         my @ret;
107         foreach my $info (mercurial_log($out)) {
108                 my @pages = ();
109                 my @message = ();
110         
111                 foreach my $msgline (split(/\n/, $info->{description})) {
112                         push @message, { line => $msgline };
113                 }
114
115                 foreach my $file (split / /,$info->{files}) {
116                         my $diffurl = $config{'diffurl'};
117                         $diffurl =~ s/\[\[file\]\]/$file/go;
118                         $diffurl =~ s/\[\[r2\]\]/$info->{changeset}/go;
119
120                         push @pages, {
121                                 page => pagename($file),
122                                 diffurl => $diffurl,
123                         };
124                 }
125
126                 my $user = $info->{"user"};
127                 $user =~ s/\s*<.*>\s*$//;
128                 $user =~ s/^\s*//;
129
130                 push @ret, {
131                         rev        => $info->{"changeset"},
132                         user       => $user,
133                         committype => "mercurial",
134                         when       => $info->{"date"},
135                         message    => [@message],
136                         pages      => [@pages],
137                 };
138         }
139
140         return @ret;
141 } #}}}
142
143 sub rcs_notify () { #{{{
144         # TODO
145 } #}}}
146
147 sub rcs_getctime ($) { #{{{
148         error "getctime not implemented";
149 } #}}}
150
151 1