X-Git-Url: http://git.vanrenterghem.biz/git.ikiwiki.info.git/blobdiff_plain/14cd75746a2c73b50548b6fdb3583d536b6ef9bd..506d16a8a01e563601dee2ddde877cb8210a61ef:/IkiWiki/Plugin/tla.pm diff --git a/IkiWiki/Plugin/tla.pm b/IkiWiki/Plugin/tla.pm index e1389a346..da4385446 100644 --- a/IkiWiki/Plugin/tla.pm +++ b/IkiWiki/Plugin/tla.pm @@ -1,29 +1,46 @@ #!/usr/bin/perl - -package IkiWiki; +package IkiWiki::Plugin::tla; use warnings; use strict; use IkiWiki; -hook(type => "checkconfig", id => "tla", call => sub { #{{{ - if (! defined $config{diffurl}) { - $config{diffurl}=""; - } - if (length $config{tla_wrapper}) { +sub import { + hook(type => "checkconfig", id => "tla", call => \&checkconfig); + hook(type => "getsetup", id => "tla", call => \&getsetup); + hook(type => "rcs", id => "rcs_update", call => \&rcs_update); + hook(type => "rcs", id => "rcs_prepedit", call => \&rcs_prepedit); + hook(type => "rcs", id => "rcs_commit", call => \&rcs_commit); + hook(type => "rcs", id => "rcs_commit_staged", call => \&rcs_commit_staged); + hook(type => "rcs", id => "rcs_add", call => \&rcs_add); + hook(type => "rcs", id => "rcs_remove", call => \&rcs_remove); + hook(type => "rcs", id => "rcs_rename", call => \&rcs_rename); + hook(type => "rcs", id => "rcs_recentchanges", call => \&rcs_recentchanges); + hook(type => "rcs", id => "rcs_diff", call => \&rcs_diff); + hook(type => "rcs", id => "rcs_getctime", call => \&rcs_getctime); + hook(type => "rcs", id => "rcs_getmtime", call => \&rcs_getmtime); +} + +sub checkconfig () { + if (defined $config{tla_wrapper} && length $config{tla_wrapper}) { push @{$config{wrappers}}, { wrapper => $config{tla_wrapper}, wrappermode => (defined $config{tla_wrappermode} ? $config{tla_wrappermode} : "06755"), }; } -}); #}}} +} -hook(type => "getsetup", id => "tla", call => sub { #{{{ +sub getsetup () { return + plugin => { + safe => 0, # rcs plugin + rebuild => undef, + section => "rcs", + }, tla_wrapper => { type => "string", #example => "", # TODO example - description => "tla post-commit executable to generate", + description => "tla post-commit hook to generate", safe => 0, # file rebuild => 0, }, @@ -48,7 +65,7 @@ hook(type => "getsetup", id => "tla", call => sub { #{{{ safe => 1, rebuild => 1, }, -}); #}}} +} sub quiet_system (@) { # See Debian bug #385939. @@ -62,15 +79,15 @@ sub quiet_system (@) { return $ret; } -sub rcs_update () { #{{{ +sub rcs_update () { if (-d "$config{srcdir}/{arch}") { if (quiet_system("tla", "replay", "-d", $config{srcdir}) != 0) { warn("tla replay failed\n"); } } -} #}}} +} -sub rcs_prepedit ($) { #{{{ +sub rcs_prepedit ($) { my $file=shift; if (-d "$config{srcdir}/{arch}") { @@ -79,20 +96,25 @@ sub rcs_prepedit ($) { #{{{ my $rev=`tla tree-id $config{srcdir}`; return defined $rev ? $rev : ""; } -} #}}} +} -sub rcs_commit ($$$;$$) { #{{{ - my $file=shift; - my $message=shift; - my $rcstoken=shift; - my $user=shift; - my $ipaddr=shift; +sub rcs_commit (@) { + my %params=@_; - if (defined $user) { - $message="web commit by $user".(length $message ? ": $message" : ""); - } - elsif (defined $ipaddr) { - $message="web commit from $ipaddr".(length $message ? ": $message" : ""); + my ($file, $message, $rcstoken)= + ($params{file}, $params{message}, $params{token}); + + if (defined $params{session}) { + if (defined $params{session}->param("name")) { + $message="web commit by ". + $params{session}->param("name"). + (length $message ? ": $message" : ""); + } + elsif (defined $params{session}->remote_addr()) { + $message="web commit from ". + $params{session}->remote_addr(). + (length $message ? ": $message" : ""); + } } if (-d "$config{srcdir}/{arch}") { @@ -110,7 +132,7 @@ sub rcs_commit ($$$;$$) { #{{{ } if (quiet_system("tla", "commit", - "-L".possibly_foolish_untaint($message), + "-L".IkiWiki::possibly_foolish_untaint($message), '-d', $config{srcdir}) != 0) { my $conflict=readfile("$config{srcdir}/$file"); if (system("tla", "undo", "-n", "--quiet", "-d", "$config{srcdir}") != 0) { @@ -120,17 +142,17 @@ sub rcs_commit ($$$;$$) { #{{{ } } return undef # success -} #}}} +} -sub rcs_commit_staged ($$$) { +sub rcs_commit_staged (@) { # Commits all staged changes. Changes can be staged using rcs_add, # rcs_remove, and rcs_rename. - my ($message, $user, $ipaddr)=@_; + my %params=@_; error("rcs_commit_staged not implemented for tla"); # TODO } -sub rcs_add ($) { #{{{ +sub rcs_add ($) { my $file=shift; if (-d "$config{srcdir}/{arch}") { @@ -138,19 +160,19 @@ sub rcs_add ($) { #{{{ warn("tla add failed\n"); } } -} #}}} +} -sub rcs_remove ($) { # {{{ +sub rcs_remove ($) { my $file = shift; error("rcs_remove not implemented for tla"); # TODO -} #}}} +} -sub rcs_rename ($$) { # {{{a +sub rcs_rename ($$) { my ($src, $dest) = @_; error("rcs_rename not implemented for tla"); # TODO -} #}}} +} sub rcs_recentchanges ($) { my $num=shift; @@ -201,7 +223,7 @@ sub rcs_recentchanges ($) { my @pages; foreach my $file (@paths) { - my $diffurl=$config{diffurl}; + my $diffurl=defined $config{diffurl} ? $config{diffurl} : ""; $diffurl=~s/\[\[file\]\]/$file/g; $diffurl=~s/\[\[rev\]\]/$change/g; push @pages, { @@ -224,7 +246,7 @@ sub rcs_recentchanges ($) { return @ret; } -sub rcs_diff ($) { #{{{ +sub rcs_diff ($) { my $rev=shift; my $logs = `tla logs -d $config{srcdir}`; my @changesets = reverse split(/\n/, $logs); @@ -236,9 +258,9 @@ sub rcs_diff ($) { #{{{ my $revminusone = $changesets[$i+1]; return `tla diff -d $config{srcdir} $revminusone`; -} #}}} +} -sub rcs_getctime ($) { #{{{ +sub rcs_getctime ($) { my $file=shift; eval q{use Date::Parse}; error($@) if $@; @@ -266,6 +288,10 @@ sub rcs_getctime ($) { #{{{ my $date=str2time($sdate, 'UTC'); debug("found ctime ".localtime($date)." for $file"); return $date; -} #}}} +} + +sub rcs_getmtime ($) { + error "rcs_getmtime is not implemented for tla\n"; # TODO +} 1