File Coverage

blib/lib/VCS/Lite/Shell.pm

Criterion	Covered	Total	%
statement	46	61	75.4
branch	11	24	45.8
condition	2	8	25.0
subroutine	13	19	68.4
pod	12	12	100.0
total	84	124	67.7

package VCS::Lite::Shell;

use strict;
use warnings;

our $VERSION = '0.11';

#----------------------------------------------------------------------------

use vars qw (@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

use Exporter ();
@ISA         = qw (Exporter);
#Give a hoot don't pollute, do not export more than needed by default
@EXPORT      = qw ();
@EXPORT_OK   = qw (store add remove list check_in check_out commit update fetch diff);
%EXPORT_TAGS = (
    local   => [qw/store add remove check_in fetch diff/],
    all     => [qw/store add remove list check_in fetch diff check_out commit update/]
);

use Params::Validate qw(:all);
use VCS::Lite::Repository;
use Cwd;

our %store_list;

#----------------------------------------------------------------------------

sub store {
    my ($which, $type, @att) = @_;

    $which ||= 'current';
    $type = 'VCS::Lite::Store::'.$type unless $type =~ /\:\:/;
    if ($type =~ /^\w+(:?\:\:\w+)*$/) {
        eval "require $type";
        carp $@ if $@;
    }

    $store_list{$which} = @att ? $type->new(@att) : $type;
}

sub repository {
    my ($store,$dir) = validate_pos( @_,
        { type => SCALAR | OBJECT},
        { type => SCALAR, default => '.'} );

    store($store, VCS::Lite::Repository->default_store)
        unless exists $store_list{$store};
    VCS::Lite::Repository->new( $dir, store=>$store_list{$store} );
}

sub member {
    my ($st,$mem) = validate_pos( @_,
        { type => SCALAR | OBJECT},
        { type => SCALAR, default => '.'} );

    store($st, VCS::Lite::Repository->default_store)
        unless exists $store_list{$st};
    $store_list{$st}->retrieve($mem);
}

sub add {
    my $ele = shift;

    repository('current')->add($ele);
}

sub remove {
    my $ele = shift;

    repository('current')->remove($ele);
}

sub list {
    my %par = validate(@_, {
        recurse => 0} );

    repository('current')->traverse( 'name', %par);
}

sub fetch {
    my ($ele, $gen) = validate_pos( @_, {type => SCALAR}, 0);

    my $mem = member('current',$ele);
    my %par = ();
    $par{generation} = $gen if defined $gen && $gen ne 'latest';
    $mem->fetch(%par)->text;
}

sub diff {
    my %par = validate( @_,
        {
            file1 => { type => SCALAR },
            gen1 => {
                type => SCALAR,
                optional => 1,
                regex => qr/^\d+$/
            },
            file2 => {
                type => SCALAR,
                optional => 1,
            },
            gen2 => {
                type => SCALAR,
                optional => 1,
                regex => qr/^\d+$|^latest$/
            },
        } );

    my $lite1 = member('current',$par{file1})
        ->fetch(exists($par{gen1}) ? (generation => $par{gen1}) : ());
    my $lite2;
    $par{file2} ||= $par{file1};
    if (exists $par{gen2}) {
        $lite2 = member('current',$par{file2})
          ->fetch(($par{gen1} eq 'latest') ? () : (generation => $par{gen2}));
    } else {
        $lite2 = VCS::Lite->new($par{file2});
    }

    my $d = $lite1->delta($lite2) or return '';
    $d->udiff;
}

sub check_out {
    my $parent_path = shift;

    store('current', VCS::Lite::Repository->default_store)
        unless exists $store_list{current};

    repository('parent',$parent_path)
        ->check_out( cwd(), store => $store_list{current} );
}

sub check_in {
    my ($what,$descr) = @_;

    member('current',$what)->check_in( description => $descr);
}

sub commit {
    repository('current')->commit();
}

sub update {
    repository('current')->update();
}

1; #this line is important and will help the module return a true value

__END__