summaryrefslogtreecommitdiff
path: root/IkiWiki/Rcs/mercurial.pm
blob: 1bfcf624224c9532215247977795d4338745b5de (plain)
  1. #!/usr/bin/perl
  2. package IkiWiki;
  3. use warnings;
  4. use strict;
  5. use IkiWiki;
  6. use Encode;
  7. use open qw{:utf8 :std};
  8. sub mercurial_log($) {
  9. my $out = shift;
  10. my @infos;
  11. while (<$out>) {
  12. my $line = $_;
  13. my ($key, $value);
  14. if (/^description:/) {
  15. $key = "description";
  16. $value = "";
  17. # slurp everything as the description text
  18. # until the next changeset
  19. while (<$out>) {
  20. if (/^changeset: /) {
  21. $line = $_;
  22. last;
  23. }
  24. $value .= $_;
  25. }
  26. local $/ = "";
  27. chomp $value;
  28. $infos[$#infos]{$key} = $value;
  29. }
  30. chomp $line;
  31. ($key, $value) = split /: +/, $line, 2;
  32. if ($key eq "changeset") {
  33. push @infos, {};
  34. # remove the revision index, which is strictly
  35. # local to the repository
  36. $value =~ s/^\d+://;
  37. }
  38. $infos[$#infos]{$key} = $value;
  39. }
  40. close $out;
  41. return @infos;
  42. }
  43. sub rcs_update () { #{{{
  44. my @cmdline = ("hg", "-q", "-R", "$config{srcdir}", "update");
  45. if (system(@cmdline) != 0) {
  46. warn "'@cmdline' failed: $!";
  47. }
  48. } #}}}
  49. sub rcs_prepedit ($) { #{{{
  50. return "";
  51. } #}}}
  52. sub rcs_commit ($$$;$$) { #{{{
  53. my ($file, $message, $rcstoken, $user, $ipaddr) = @_;
  54. if (defined $user) {
  55. $user = possibly_foolish_untaint($user);
  56. }
  57. elsif (defined $ipaddr) {
  58. $user = "Anonymous from ".possibly_foolish_untaint($ipaddr);
  59. }
  60. else {
  61. $user = "Anonymous";
  62. }
  63. $message = possibly_foolish_untaint($message);
  64. if (! length $message) {
  65. $message = "no message given";
  66. }
  67. my @cmdline = ("hg", "-q", "-R", $config{srcdir}, "commit",
  68. "-m", $message, "-u", $user);
  69. if (system(@cmdline) != 0) {
  70. warn "'@cmdline' failed: $!";
  71. }
  72. return undef; # success
  73. } #}}}
  74. sub rcs_add ($) { # {{{
  75. my ($file) = @_;
  76. my @cmdline = ("hg", "-q", "-R", "$config{srcdir}", "add", "$config{srcdir}/$file");
  77. if (system(@cmdline) != 0) {
  78. warn "'@cmdline' failed: $!";
  79. }
  80. } #}}}
  81. sub rcs_remove ($) { # {{{
  82. my ($file) = @_;
  83. error("rcs_remove not implemented for mercurial"); # TODO
  84. } #}}}
  85. sub rcs_recentchanges ($) { #{{{
  86. my ($num) = @_;
  87. my @cmdline = ("hg", "-R", $config{srcdir}, "log", "-v", "-l", $num,
  88. "--style", "default");
  89. open (my $out, "@cmdline |");
  90. eval q{use Date::Parse};
  91. error($@) if $@;
  92. my @ret;
  93. foreach my $info (mercurial_log($out)) {
  94. my @pages = ();
  95. my @message = ();
  96. foreach my $msgline (split(/\n/, $info->{description})) {
  97. push @message, { line => $msgline };
  98. }
  99. foreach my $file (split / /,$info->{files}) {
  100. my $diffurl = $config{'diffurl'};
  101. $diffurl =~ s/\[\[file\]\]/$file/go;
  102. $diffurl =~ s/\[\[r2\]\]/$info->{changeset}/go;
  103. push @pages, {
  104. page => pagename($file),
  105. diffurl => $diffurl,
  106. };
  107. }
  108. my $user = $info->{"user"};
  109. $user =~ s/\s*<.*>\s*$//;
  110. $user =~ s/^\s*//;
  111. push @ret, {
  112. rev => $info->{"changeset"},
  113. user => $user,
  114. committype => "mercurial",
  115. when => str2time($info->{"date"}),
  116. message => [@message],
  117. pages => [@pages],
  118. };
  119. }
  120. return @ret;
  121. } #}}}
  122. sub rcs_diff ($) { #{{{
  123. # TODO
  124. } #}}}
  125. sub rcs_getctime ($) { #{{{
  126. my ($file) = @_;
  127. # XXX filename passes through the shell here, should try to avoid
  128. # that just in case
  129. my @cmdline = ("hg", "-R", $config{srcdir}, "log", "-v", "-l", '1',
  130. "--style", "default", "$config{srcdir}/$file");
  131. open (my $out, "@cmdline |");
  132. my @log = mercurial_log($out);
  133. if (length @log < 1) {
  134. return 0;
  135. }
  136. eval q{use Date::Parse};
  137. error($@) if $@;
  138. my $ctime = str2time($log[0]->{"date"});
  139. return $ctime;
  140. } #}}}
  141. 1