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) = @_;
  70
  71         $message = possibly_foolish_untaint($message);
  72
  73         my @cmdline = ("hg", "-R", "$config{srcdir}", "commit", "-m", "$message");
  74         if (system(@cmdline) != 0) {
  75                 warn "'@cmdline' failed: $!";
  76         }
  77
  78         return undef; # success
  79 } #}}}
  80
  81 sub rcs_add ($) { # {{{
  82         my ($file) = @_;
  83
  84         my @cmdline = ("hg", "-R", "$config{srcdir}", "add", "$file");
  85         if (system(@cmdline) != 0) {
  86                 warn "'@cmdline' failed: $!";
  87         }
  88 } #}}}
  89
  90 sub rcs_recentchanges ($) { #{{{
  91         my ($num) = @_;
  92
  93         eval q{use CGI 'escapeHTML'};
  94         error($@) if $@;
  95
  96         my @cmdline = ("hg", "-R", $config{srcdir}, "log", "-v", "-l", $num);
  97         open (my $out, "@cmdline |");
  98
  99         my @ret;
 100         foreach my $info (mercurial_log($out)) {
 101                 my @pages = ();
 102                 my @message = ();
 103
 104                 foreach my $msgline (split(/\n/, $info->{description})) {
 105                         push @message, { line => $msgline };
 106                 }
 107
 108                 foreach my $file (split / /,$info->{files}) {
 109                         my $diffurl = $config{'diffurl'};
 110                         $diffurl =~ s/\[\[file\]\]/$file/go;
 111                         $diffurl =~ s/\[\[r2\]\]/$info->{changeset}/go;
 112
 113                         push @pages, {
 114                                 page => pagename($file),
 115                                 diffurl => $diffurl,
 116                         };
 117                 }
 118
 119                 my $user = $info->{"user"};
 120                 $user =~ s/\s*<.*>\s*$//;
 121                 $user =~ s/^\s*//;
 122
 123                 push @ret, {
 124                         rev        => $info->{"changeset"},
 125                         user       => $user,
 126                         committype => "mercurial",
 127                         when       => $info->{"date"},
 128                         message    => [@message],
 129                         pages      => [@pages],
 130                 };
 131         }
 132
 133         return @ret;
 134 } #}}}
 135
 136 sub rcs_notify () { #{{{
 137         # TODO
 138 } #}}}
 139
 140 sub rcs_getctime ($) { #{{{
 141         error "getctime not implemented";
 142 } #}}}
 143
 144 1