File Coverage

blib/lib/Toader/VCS.pm

Criterion	Covered	Total	%
statement	12	127	9.4
branch	0	40	0.0
condition	0	18	0.0
subroutine	4	9	44.4
pod	5	5	100.0
total	21	199	10.5

package Toader::VCS;

use warnings;
use strict;
use base 'Error::Helper';
use Config::Tiny;

=head1 NAME

Toader::VCS - Handles the VCS integration for Toader.

=head1 VERSION

Version 0.0.1

=cut

our $VERSION = '0.0.1';

=head1 METHODS

=head2 new

This intiates the object.

One argument is accepted and that is to Toader object
to use.

    my $tvcs=Toader::VCS->new($toader);
    if ( $tvcs->error ){
        warn('Error:'$tvcs->error.':'.$tvcs->errorFlag.': '.$tvcs->errorString);
    }

=cut

sub new{
	my $toader=$_[1];

	my $self={
			  error=>undef,
			  errorString=>'',
			  perror=>undef,
			  errorExtra=>{
				  flags=>{
					  1=>'noToader',
					  2=>'notToader',
					  3=>'getConfigFailed',
					  4=>'nothingToAdd',
					  5=>'doesNotExist',
					  6=>'notFileOrDir',
					  7=>'configNotUsable',
					  8=>'nonZeroExit',
					  9=>'getVCSfailed',
				  },
			  },
			  usable=>1,
			  };
	bless $self;

	#make sure a Toader object is specified
	if ( ! defined( $toader ) ){
		$self->{perror}=1;
		$self->{error}=1;
		$self->{errorString}='No toader object specified';
		$self->warn;
		return $self;
	}

	#make sure it is a Toader object
	if ( ref( $toader ) ne 'Toader' ){
		$self->{perror}=1;
		$self->{error}=2;
		$self->{errorString}='The passed object is "'.ref( $toader ).'" and not a Toader object';
		$self->warn;
		return $self;
	}

	#saves the Toader object
	$self->{toader}=$toader;

	#gets the config manually as Toader::Config depends on this module
	my $configFile=$self->{toader}->getRootDir.'/.toader/config.ini';
	if ( -f $configFile ){
		$self->{config}=Config::Tiny->read( $configFile );
		if ( ! defined( $self->{config} ) ){
			$self->{perror}=1;
			$self->{error}=3;
			$self->{errorString}='Config::Tiny failed to read "'.$configFile.'"';
			$self->warn;
			return $self;
		}
	}else{
		$self->{config}=Config::Tiny->new;
	}

	#checks if it is usable or not
	if (
		( !defined( $self->{config}->{_}->{vcs} ) ) ||
		( !$self->{config}->{_}{vcs} ) ||
		( !defined( $self->{config}->{VCS} ) ) ||
		( !defined( $self->{config}->{VCS}->{addExec} ) ) ||
		( !defined( $self->{config}->{VCS}->{deleteExec} ) ) ||
		( !defined( $self->{config}->{VCS}->{underVCSexec} ) )
		){
		$self->{usable}=0;
	}


	return $self;
}

=head2 add

This adds a file or directory.

One option is accepted and that what is to be added.

    $tvcs->add($someFile);
    if ( $tvcs->error ){
        warn('Error:'$tvcs->error.':'.$tvcs->errorFlag.': '.$tvcs->errorString);
    }

=cut

sub add{
	my $self=$_[0];
	my $toAdd=$_[1];

	if ( ! $self->errorblank ){
		return undef;
	}

	if ( ! $self->{usable} ){
		$self->{error}=7;
		$self->{errorString}='The VCS config is not usable';
		$self->warn;
		return undef;
	}

	if ( ! defined( $toAdd ) ){
		$self->{error}=4;
		$self->{errorString}='Nothing defined to add';
		$self->warn;
		return undef;
	}

	if ( ! -e $toAdd ){
		$self->{error}=5;
		$self->{errorString}='What is to be added does not exist';
		$self->warn;
		return undef;
	}

	if ( ( ! -f $toAdd ) || ( ! -d $toAdd ) ){
		$self->{error}=6;
		$self->{errorString}='What is to be added is not a file or directory';
		$self->warn;
		return undef;
	}

	my $toExec=$self->{config}->{VCS}->{addExec};
	$toExec=~s/\%\%\%item\%\%\%/$toAdd/g;
	system($toExec);
	my $exitCode=$?;
	if ( $exitCode != 0 ){
		$self->{error}=8;
		$self->{errorString}='Exit integer returned "'.$exitCode.'". instead of "0"';
		$self->warn;
		return undef;
	}

	return 1;
}

