#!/usr/bin/perl
+
+package IkiWiki;
+
use warnings;
use strict;
use IkiWiki;
use Date::Parse qw(str2time);
use Date::Format qw(time2str);
-package IkiWiki;
-
my $sha1_pattern = qr/[0-9a-fA-F]{40}/; # pattern to validate sha1sums
-sub check_config() { #{{{
+hook(type => "checkconfig", id => "monotone", call => sub { #{{{
if (!defined($config{mtnrootdir})) {
$config{mtnrootdir} = $config{srcdir};
}
error("Ikiwiki srcdir does not seem to be a Monotone workspace (or set the mtnrootdir)!");
}
- chdir $config{srcdir}
- or error("Cannot chdir to $config{srcdir}: $!");
-
my $child = open(MTN, "-|");
if (! $child) {
open STDERR, ">/dev/null";
if ($version < 0.38) {
error("Monotone version too old, is $version but required 0.38");
}
-} #}}}
+
+ if (exists $config{mtn_wrapper}) {
+ push @{$config{wrappers}}, {
+ wrapper => $config{mtn_wrapper},
+ wrappermode => (defined $config{mtn_wrappermode} ? $config{mtn_wrappermode} : "06755"),
+ };
+ }
+}); #}}}
+
+hook(type => "getsetup", id => "monotone", call => sub { #{{{
+ return
+ mtn_wrapper => {
+ type => "string",
+ example => "/srv/mtn/wiki/_MTN/ikiwiki-netsync-hook",
+ description => "monotone netsync hook executable to generate",
+ safe => 0, # file
+ rebuild => 0,
+ },
+ mtn_wrappermode => {
+ type => "string",
+ example => '06755',
+ description => "mode for mtn_wrapper (can safely be made suid)",
+ safe => 0,
+ rebuild => 0,
+ },
+ mtnkey => {
+ type => "string",
+ example => 'web@example.com',
+ description => "your monotone key",
+ safe => 1,
+ rebuild => 0,
+ },
+ historyurl => {
+ type => "string",
+ example => "http://viewmtn.example.com/branch/head/filechanges/com.example.branch/[[file]]",
+ description => "viewmtn url to show file history ([[file]] substituted)",
+ safe => 1,
+ rebuild => 1,
+ },
+ diffurl => {
+ type => "string",
+ example => "http://viewmtn.example.com/revision/diff/[[r1]]/with/[[r2]]/[[file]]",
+ description => "viewmtn url to show a diff ([[r1]], [[r2]], and [[file]] substituted)",
+ safe => 1,
+ rebuild => 1,
+ },
+ mtnsync => {
+ type => "boolean",
+ example => 0,
+ description => "sync on update and commit?",
+ safe => 0, # paranoia
+ rebuild => 0,
+ },
+ mtnrootdir => {
+ type => "string",
+ description => "path to your workspace (defaults to the srcdir; specify if the srcdir is a subdirectory of the workspace)",
+ safe => 0, # path
+ rebuild => 0,
+ },
+}); #}}}
sub get_rev () { #{{{
my $sha1 = `mtn --root=$config{mtnrootdir} automate get_base_revision_id`;
} #}}}
sub rcs_update () { #{{{
- check_config();
+ chdir $config{srcdir}
+ or error("Cannot chdir to $config{srcdir}: $!");
if (defined($config{mtnsync}) && $config{mtnsync}) {
if (system("mtn", "--root=$config{mtnrootdir}", "sync",
sub rcs_prepedit ($) { #{{{
my $file=shift;
- check_config();
+ chdir $config{srcdir}
+ or error("Cannot chdir to $config{srcdir}: $!");
# For monotone, return the revision of the file when
# editing begins.
$author="Web: Anonymous";
}
- check_config();
+ chdir $config{srcdir}
+ or error("Cannot chdir to $config{srcdir}: $!");
my ($oldrev)= $rcstoken=~ m/^($sha1_pattern)$/; # untaint
my $rev = get_rev();
return undef # success
} #}}}
+sub rcs_commit_staged ($$$) {
+ # Commits all staged changes. Changes can be staged using rcs_add,
+ # rcs_remove, and rcs_rename.
+ my ($message, $user, $ipaddr)=@_;
+
+ # Note - this will also commit any spurious changes that happen to be
+ # lying around in the working copy. There shouldn't be any, but...
+
+ chdir $config{srcdir}
+ or error("Cannot chdir to $config{srcdir}: $!");
+
+ my $author;
+
+ if (defined $user) {
+ $author="Web user: " . $user;
+ }
+ elsif (defined $ipaddr) {
+ $author="Web IP: " . $ipaddr;
+ }
+ else {
+ $author="Web: Anonymous";
+ }
+
+ if (system("mtn", "--root=$config{mtnrootdir}", "commit", "--quiet",
+ "--author", $author, "--key", $config{mtnkey}, "-m",
+ possibly_foolish_untaint($message)) != 0) {
+ error("Monotone commit failed");
+ }
+}
+
sub rcs_add ($) { #{{{
my $file=shift;
- check_config();
+ chdir $config{srcdir}
+ or error("Cannot chdir to $config{srcdir}: $!");
if (system("mtn", "--root=$config{mtnrootdir}", "add", "--quiet",
$file) != 0) {
}
} #}}}
+sub rcs_remove ($) { # {{{
+ my $file = shift;
+
+ chdir $config{srcdir}
+ or error("Cannot chdir to $config{srcdir}: $!");
+
+ # Note: it is difficult to undo a remove in Monotone at the moment.
+ # Until this is fixed, it might be better to make 'rm' move things
+ # into an attic, rather than actually remove them.
+ # To resurrect a file, you currently add a new file with the contents
+ # you want it to have. This loses all connectivity and automated
+ # merging with the 'pre-delete' versions of the file.
+
+ if (system("mtn", "--root=$config{mtnrootdir}", "rm", "--quiet",
+ $file) != 0) {
+ error("Monotone remove failed");
+ }
+} #}}}
+
+sub rcs_rename ($$) { # {{{
+ my ($src, $dest) = @_;
+
+ chdir $config{srcdir}
+ or error("Cannot chdir to $config{srcdir}: $!");
+
+ if (system("mtn", "--root=$config{mtnrootdir}", "rename", "--quiet",
+ $src, $dest) != 0) {
+ error("Monotone rename failed");
+ }
+} #}}}
+
sub rcs_recentchanges ($) { #{{{
my $num=shift;
my @ret;
- check_config();
+ chdir $config{srcdir}
+ or error("Cannot chdir to $config{srcdir}: $!");
# use log --brief to get a list of revs, as this
# gives the results in a nice order
} #}}}
sub rcs_diff ($) { #{{{
- # TODO
+ my $rev=shift;
+ my ($sha1) = $rev =~ /^($sha1_pattern)$/; # untaint
+
+ chdir $config{srcdir}
+ or error("Cannot chdir to $config{srcdir}: $!");
+
+ my $child = open(MTNDIFF, "-|");
+ if (! $child) {
+ exec("mtn", "diff", "--root=$config{mtnrootdir}", "-r", "p:".$sha1, "-r", $sha1) || error("mtn diff $sha1 failed to run");
+ }
+
+ my (@lines) = <MTNDIFF>;
+
+ close MTNDIFF || debug("mtn diff $sha1 exited $?");
+
+ if (wantarray) {
+ return @lines;
+ }
+ else {
+ return join("", @lines);
+ }
} #}}}
sub rcs_getctime ($) { #{{{
my $file=shift;
- check_config();
+ chdir $config{srcdir}
+ or error("Cannot chdir to $config{srcdir}: $!");
my $child = open(MTNLOG, "-|");
if (! $child) {
sipb-www / ikiwiki.git / blobdiff