package SVN::Class;
use strict;
use warnings;
use base qw( Path::Class Class::Accessor::Fast );
__PACKAGE__->mk_accessors(
    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;

#$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?";
}

# 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
open( *REAL_STDIN,  "<&=" . fileno(*STDIN) );
open( *REAL_STDOUT, ">>&=" . fileno(*STDOUT) );

our @EXPORT    = qw( svn_file svn_dir );
our @EXPORT_OK = qw( svn_file svn_dir );
our $VERSION   = '0.02';

=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<svn> 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<file> )

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

=head2 svn_dir( I<dir> )

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_run( I<cmd>, I<opts>, I<file> )

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

I<opts> should be an array ref of options to pass to I<cmd>.

I<file> 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.

=cut

sub svn_run {
    my $self    = shift;
    my $cmd     = shift or croak "svn command required";
    my $opts    = shift || [];
    my $file    = shift || "$self";
    my $command = join( ' ', $self->svn, $cmd, @$opts, $file );

    my @out;

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

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

        (@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) && $error_code == -1 && !@stderr ) {
        $success = 1;
    }

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

    if ( $self->debug || $ENV{PERL_DEBUG} ) {
        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<message> )

Commit the object to the repository with the log I<message>.

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

    # must escape any literal '" in the message
    $message =~ s,(['"]),\\$1,g;

    my $ret = $self->svn_run( 'commit', ["-m \"$message\""] );

    # $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 ) {

        # check only first arg to see if it matches self
        if ( defined $self->stdout->[0] ) {
            if ( $self->stdout->[0] =~ m/^(\S)\s+$self$/ ) {
                return $1;
            }
            else {
                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<Add> or C<Modified>.

=cut

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

=head2 conflicted

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

=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 dump

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

=cut

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

=head2 errstr

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

=cut

sub errstr {
    return join( "\n", shift->error );
}

1;

__END__

=head1 AUTHOR

Peter Karman, C<< <karman at cpan.org> >>

=head1 BUGS

Please report any bugs or feature requests to
C<bug-svn-class at rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=SVN-Class>.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc SVN::Class

You can also look for information at:

=over 4

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/SVN-Class>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/SVN-Class>

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=SVN-Class>

=item * Search CPAN

L<http://search.cpan.org/dist/SVN-Class>

=back

=head1 ACKNOWLEDGEMENTS

I looked at SVN::Agent before starting this project. It has
a different API, more like SVN::Client in the SVN::Core, but
I cribbed some of the ideas.

The Minnesota Supercomputing Institute C<< http://www.msi.umn.edu/ >>
sponsored the development of this software.

=head1 COPYRIGHT

Copyright 2007 by the Regents of the University of Minnesota.
All rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=head1 SEE ALSO

Path::Class, Class::Accessor::Fast, SVN::Agent, IPC::Cmd
