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