SVN::Class - manipulate Subversion workspaces with Perl objects

 use SVN::Class;

 my $file = svn_file( 'path/to/file' );
 my $fh = $file->open('>>');
 print {$fh} "hello world\n";
 $fh->close;
 $file->add;
 if ($file->modified) {
    my $rev = $file->commit('the file changed');
    print "$file was committed with revision $rev\n";
 }
 else {
    croak "$file was not committed: " . $file->errstr;
 }

 my $dir = svn_dir( 'path/to/dir' );
 $dir->mkpath unless -d $dir;
 $dir->add;  # recurses by default
 $dir->commit('added directory') if $dir->modified;

 use SVN::Class ();

    perldoc SVN::Class

package SVN::Class;
use strict;
use warnings;
use base qw( Path::Class Rose::Object );
use Rose::Object::MakeMethods::Generic (
    scalar => [qw( svn stdout stderr error error_code verbose debug )] );
use Carp;
use Data::Dump;
use IPC::Cmd qw( can_run run );
use SVN::Class::File;
use SVN::Class::Dir;
use SVN::Class::Info;
use Text::ParseWords;
use File::Temp;

$ENV{LC_ALL} = 'C';    # we expect our responses in ASCII

#$IPC::Cmd::DEBUG   = 1;
#$IPC::Cmd::VERBOSE = 1;

unless ( IPC::Cmd->can_capture_buffer ) {
    croak "IPC::Cmd is not configured to capture buffers. "
        . "Do you have IPC::Run installed?";
}

# IPC::Run fails tests because we use built-in shell commands
# not found in PATH
$IPC::Cmd::USE_IPC_RUN = 1;

# this trick cribbed from mst's Catalyst::Controller::WrapCGI
# we alias STDIN and STDOUT since Catalyst (and presumaly other code)
# might be messing with STDOUT or STDIN
my $REAL_STDIN  = *STDIN;
my $REAL_STDOUT = *STDOUT;
my $REAL_STDERR = *STDERR;
if ( $ENV{SVN_CLASS_ALIAS_STDOUT} ) {
    open $REAL_STDIN,  "<&=" . CORE::fileno(*STDIN);
    open $REAL_STDOUT, ">>&=" . CORE::fileno(*STDOUT);
    open $REAL_STDERR, ">>&=" . CORE::fileno(*STDERR);
}

sub _debug_stdin_fh {

    #warn "     stdin fileno = " . CORE::fileno(*STDIN);
    #warn "real_stdin fileno = " . CORE::fileno($REAL_STDIN);
}

sub _debug_stdout_fh {

    #warn "     stdout fileno = " . CORE::fileno(*STDOUT);
    #warn "real_stdout fileno = " . CORE::fileno($REAL_STDOUT);
}

our @EXPORT    = qw( svn_file svn_dir );
our @EXPORT_OK = qw( svn_file svn_dir );

our $VERSION = '0.16';

sub svn_file {
    SVN::Class::File->new(@_);
}

sub svn_dir {
    SVN::Class::Dir->new(@_);
}