=head2 delete

This deletes a file or directory.

One option is accepted and that what is to be deleted.

    $tvcs->delete($someFile);
    if ( $tvcs->error ){
        warn('Error:'$tvcs->error.':'.$tvcs->errorFlag.': '.$tvcs->errorString);
    }

=cut

sub delete{
	my $self=$_[0];
	my $toDelete=$_[1];

	if ( ! $self->errorblank ){
		return undef;
	}

	if ( ! $self->{usable} ){
		$self->{error}=7;
		$self->{errorString}='The VCS config is not usable';
		$self->warn;
		return undef;
	}

	if ( ! defined( $toDelete ) ){
		$self->{error}=4;
		$self->{errorString}='Nothing defined to delete';
		$self->warn;
		return undef;
	}

	my $toExec=$self->{config}->{VCS}->{deleteExec};
	$toExec=~s/\%\%\%item\%\%\%/$toDelete/g;
	system($toExec);
	my $exitCode=$?;
	if ( $exitCode != 0 ){
		$self->{error}=8;
		$self->{errorString}='Exit integer returned "'.$exitCode.'". instead of "0"';
		$self->warn;
		return undef;
	}

	return 1;
}

=head2 underVCS

This checks if something is under VCS.

The returned value is a Perl boolean.

    my $underVCS=$tvcs->underVCS($someFile);
    if ( $tvcs->error ){
        warn('Error:'$tvcs->error.':'.$tvcs->errorFlag.': '.$tvcs->errorString);
    }

=cut

sub underVCS{
	my $self=$_[0];
	my $toCheck=$_[1];

	if ( ! $self->errorblank ){
		return undef;
	}

	if ( ! $self->{usable} ){
		$self->{error}=7;
		$self->{errorString}='The VCS config is not usable';
		$self->warn;
		return undef;
	}

	if ( ! defined( $toCheck ) ){
		$self->{error}=4;
		$self->{errorString}='Nothing defined to check';
		$self->warn;
		return undef;
	}

	my $toExec=$self->{config}->{VCS}->{underVCSexec};
	$toExec=~s/\%\%\%item\%\%\%/$toCheck/g;
	system($toExec);
	my $exitCode=$?;
	if ( $exitCode != 0 ){
		$self->{error}=8;
		$self->{errorString}='Exit integer returned "'.$exitCode.'". instead of "0"';
		$self->warn;
		return undef;
	}

	return 1;
}

=head2 usable

Checks if this object is usable or not.

    $tvcs->usable;

=cut

sub usable{
	my $self=$_[0];

	if ( $self->perror ){
		return undef;
	}

	return $self->{usable};
}

=head1 ERROR CODES/FLAGS/HANDLING

Error handling is provided by L.

=head2 1, noToader

No L object specified.

=head2 2, notToader

The object specified is not a L object.

=head2 3, getConfigFailed

Failed to read the .toader/config.ini .

=head2 4, nothingToAdd

Nothing specified to add.

=head2 5, doesNotExist

What is to be added does not exist

=head2 6, notFileOrDir

The specified item is not a file or directory.

=head2 7, configNotUsable

The configuration is not usable.

This most likely means either a config value is missing or it is disabled, such as in the example below.

    vcs=0
    [VCS]
    addExec=svn add --parents %%%item%%% > /dev/null
    deleteExec=svn del %%%item%%% > /dev/null
    underVCSexec=svn info %%%info%%% > /dev/null


=head2 8, nonZeroExit

One of the commands to execute returned a non-zero status.

=head2 9, getVCSfailed

Toader->getVCS errored.

=head1 AUTHOR

Zane C. Bowers-Hadley, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to C, or through
the web interface at L.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.




=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Toader::VCS


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L

=item * AnnoCPAN: Annotated CPAN documentation

L

=item * CPAN Ratings

L

=item * Search CPAN

L

=back


=head1 ACKNOWLEDGEMENTS


=head1 LICENSE AND COPYRIGHT

Copyright 2013 Zane C. Bowers-Hadley.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.


=cut

1; # End of Toader::VCS