File Coverage

blib/lib/VCS/Lite/Store.pm

Criterion	Covered	Total	%
statement	44	54	81.4
branch	13	22	59.0
condition	2	3	66.6
subroutine	9	10	90.0
pod	5	5	100.0
total	73	94	77.6

package VCS::Lite::Store;

use strict;
use warnings;

our $VERSION = '0.11';

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

use Carp;
use File::Spec::Functions qw(:ALL);
use Time::Piece;

our $hidden_repos_dir = '.VCSLite';
$hidden_repos_dir = '_VCSLITE' if $^O =~ /vms/i;

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

sub new {
    my ($pkg, %par) = @_;
    bless \%par,$pkg;
}

sub retrieve {
    my ($self, $path) = @_;

    my $store_file = $self->store_path($path);
    return unless -e $store_file;
    my $obj = $self->load($store_file) or die "Failed to retrieve $path";
    $obj->{store} = $self;
    $obj;
}

sub retrieve_or_create {
    my ($self, $proto) = @_;

    my $path = $proto->path;

    $self->retrieve($path) || $self->create($proto);
}

sub create {
    my ($self, $proto) = @_;

    my $path = $proto->path;

    my ($store_dir, $store_file) = $self->store_path($path);

    if (!-d $store_dir) {
        mkdir $store_dir or croak "Failed to make repository dir $store_dir";
    }

    my $creator = $self->can('user') ? $self->user : $proto->user or croak "Username not specified";

    @{$proto}{qw/store creator created/} = ($self,$creator,localtime->datetime);
    my $class = ref $proto;
    $proto->_mumble("Creating $class $path");
    $proto->save($store_file);
    $proto;
}

sub store_path {
    my ($self,$path,$ext) = @_;

    my ($vol,$dir,$fil) = splitpath(rel2abs($path));
    if ($fil && -d $path) {      # Because of the way splitpath works on Unix
        $dir = catdir($dir,$fil);
        $fil = '';
    }

    if (ref $self) {
        my ($hvol,$hdir) = splitpath($self->{home});
        croak "Wrong volume in attempt to access store for $path"
            if $hvol ne $vol;
        my @dir = splitdir($dir);
        for (splitdir($hdir)) {
            my $dd = shift @dir;
            croak "Outside directory tree: $path" if $dd ne $_;
        }
        ($vol,my $rdir) = splitpath($self->{root});
        $dir = catdir($rdir,@dir);
    } else {
        $dir = catdir($dir,$hidden_repos_dir);
    }

    ($dir, catpath($vol, $dir, $self->repos_name($fil,$ext)));
}

1;

__END__