git.oblomov.eu Git - ikiwiki/blob - IkiWiki/Rcs/bazaar.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 bazaar_log($) {
  12         my $out = shift;
  13         my @infos = ();
  14         my $key = undef;
  15
  16         while (<$out>) {
  17                 my $line = $_;
  18                 my ($value);
  19                 if ($line =~ /^message:/) {
  20                         $key = "message";
  21                         $infos[$#infos]{$key} = "";
  22                 } elsif ($line =~ /^(modified|added|renamed|renamed and modified|removed):/) {
  23                         $key = "files";
  24                         unless (defined($infos[$#infos]{$key})) { $infos[$#infos]{$key} = ""; }
  25                 } elsif (defined($key) and $line =~ /^  (.*)/) {
  26                         $infos[$#infos]{$key} .= $1;
  27                 } elsif ($line eq "------------------------------------------------------------\n") {
  28                         $key = undef;
  29                         push (@infos, {});
  30                 } else {
  31                         chomp $line;
  32                                 ($key, $value) = split /: +/, $line, 2;
  33                         $infos[$#infos]{$key} = $value;
  34                 }
  35         }
  36         close $out;
  37
  38         return @infos;
  39 }
  40
  41 sub rcs_update () { #{{{
  42         my @cmdline = ("bzr", "$config{srcdir}", "update");
  43         if (system(@cmdline) != 0) {
  44                 warn "'@cmdline' failed: $!";
  45         }
  46 } #}}}
  47
  48 sub rcs_prepedit ($) { #{{{
  49         return "";
  50 } #}}}
  51
  52 sub rcs_commit ($$$;$$) { #{{{
  53         my ($file, $message, $rcstoken, $user, $ipaddr) = @_;
  54
  55         if (defined $user) {
  56                 $user = possibly_foolish_untaint($user);
  57         }
  58         elsif (defined $ipaddr) {
  59                 $user = "Anonymous from ".possibly_foolish_untaint($ipaddr);
  60         }
  61         else {
  62                 $user = "Anonymous";
  63         }
  64
  65         $message = possibly_foolish_untaint($message);
  66         if (! length $message) {
  67                 $message = "no message given";
  68         }
  69
  70         my @cmdline = ("bzr", "commit",
  71                        "-m", $message, "--author", $user, $config{srcdir});
  72         if (system(@cmdline) != 0) {
  73                 warn "'@cmdline' failed: $!";
  74         }
  75
  76         return undef; # success
  77 } #}}}
  78
  79 sub rcs_add ($) { # {{{
  80         my ($file) = @_;
  81
  82         my @cmdline = ("bzr", "add", "$config{srcdir}/$file");
  83         if (system(@cmdline) != 0) {
  84                 warn "'@cmdline' failed: $!";
  85         }
  86 } #}}}
  87
  88 sub rcs_recentchanges ($) { #{{{
  89         my ($num) = @_;
  90
  91         eval q{use CGI 'escapeHTML'};
  92         error($@) if $@;
  93
  94         my @cmdline = ("bzr", "log", "-v", "--limit", $num, $config{srcdir});
  95         open (my $out, "@cmdline |");
  96
  97         eval q{use Date::Parse};
  98         error($@) if $@;
  99
 100         my @ret;
 101         foreach my $info (bazaar_log($out)) {
 102                 my @pages = ();
 103                 my @message = ();
 104
 105                 foreach my $msgline (split(/\n/, $info->{message})) {
 106                         push @message, { line => $msgline };
 107                 }
 108
 109                 foreach my $file (split(/\n/, $info->{files})) {
 110                         my $diffurl = $config{'diffurl'};
 111                         $diffurl =~ s/\[\[file\]\]/$file/go;
 112                         $diffurl =~ s/\[\[r2\]\]/$info->{revno}/go;
 113
 114                         push @pages, {
 115                                 page => pagename($file),
 116                                 diffurl => $diffurl,
 117                         };
 118                 }
 119
 120                 my $user = $info->{"committer"};
 121                 if (defined($info->{"author"})) { $user = $info->{"author"}; }
 122                 $user =~ s/\s*<.*>\s*$//;
 123                 $user =~ s/^\s*//;
 124
 125                 push @ret, {
 126                         rev        => $info->{"revno"},
 127                         user       => $user,
 128                         committype => "bazaar",
 129                         when       => time - str2time($info->{"timestamp"}),
 130                         message    => [@message],
 131                         pages      => [@pages],
 132                 };
 133         }
 134
 135         return @ret;
 136 } #}}}
 137
 138 sub rcs_notify () { #{{{
 139         # TODO
 140 } #}}}
 141
 142 sub rcs_getctime ($) { #{{{
 143         my ($file) = @_;
 144
 145         # XXX filename passes through the shell here, should try to avoid
 146         # that just in case
 147         my @cmdline = ("bzr", "log", "--limit", '1', "$config{srcdir}/$file");
 148         open (my $out, "@cmdline |");
 149
 150         my @log = bazaar_log($out);
 151
 152         if (length @log < 1) {
 153                 return 0;
 154         }
 155
 156         eval q{use Date::Parse};
 157         error($@) if $@;
 158
 159         my $ctime = str2time($log[0]->{"timestamp"});
 160         return $ctime;
 161 } #}}}
 162
 163 1