X-Git-Url: http://git.vanrenterghem.biz/git.ikiwiki.info.git/blobdiff_plain/b493f9b6d8e2131dd2338da05d98fded592d0943..c69120058ba671e1c6863796b511710f5df3efa2:/IkiWiki/Plugin/cvs.pm diff --git a/IkiWiki/Plugin/cvs.pm b/IkiWiki/Plugin/cvs.pm index ccd9527cd..841aec914 100644 --- a/IkiWiki/Plugin/cvs.pm +++ b/IkiWiki/Plugin/cvs.pm @@ -1,13 +1,49 @@ -#!/usr/pkg/bin/perl +#!/usr/bin/perl package IkiWiki::Plugin::cvs; +# Copyright (c) 2009 Amitai Schlair +# All rights reserved. +# +# This code is derived from software contributed to ikiwiki +# by Amitai Schlair. +# +# Redistribution and use in source and binary forms, with or without +# modification, are permitted provided that the following conditions +# are met: +# 1. Redistributions of source code must retain the above copyright +# notice, this list of conditions and the following disclaimer. +# 2. Redistributions in binary form must reproduce the above copyright +# notice, this list of conditions and the following disclaimer in the +# documentation and/or other materials provided with the distribution. +# +# THIS SOFTWARE IS PROVIDED BY IKIWIKI AND CONTRIBUTORS ``AS IS'' +# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +# TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A +# PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE FOUNDATION +# OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +# LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF +# USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +# ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +# OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT +# OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +# SUCH DAMAGE. + use warnings; use strict; use IkiWiki; +use URI::Escape q{uri_escape_utf8}; +use File::chdir; + + +# GENERAL PLUGIN API CALLS + sub import { hook(type => "checkconfig", id => "cvs", call => \&checkconfig); hook(type => "getsetup", id => "cvs", call => \&getsetup); + hook(type => "genwrapper", id => "cvs", call => \&genwrapper); + 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); @@ -18,6 +54,7 @@ sub import { 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 () { @@ -43,6 +80,7 @@ sub getsetup () { plugin => { safe => 0, # rcs plugin rebuild => undef, + section => "rcs", }, cvsrepo => { type => "string", @@ -61,7 +99,7 @@ sub getsetup () { cvs_wrapper => { type => "string", example => "/cvs/wikirepo/CVSROOT/post-commit", - description => "cvs post-commit hook to generate (triggered by CVSROOT/loginfo entry", + description => "cvs post-commit hook to generate (triggered by CVSROOT/loginfo entry)", safe => 0, # file rebuild => 0, }, @@ -88,55 +126,23 @@ sub getsetup () { }, } -sub cvs_info ($$) { - my $field=shift; - my $file=shift; - - chdir $config{srcdir} || error("Cannot chdir to $config{srcdir}: $!"); - - my $info=`cvs status $file`; - my ($ret)=$info=~/^\s*$field:\s*(\S+)/m; - return $ret; -} - -sub cvs_runcvs(@) { - my ($cmd) = @_; - unshift @$cmd, 'cvs', '-Q'; - - eval q{use IPC::Cmd}; - error($@) if $@; - - chdir $config{srcdir} || error("Cannot chdir to $config{srcdir}: $!"); - - debug("runcvs: " . join(" ", @$cmd)); - - my ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf) = - IPC::Cmd::run(command => $cmd, verbose => 0); - if (! $success) { - warn(join(" ", @$cmd) . " exited with code $error_code\n"); - warn(join "", @$stderr_buf); +sub genwrapper () { + return <$tmpfile"); + if ($? == -1) { + error "couldn't run cvsps: $!\n"; + } + elsif (($? >> 8) != 0) { + error "cvsps exited " . ($? >> 8) . ": $!\n"; + } - # there's no option to get the last N changesets, so read backwards - open CVSPS, "env TZ=UTC cvsps -q --cvs-direct -z 30 -x |" || error "couldn't get cvsps output: $!\n"; - my @spsvc = reverse ; # is this great? no it is not - close CVSPS || error "couldn't close cvsps output: $!\n"; + tie(*SPSVC, 'File::ReadBackwards', $tmpfile) + || error "couldn't open $tmpfile for read: $!\n"; - while (my $line = shift @spsvc) { + while (my $line = ) { $line =~ /^$/ || error "expected blank line, got $line"; my ($rev, $user, $committype, $when); @@ -303,7 +303,7 @@ sub rcs_recentchanges($) { # @pages (and revisions) # - while ($line = shift @spsvc) { + while ($line = ) { last if ($line =~ /^Members:/); for ($line) { s/^\s+//; @@ -314,7 +314,10 @@ sub rcs_recentchanges($) { $oldrev =~ s/INITIAL/0/; $newrev =~ s/\(DEAD\)//; my $diffurl = defined $config{diffurl} ? $config{diffurl} : ""; - $diffurl=~s/\[\[file\]\]/$page/g; + my $epage = join('/', + map { uri_escape_utf8($_) } split('/', $page) + ); + $diffurl=~s/\[\[file\]\]/$epage/g; $diffurl=~s/\[\[r1\]\]/$oldrev/g; $diffurl=~s/\[\[r2\]\]/$newrev/g; unshift @pages, { @@ -323,7 +326,7 @@ sub rcs_recentchanges($) { } if length $page; } - while ($line = shift @spsvc) { + while ($line = ) { last if ($line =~ /^Log:$/); chomp $line; unshift @message, { line => $line }; @@ -333,35 +336,39 @@ sub rcs_recentchanges($) { $message[0]->{line}=~/$config{web_commit_regexp}/) { $user=defined $2 ? "$2" : "$3"; $message[0]->{line}=$4; - } else { + } + else { $committype="cvs"; } - $line = shift @spsvc; # Tag - $line = shift @spsvc; # Branch + $line = ; # Tag + $line = ; # Branch - $line = shift @spsvc; + $line = ; if ($line =~ /^Author: (.*)$/) { $user = $1 unless defined $user && length $user; - } else { + } + else { error "expected Author, got $line"; } - $line = shift @spsvc; + $line = ; if ($line =~ /^Date: (.*)$/) { $when = str2time($1, 'UTC'); - } else { + } + else { error "expected Date, got $line"; } - $line = shift @spsvc; + $line = ; if ($line =~ /^PatchSet (.*)$/) { $rev = $1; - } else { + } + else { error "expected PatchSet, got $line"; } - $line = shift @spsvc; # --------------------- + $line = ; # --------------------- push @ret, { rev => $rev, @@ -371,29 +378,37 @@ sub rcs_recentchanges($) { message => [@message], pages => [@pages], } if @pages; - return @ret if @ret >= $num; + last if @ret >= $num; } + unlink($tmpfile) || error "couldn't unlink $tmpfile: $!\n"; + return @ret; } -sub rcs_diff ($) { +sub rcs_diff ($;$) { my $rev=IkiWiki::possibly_foolish_untaint(int(shift)); + my $maxlines=shift; - chdir $config{srcdir} || error("Cannot chdir to $config{srcdir}: $!"); + local $CWD = $config{srcdir}; # diff output is unavoidably preceded by the cvsps PatchSet entry my @cvsps = `env TZ=UTC cvsps -q --cvs-direct -z 30 -g -s $rev`; my $blank_lines_seen = 0; + # skip log, get to the diff while (my $line = shift @cvsps) { $blank_lines_seen++ if ($line =~ /^$/); last if $blank_lines_seen == 2; } + @cvsps = @cvsps[0..$maxlines-1] + if defined $maxlines && @cvsps > $maxlines; + if (wantarray) { return @cvsps; - } else { + } + else { return join("", @cvsps); } } @@ -401,6 +416,8 @@ sub rcs_diff ($) { sub rcs_getctime ($) { my $file=shift; + local $CWD = $config{srcdir}; + my $cvs_log_infoline=qr/^date: (.+);\s+author/; open CVSLOG, "cvs -Q log -r1.1 '$file' |" @@ -426,4 +443,107 @@ sub rcs_getctime ($) { return $date; } +sub rcs_getmtime ($) { + error "rcs_getmtime is not implemented for cvs\n"; # TODO +} + + +# INTERNAL SUPPORT ROUTINES + +sub commitmessage (@) { + my %params=@_; + + if (defined $params{session}) { + if (defined $params{session}->param("name")) { + return "web commit by ". + $params{session}->param("name"). + (length $params{message} ? ": $params{message}" : ""); + } + elsif (defined $params{session}->remote_addr()) { + return "web commit from ". + $params{session}->remote_addr(). + (length $params{message} ? ": $params{message}" : ""); + } + } + return $params{message}; +} + +sub cvs_info ($$) { + my $field=shift; + my $file=shift; + + local $CWD = $config{srcdir}; + + my $info=`cvs status $file`; + my ($ret)=$info=~/^\s*$field:\s*(\S+)/m; + return $ret; +} + +sub cvs_is_controlling { + my $dir=shift; + $dir=$config{srcdir} unless defined($dir); + return (-d "$dir/CVS") ? 1 : 0; +} + +sub cvs_keyword_subst_args ($) { + my $file = shift; + + local $CWD = $config{srcdir}; + + eval q{use File::MimeInfo}; + error($@) if $@; + my $filemime = File::MimeInfo::default($file); + # if (-T $file) { + + defined($filemime) && $filemime eq 'text/plain' + ? return ('-kkv', $file) + : return ('-kb', $file); +} + +sub cvs_runcvs(@) { + my @cmd = @_; + unshift @cmd, 'cvs', '-Q'; + + # CVS can't operate outside a srcdir, so we're always setting $CWD. + # "local $CWD" restores the previous value when we go out of scope. + # Usually that's correct. But if we're removing the last file from + # a directory, the post-commit hook will exec in a working directory + # that's about to not exist (CVS will prune it). + # + # chdir() manually here, so we can selectively not chdir() back. + + my $oldcwd = $CWD; + chdir($config{srcdir}); + + eval q{ + use IPC::Open3; + use Symbol qw(gensym); + use IO::File; + }; + error($@) if $@; + + my $cvsout = ''; + my $cvserr = ''; + local *CATCHERR = IO::File->new_tmpfile; + my $pid = open3(gensym(), \*CATCHOUT, ">&CATCHERR", @cmd); + while (my $l = ) { + $cvsout .= $l + unless 1; + } + waitpid($pid, 0); + my $ret = $? >> 8; + seek CATCHERR, 0, 0; + while (my $l = ) { + $cvserr .= $l + unless $l =~ /^cvs commit: changing keyword expansion /; + } + + print STDOUT $cvsout; + print STDERR $cvserr; + + chdir($oldcwd) if -d $oldcwd; + + return ($ret == 0) ? 1 : 0; +} + 1