The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package CGI::Kwiki::Backup::SVN;
$VERSION = '0.01';

use strict;
use base 'CGI::Kwiki::Backup';
use File::Spec;

use constant SVN_DIR => 'metabase/svn';
use constant LOCAL_DIR => 'database/.svn/text-base';

my $svn = can_run('svn') or die "Cannot find svn in PATH!";
my $svnadmin = can_run('svnadmin') or die "Cannot find svnadmin in PATH!";

# check if we can run some command
sub can_run {
    my ($cmd) = @_;

    require Config;
    require File::Spec;
    require ExtUtils::MakeMaker;

    my $_cmd = $cmd;
    return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd));

    for my $dir (
        (split /$Config::Config{path_sep}/, $ENV{PATH}),
        ('c:/progra~1/subversion', '/usr/local/bin', '/opt/bin', '/sw/bin', '.')
    ) {
        my $abs = File::Spec->catfile($dir, $_[0]);
        return $abs if (-x $abs or $abs = MM->maybe_command($abs));
    }

    return;
}

sub file_path {
    my ($self, $page_id) = @_;
    LOCAL_DIR . '/' . $self->escape($page_id) . '.svn-base';
}

my $user_name = '';
sub new {
    my ($class) = shift;
    my $self = $class->SUPER::new(@_);

    return $self if $class ne __PACKAGE__;
    return $self if -d SVN_DIR;

    $self->shell("$svnadmin create " . SVN_DIR);
    umask 0000;
    chmod 0777, SVN_DIR;
    my $url = File::Spec->rel2abs( SVN_DIR );
    $url =~ s{\\}{/}g;
    $url =~ s{\w:}{};
    $self->shell("$svn co -q file://$url " . $self->database->file_path(''));
    $user_name = 'kwiki-install';
    for my $page_id ($self->database->pages) {
        $self->add($page_id);
    }
    $self->commit_all;

    return $self;
}
    
sub add {
    my ($self, $page_id) = @_;
    my $msg = $user_name || $self->metadata->edit_by;
    my $page_file_path = $self->database->file_path($page_id);
    $self->shell(qq{$svn add -q $page_file_path})
        unless $self->has_history($page_id);
}

sub commit {
    my ($self, $page_id) = @_;
    my $msg = $self->escape($user_name || $self->metadata->edit_by);
    my $page_file_path = $self->database->file_path($page_id);
    $self->shell(qq{$svn add -q $page_file_path})
        unless $self->has_history($page_id);
    $self->shell(qq{$svn ci -q -m"$msg" $page_file_path});
}

sub commit_all {
    my ($self) = @_;
    my $msg = $self->escape($user_name || $self->metadata->edit_by);
    my $page_file_path = $self->database->file_path('');
    $self->shell(qq{$svn ci -q -m"$msg" $page_file_path});
}

sub has_history {
    my ($self, $page_id) = @_;
    $page_id ||= $self->cgi->page_id;
    -f $self->file_path($page_id);
}

sub history {
    my ($self, $page_id) = @_;
    $page_id ||= $self->cgi->page_id;
    my $svn_file_path = $self->database->file_path($page_id);
    open RLOG, "$svn log $svn_file_path |"
      or DIE $!; 
    binmode(RLOG, ':utf8') if $self->use_utf8;
    my $history = [];
    while (<RLOG>) {
        /^(?:r|rev\s+)(\d+)\s*[:\|]\s+(\S+)\s+\|\s+(.+?)\s+\(/ or next;
        my $entry = {
            revision => $1,
            edit_by => $2,
            date => $3,
        };
        while (<RLOG>) {
            /^(.+)$/ or next;
            $entry->{edit_by} = $self->unescape($1);
            last;
        }
        push @$history, $entry;
    }

    return $self->_build_history($history);
}

sub _build_history {
    my ($self, $history) = @_;
    my $count = @$history;
    $self->{revisions} = {};
    for (@$history) {
        $_->{file_rev} = $count--;
        $self->{revisions}{$_->{revision}} = $_->{file_rev};
    }
    return $history;
}

sub file_rev {
    my ($self, $page_id, $revision) = @_;
    $self->history unless $self->{revisions};
    return $self->{revisions}{$revision};
}

sub fetch {
    my ($self, $page_id, $revision) = @_;
    my $svn_file_path = $self->database->file_path($page_id);
    
    local($/, *CO);
    open CO, qq{$svn -r $revision cat $svn_file_path |}
      or die $!;
    binmode(CO, ':utf8') if $self->use_utf8;
    <CO>;
}

sub diff {
    my ($self, $page_id, $r1, $r2, $context) = @_;
    $context ||= 1000000;
    my $svn_file_path = $self->database->file_path($page_id);

    use Cwd;
    local(*SVNDIFF);
    my $kluge = ((-w '.') ? '' : '../');
    chdir('metabase') if $kluge;
    open SVNDIFF, qq{$svn diff -r $r1:$r2 $kluge$svn_file_path |}
      or die "svndiff failed:\n$!";
    chdir('..') if $kluge;
    binmode(SVNDIFF, ':utf8') if $self->use_utf8;
    <SVNDIFF>; <SVNDIFF>;
    my $line1 = <SVNDIFF>;
    my $line2 = <SVNDIFF>;
    $line2 =~ s/\+/%2B/g; # counter ->unescape
    local $/;
    return($self->unescape($line1) . $self->unescape($line2) . <SVNDIFF>);
}

sub shell {
    my ($self, $command) = @_;
    use Cwd;
    $! = undef;
    system($command) == 0 
      or die "$command failed: $! | " . Cwd::cwd();
}

1;