sub svn_run {
    my $self = shift;
    my $cmd  = shift or croak "svn command required";
    my $opts = shift || [];
    my $file = shift || "$self";

    # since $opts may contain whitespace, must pass command as array ref
    # to IPC::Run
    my $command
        = [ $self->svn, $cmd, shellwords( join( ' ', @$opts ) ), $file ];

    my @out;

    $self->_debug_stdin_fh;
    $self->_debug_stdout_fh;

    {
        local *STDIN  = $REAL_STDIN;    # restore the real ones so the filenos
        local *STDOUT = $REAL_STDOUT;   # are 0 and 1 for the env setup
        local *STDERR = $REAL_STDERR;

        my $old = select($REAL_STDOUT);  # in case somebody just calls 'print'

        # Use local signal handler so global handler
        # does not result in bad values in $? and $!
        # http://www.perlmonks.org/?node_id=197500
        # useful for running under Catalyst (e.g.)
        local $SIG{CHLD} = '';

        $self->_debug_stdin_fh;
        $self->_debug_stdout_fh;

        (@out) = run( command => $command, verbose => $self->verbose );

        select($old);
    }

    my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = @out;

    # buffers do not always split on \n so force them to.
    my @stdout = split( m/\n/, join( '', @$stdout_buf ) );
    my @stderr = split( m/\n/, join( '', @$stderr_buf ) );

    # return code is a little murky as $error_code is often -1
    # which sometimes signals success, while $success is undef.
    if ( !defined($success) ) {
        if ( $error_code eq '-1' && !@stderr ) {
            $success = 1;
        }
        else {
            $success = 0;
        }
    }

    $self->stdout( \@stdout );
    $self->stderr( \@stderr );
    $self->error( $success ? "" : \@stderr );
    $self->error_code($error_code);

    if ( $self->debug || $ENV{PERL_DEBUG} ) {
        carp "command: " . Data::Dump::dump($command);
        carp Data::Dump::dump \@out;
        $self->dump;
        carp "success = $success";
    }

    return $success;
}

sub log {
    my $self = shift;
    my $ret = $self->svn_run( 'log', @_ );
    return 0 unless $ret > 0;
    return $self->stdout;
}

sub add {
    shift->svn_run( 'add', @_ );
}

sub delete {
    shift->svn_run( 'rm', @_ );
}

sub update {
    shift->svn_run( 'update', @_ );
}

*up = \&update;

sub revert {
    shift->svn_run( 'revert', @_ );
}

sub commit {

    # croak if failure but set error() and error_code()
    # first in case wrapped in eval().
    my $self    = shift;
    my $message = shift or croak "commit message required";
    my $opts    = shift || [];

    # create temp file to print message to. see RT #48748
    my $message_fh = File::Temp->new();
    print $message_fh $message;
    my $message_file = $message_fh->filename;
    $message_file =~ s!\\!/!g;  # escape literal \ for Windows users. see RT#54969

    my $ret = $self->svn_run( 'commit', [ '--file', $message_file, @$opts ] );

    # confirm temp file is removed
    undef $message_fh;
    if ( -s $message_file ) {
        warn "temp file not removed: $message_file";
    }

    # $ret is empty string on success. that's odd.
    if ( defined( $self->{stdout}->[0] )
        && $self->{stdout}->[-1] =~ m/Committed revision (\d+)/ )
    {
        return $1;
    }
    return 0;
}

sub status {
    my $self = shift;
    $self->svn_run('status');

    if ( $self->is_dir ) {

        # find the arg that matches $self
        if ( defined $self->stdout->[0] ) {
            for my $line ( @{ $self->stdout } ) {
                if ( $line =~ m/^(\S)\s+\Q$self\E$/ ) {
                    return $1;
                }
            }
            return 0;
        }
    }

    if ( defined $self->stdout->[0] ) {
        my ($stat) = ( $self->stdout->[0] =~ m/^([A-Z\?])/ );
        return $stat;
    }
    return 0;
}

sub modified {
    return $_[0]->status =~ m/^[MA]$/ ? 1 : 0;
}

sub conflicted {
    return $_[0]->status eq 'C';
}

sub diff {
    shift->svn_run( 'diff', @_ );
}

sub blame {
    shift->svn_run( 'blame', @_ );
}

sub info {
    my $self = shift;
    return 0 unless $self->svn_run( 'info', @_ );
    return SVN::Class::Info->new( $self->stdout );
}

sub dump {
    Data::Dump::dump(shift);
}

sub errstr {
    my $self = shift;
    my $err  = $self->error;
    return ref($err) ? join( "\n", @$err ) : $err;
}

sub outstr {
    my $self = shift;
    my $out  = $self->stdout;
    return ( ref($out) ? join( "\n", @$out ) : $out ) . "\n";
}

1;

__END__