File Coverage

lib/Dyer/CLI.pm

Criterion	Covered	Total	%
statement	15	80	18.7
branch	1	46	2.1
condition	0	17	0.0
subroutine	5	14	35.7
pod			n/a
total	21	157	13.3

package Dyer::CLI;
use strict;
use Carp;
use Cwd;
use Getopt::Std;
our $VERSION = sprintf "%d.%02d", q$Revision: 1.4 $ =~ /(\d+)/g;


$main::DEBUG=1;
$main::VERBOSE=1;

sub main::DEBUG {
	my $val = shift;
	if (defined $val){
		$main::DEBUG = $val;
	}
	return $main::DEBUG;
}

sub main::VERBOSE {
	my $val = shift;
	if (defined $val){
		$main::VERBOSE = $val;
	}
	return $main::VERBOSE;
}









sub main::force_root {
	my $whoami = `whoami`;
	chomp $whoami;
	$whoami eq 'root' or print "$0, only root can use this." and exit;
	return 1;
}

sub main::gopts {
	my $opts = shift;
	$opts||='';

	if($opts=~s/v\:?|h\:?//sg){
		print STDERR("$0, options changed") if ::DEBUG;
	}

	$opts.='vh';

	my $o = {};

	Getopt::Std::getopts($opts, $o);

	if($o->{v}){
		if (defined $::VERSION){
			print $::VERSION;
			exit;
		}
		print STDERR "$0 has no version\n";
		exit;
	}


	if($o->{h}){
		main::man()
	}

	return $o;
}

sub main::man {
	my $name = main::_scriptname();
   print `man $name` and exit;
}

sub main::_scriptname{
	my $name = $0 or return;
	$name=~s/^.+\///;
	return $name;
}

sub main::argv_aspaths {
	my @argv;
	scalar @ARGV or return;

	for(@ARGV){
		my $abs = Cwd::abs_path($_) or warn("$0, Does not resolve: $_, skipped.") and next;
		-e $abs or  warn("$0, Does not exist: $_, skipped.") and next;
		push @argv, $abs;
	}

	scalar @argv or return;

	return \@argv;
}

sub main::argv_aspaths_strict {
	my @argv;
	scalar @ARGV or return;

	for(@ARGV){
		my $abs = Cwd::abs_path($_) or warn("Does not resolve: $_.") and return;
		-e $abs or  warn("Is not on disk: $_.") and return;
		push @argv, $abs;
	}
	scalar @argv or return;
	return \@argv;
}

sub main::argv_aspaths_loose {
	my @argv;
	scalar @ARGV or return;

	for(@ARGV){
		my $abs = Cwd::abs_path($_) or warn("$0, Does not resolve: $_, skipped.") and next;
		push @argv, $abs;
	}
	scalar @argv or return;
	return \@argv;
}


sub main::yn {
        my $question = shift; $question ||='Your answer? ';
        my $val = undef;

        until (defined $val){
                print "$question (y/n): ";
                $val = ;
                chomp $val;
                if ($val eq 'y'){ $val = 1; }
                elsif ($val eq 'n'){ $val = 0;}
                else { $val = undef; }
        }
        return $val;
}





1;

__END__