File Coverage

blib/lib/VCS/Which/Plugin/CVS.pm

Criterion	Covered	Total	%
statement	39	88	44.3
branch	6	18	33.3
condition	0	12	0.0
subroutine	12	19	63.1
pod	6	6	100.0
total	63	143	44.0

package VCS::Which::Plugin::CVS;

# Created on: 2009-05-16 16:58:14
# Create by:  ivan
# $Id$
# $Revision$, $HeadURL$, $Date$
# $Revision$, $Source$, $Date$

use Moo;
use strict;
use warnings;
use version;
use Carp;
use Data::Dumper qw/Dumper/;
use English qw/ -no_match_vars /;
use Path::Tiny;
use File::chdir;
use Contextual::Return;

extends 'VCS::Which::Plugin';

our $VERSION = version->new('0.6.9');
our $name    = 'CVS';
our $exe     = 'cvs';
our $meta    = 'CVS';

sub installed {
    my ($self) = @_;

    return $self->_installed if defined $self->_installed;

    for my $path (split /[:;]/, $ENV{PATH}) {
        next if !-x "$path/$exe";

        return $self->_installed( 1 );
    }

    return $self->_installed( 0 );
}

sub used {
    my ( $self, $dir ) = @_;

    if (-f $dir) {
        $dir = path($dir)->parent;
    }

    croak "$dir is not a directory!" if !-d $dir;

    return -d "$dir/$meta";
}

sub uptodate {
    my ( $self, $dir ) = @_;

    $dir ||= $self->_base;

    croak "'$dir' is not a directory!" if !-e $dir;

    chdir $dir;

    return !grep {!/Up-to-date/} grep { /Status:/ } `$exe status 2>/dev/null`;
}

sub pull {
    my ( $self, $dir ) = @_;

    $dir ||= $self->_base;

    croak "'$dir' is not a directory!" if !-e $dir;

    local $CWD = $dir;
    return !system "$exe update > /dev/null 2> /dev/null";
}

sub cat {
    my ($self, $file, $revision) = @_;

    if ( $revision && $revision =~ /^-\d+$/xms ) {
        my @versions = reverse `$exe log -q $file` =~ /^ revision \s+ (\d+[.]\d+)/gxms;
        $revision = $versions[$revision];
    }
    elsif ( !defined $revision ) {
        $revision = '';
    }

    $revision &&= "-r $revision";

    return `$exe update -p $revision $file`;
}

sub log {
    my ($self, $file, @args) = @_;

    my $args = join ' ', @args;
    my $dir  = -d $file ? path($file) : path($file)->parent;

    local $CWD = $dir;
    return
        SCALAR   { scalar `$exe log $args` }
        ARRAYREF {
            my $logs = `$exe $args log 2> /dev/null`;
            my @logs;
            for my $file ( split /^={77}$/xms, $logs ) {
                my ($details, @log) = split /^-{28}$/xms, $file;
                push @logs, @log;
            }

            return \@logs;
        }
        HASHREF  {
            my $logs = `$exe $args log 2> /dev/null`;
            my %log_by_date;
            for my $file ( split /^={77}$/xms, $logs ) {
                my ($details, @log) = split /^-{28}$/xms, $file;
                for my $log (@log) {
                    my (undef, $rev_line, $data_line, $description) = split /\r?\n/xms, $log, 4;

                    chomp $description;
                    my ($rev) = $rev_line =~ /^revision \s+ ([\d.]+)$/xms;
                    my ($date, $author) = $data_line =~ /^date: \s* ([^;]+); \s* author: \s* ([^;]+)/xms;

                    push @{ $log_by_date{$date} }, {
                        rev         => $rev,
                        description => $description,
                        Date        => $date,
                        Author      => $author,
                    };
                }
            }

            my %log;
            my $i = 1;
            for my $date ( sort keys %log_by_date ) {
                $log{$i++} = $log_by_date{$date}[0];
            }
            return \%log;
        }
}

1;

__END__