File Coverage

blib/lib/SVN/Class.pm

Criterion	Covered	Total	%
statement	36	124	29.0
branch	0	34	0.0
condition	0	16	0.0
subroutine	12	32	37.5
pod	18	18	100.0
total	66	224	29.4

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.17';

=head1 NAME

SVN::Class - manipulate Subversion workspaces with Perl objects

=head1 SYNOPSIS

 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;

=head1 DESCRIPTION

SVN::Class extends Path::Class to allow for basic Subversion workspace
management. SVN::Class::File and SVN::Class::Dir are subclasses of
Path::Class::File::Stat and Path::Class::Dir respectively.

SVN::Class does not use the SVN::Core Subversion SWIG bindings. Instead,
the C binary tool is used for all interactions, using IPC::Cmd. This
design decision was made for maximum portability and to eliminate
non-CPAN dependencies.

=head1 EXPORT

SVN::Class exports two functions by default: svn_file() and svn_dir().
These work just like the dir() and file() functions in Path::Class.
If you do not want to export them, just invoke SVN::Class like:

 use SVN::Class ();

=head2 svn_file( I )

Works just like Path::Class::file().

=head2 svn_dir( I )

Works just like Path::Class::dir().

=cut

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

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

=head1 METHODS

SVN::Class inherits from Path::Class. Only new or overridden methods
are documented here.

=cut

=head2 svn

Path to the svn binary. Defaults to C and thus relies on environment's
PATH to find and execute the correct command.

=head2 stdout

Get the stdout from the last svn_run().

=head2 stderr

Get the stderr from the last svn_run().

=head2 error

If the last svn_run() exited with non-zero, error() will return same
as stderr(). If svn_run() was successful, returns the empty string.

=head2 error_code

Returns the last exit value of svn_run().

=head2 verbose

Get/set a true value to enable IPC output in svn_run().

=head2 debug

Get/set a true value to see debugging output printed on stderr.

=cut

=head2 svn_run( I, I, I )

Execute I given I and I as arguments. This is a wrapper
around the IPC::Run run() function.

I should be an array ref of options to pass to I.

I defaults to $self->stringify().

Returns the success code from IPC::Run run(). Sets the stdout,
stderr, err, errstr, and error_code values in the SVN::Class object.

This method is used internally by all the Subversion commands.

B In order to standardize the output of Subversion commands into
a locale that is easily parse-able by other methods that call svn_run()
internally, all commands are run with C to make sure
output is ASCII only.

=cut

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;
}

=head2 log

Returns svn log of the file or 0 on error. The log is returned
as an arrayref (same as accessing stdout()).

=cut

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

=head2 add

Schedule the object for addition to the repository.

=cut

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

=head2 delete

Schedule the object for removal from the repository.

=cut

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

=head2 update

Get the latest version of the object from the repository.

=cut

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

=head2 up

Alias for update().

=cut

*up = \&update;

=head2 revert

Undo the last Subversion action on the object.

=cut

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

=head2 commit( I )

Commit the object to the repository with the log I.

Returns the revision number of the commit on success, 0 on failure.

=cut

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;
}

=head2 status

Returns the workspace status of the object.

=cut

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;
}

=head2 modified

Returns true if the status() of the object is C or C.

=cut

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

=head2 conflicted

Returns true if the status() of the object is C.

=cut

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

=head2 diff

Diff the workspace version of the object against either the repository
or the current working baseline version.

=cut

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

=head2 blame

Annotated accounting of who modified what lines of the object.

=cut

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

=head2 info

Returns SVN::Class::Info instance with information about the current
object or 0 on failure.

=cut

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

=head2 dump

Returns a Data::Dump serialization of the object. Useful for debugging.

=cut

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

=head2 errstr

Returns the contents of error() as a newline-joined string.

=cut

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

=head2 outstr

Returns the contents of stdout() as a newline-joined string.

=cut

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

1;

__END__