File Coverage

blib/lib/VCS/Which.pm

Criterion	Covered	Total	%
statement	163	167	97.6
branch	85	88	96.5
condition	13	15	86.6
subroutine	23	23	100.0
pod	15	15	100.0
total	299	308	97.0

package VCS::Which;

# Created on: 2009-05-16 16:54:35
# 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;

our $VERSION = version->new('0.6.9');

our %systems;

has [qw/dir systems/] => (
    is => 'rw',
);
has [qw/_which _uptodate/] => (
    is      => 'rw',
    default => sub {{}},
);

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

    if ( !%systems ) {
        $self->get_systems();
    }

    $self->load_systems();

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

    return $self;
}

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

    for my $module (keys %systems) {
        $self->{systems}{$module} = $module->new;
    }

    return;
}

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

    for my $dir (@INC) {
        if ( $dir !~ /^\/|^\w:\// ) {
            $dir = "./$dir";
        }
        my @files = glob "$dir/VCS/Which/Plugin/*.pm";

        for my $file (@files) {
            my $module = $file;
            $module =~ s{\Q$dir\E/}{}xms;
            $module =~ s{/}{::}gxms;
            $module =~ s{[.]pm$}{}xms;

            next if $systems{$module};

            eval {
                require $file;
            } or do {
                confess $@, "Error with $file / $module";
            };
            $systems{$module} = 1;
        }
    }

    return;
}

sub capabilities {
    my ($self, $dir) = @_;
    my $out;
    my %out;

    if ($dir) {
        $self->dir($dir);
    }
    else {
        $dir = $self->dir;
    }

    for my $system (values %{ $self->{systems} }) {

        $out .= $system->name . ' ' x (10 - length $system->name);
        $out .= $system->installed  ? ' installed    ' : ' not installed';
        $out{$system->name}{installed} = $system->installed;

        if ($dir) {
            eval {
                $out .= $system->used($dir) ? ' versioning' : ' not versioning';
                $out{$system->name}{installed} = $system->used($dir);
            };
            if ($EVAL_ERROR) {
                warn "$system error in determining if the directory is used: $EVAL_ERROR\n";
                $out .= ' NA';
                $out{$system->name}{installed} = ' NA';
            }
        }

        $out .= "\n";
    }

    return wantarray ? %out : $out;
}

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

    if ($dir) {
        $self->dir($dir);
    }
    else {
        $dir = $self->dir;
    }

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

    confess "No directory supplied!" if !$dir;

    return $self->_which->{$dir} if exists $self->_which->{$dir};

    $self->_which->{$dir} = undef;
    my %used;
    my $min;

    for my $system (values %{ $self->{systems} }) {
        my $used = eval { $system->used($dir) || 0 };
        next if $EVAL_ERROR;

        if ( $used && ! defined $min ) {
            $min = $used;
        }

        # check that the directory is used and that it was found at a level closer to $dir that the last found system
        if ( $used && $used <= $min ) {
            $self->_which->{$dir} = $system;
            $min = $used;
        }
    }

    confess "Could not work out what plugin to use with '$dir'\n" if !$self->_which->{$dir};

    return $self->_which->{$dir};
}

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

    if ($dir) {
        $self->dir($dir);
    }
    else {
        $dir = $self->dir;
    }

    confess "No directory supplied!" if !$dir;

    return $self->_uptodate->{$dir} if exists $self->_uptodate->{$dir};

    my $system = $self->which;

    return $self->_uptodate->{$dir} = $system->uptodate($dir);
}

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

    confess "Nothing to exec!" if !@args;

    if (-e $args[0]) {
        $dir = $self->dir( shift @args );
    }
    else {
        $dir = $self->dir;
    }

    confess "No directory supplied!" if !$dir;

    my $system = $self->which;

    return $system->exec($dir, @args);
}

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

    if ( $file && ! -e $file ) {
        unshift @args, $file;
        undef $file;
    }

    my $dir
        = !defined $file ? $self->dir
        : -f $file       ? path($file)->parent
        :                  $file;

    confess "No directory supplied!" if !$dir;

    my $system = $self->which($dir);

    return $system->log($file, @args);
}

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

    if ($file) {
        $self->dir($file);
    }
    else {
        $file = $self->dir;
    }

    confess "No file supplied!" if !$file;

    my $system = $self->which;

    return $system->cat($file, @args);
}

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

    if ($file) {
        $self->dir($file);
    }
    else {
        $file = $self->dir;
    }

    confess "No file supplied!" if !$file;

    my $system = $self->which;

    return $system->versions($file, @args);
}

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

    if ($dir) {
        $self->dir($dir);
    }
    else {
        $dir = $self->dir;
    }

    confess "No directory supplied!" if !$dir;

    my $system = $self->which;

    return $system->pull($dir);
}

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

    if ($dir) {
        $self->dir($dir);
    }
    else {
        $dir = $self->dir;
    }

    confess "No directory supplied!" if !$dir;

    my $system = $self->which;

    return $system->push($dir);
}

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

    if ($dir) {
        $self->dir($dir);
    }
    else {
        $dir = $self->dir;
    }

    confess "No directory supplied!" if !$dir;

    my $system = $self->which;

    return $system->status($dir);
}

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

    if ($dir) {
        $self->dir($dir);
    }
    else {
        $dir = $self->dir;
    }

    confess "No directory supplied!" if !$dir;

    my $system = $self->which;

    return $system->checkout($dir, @extra);
}

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

    if ($dir) {
        $self->dir($dir);
    }
    else {
        $dir = $self->dir;
    }

    confess "No directory supplied!" if !$dir;

    my $system = $self->which;

    return $system->add($dir, @extra);
}

1;

__END__