File Coverage

blib/lib/PANT/Cvs.pm

Criterion	Covered	Total	%
statement	66	72	91.6
branch	11	20	55.0
condition			n/a
subroutine	12	12	100.0
pod	5	5	100.0
total	94	109	86.2

# PANT::Cvs - Provide support for CVS operations

package PANT::Cvs;

use 5.008;
use strict;
use warnings;
use Carp;
use Cwd;
use XML::Writer;
use Exporter;

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use PANT ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw() ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw( );

our $VERSION = '0.02';


sub new {
    my($clsname, $writer, @rest) =@_;
    my $self = {
	writer=>$writer,
	@rest,
    };
    bless $self, $clsname;
    return $self;
}

sub Run {
    my($self, $cmd, %args) = @_;
    my $writer = $self->{writer};
    my $cdir = ".";
    if ($args{directory}) {
	$cdir = getcwd;
	chdir($args{directory}) || Abort("Can't change to directory $args{directory}");

    }
    $writer->startTag('li');
    $writer->characters("Run $cmd\n");
    my $output;
    my $retval;
    if ($self->{dryrun}) {
	$output = "Output of the command $cmd would be here";
	$retval = 1;
    }
    else {
        $writer->startTag('pre');
	$cmd .= " 2>&1"; # collect stderr too
	$self->{lines} = [];
	if (open(PIPE, "$cmd |")) {
	    while(my $line = ) {
		$writer->characters($line);
		push(@ {$self->{lines} }, $line);
	    }
	    close(PIPE);
	    $retval = $? == 0;
	}
	else {
	    $retval = 0;
	}
        $writer->endTag('pre');
    }
    $writer->characters("$cmd failed: $!") if ($retval == 0);
    $writer->endTag('li');
    do { chdir($cdir) || Abort("Can't change back to $cdir: $!"); } if ($args{directory});
    return $retval;
}

sub HasUpdate {
    my $self = shift;
    foreach my $line (@{ $self->{lines} }) {
	if ($line =~ /^\s*[UP]\s+/) { # Its a change, one out, all out.
	    return 1;
	}
    }
    return 0;
}

sub HasLocalMod {
    my $self = shift;
    foreach my $line (@{ $self->{lines} }) {
	if ($line =~ /^\s*[MA]\s+/) { # Its a change, one out, all out.
	    return 1;
	}
    }
    return 0;
}
sub HasConflict {
    my $self = shift;
    foreach my $line (@{ $self->{lines} }) {
	if ($line =~ /^\s*[C]\s+/) { # Its a conflict
	    return 1;
	}
    }
    return 0;
}

1;
__END__