File Coverage

lib/LEOCHARRE/CLI.pm

Criterion	Covered	Total	%
statement	75	149	50.3
branch	25	92	27.1
condition	3	31	9.6
subroutine	19	29	65.5
pod	3	3	100.0
total	125	304	41.1

package LEOCHARRE::CLI;
use strict;
use Carp;
use Cwd;
use vars qw($VERSION);
$VERSION = sprintf "%d.%02d", q$Revision: 1.19 $ =~ /(\d+)/g;

$main::DEBUG = 0;
$main::USAGE = 0;

sub main::DEBUG : lvalue {
   $main::DEBUG;
}

sub main::debug {
   $main::DEBUG or return 1;
   my $msg = shift;
   print STDERR " $0, $msg\n";
   return 1;
}











# BEGIN USER

sub main::whoami {
	unless (defined $::WHOAMI){
      require File::Which;
		if (my $wb = File::Which::which('whoami')){
			my $whoami = `$wb`;
			chomp $whoami;
			$::WHOAMI = $whoami;
		}
		else {
         warn("whoami bin path not found.");
			$::WHOAMI = 0;
			return;
		}
	}
	$::WHOAMI or return;

	return $::WHOAMI;
}

sub main::force_root {
	main::running_as_root() or print "$0, only root can use this." and exit;
	return 1;
}

sub main::running_as_root {
   my $whoami = main::whoami() or return 0;
   $whoami eq 'root' or return 0;
   return 1;
}

sub main::get_uid {
  my $name = shift;
  main::user_exists($name) or return;

  require Linux::usermod;
  my $user = Linux::usermod->new($name);
  my $id = $user->get('uid');
  $id=~/^\d+$/ or return;
  return $id;
}

sub main::user_exists {
   my $name = shift;
   require Linux::usermod;
   my %u = Linux::usermod->users;
   $u{$name} or return 0;
   return 1;
}

sub main::get_gid {
  my $name = shift;
  main::user_exists($name) or return;
  require Linux::usermod;
  my $g = Linux::usermod->new($name,1);
  my $id = $g->get('gid');
  $id=~/^\d+$/ or return;
  return $id;
}

# END USER






sub main::get_mode {
   my $abs = shift;
   require File::chmod;
   my $mod = File::chmod::getmod($abs) or return;
   return $mod;
}










# BEGIN GOPTS AND ARGS
sub main::gopts {
	my $opts = shift;
	$opts||='';

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

	$opts.='vhd';

	my $o = {};

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

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

	if ($o->{d}){
		$main::DEBUG = 1;
	}


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

	return $o;
}




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;
}

# END GOPTS AND ARGS



















# BEIGN HELP , USAGE, MAN ETC

sub main::man {

   if( defined $main::usage ){
      my $output = $main::usage;
      print STDERR "$output\n";
   }

   elsif( defined &main::usage ){
      my $output = main::usage();
      print STDERR "$output\n";
   }

   else {
   	my $name = main::_scriptname();
      print `man $name`;
   }

   exit;
}

# END HELP








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

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

sub main::config {
	my $abs_conf = shift;

   $abs_conf ||= main::suggest_abs_conf();

   $abs_conf
      or warn("Cannot determine abs_conf automatically and no arg passed")
      and return;

	-f $abs_conf
      or warn("$0, [$abs_conf] does not exist.")
      and return;

	require YAML;
	return (YAML::LoadFile($abs_conf));
}

sub main::suggest_abs_conf {
   $ENV{HOME} or warn("ENV HOME not set") and return;
   return ( $ENV{HOME}.'/'. main::_scriptname_only().'.conf');
}

sub main::suggest_abs_log {
   $ENV{HOME} or warn("ENV HOME not set") and return;
   return ( $ENV{HOME}.'/'. main::_scriptname_only().'.log');
}

sub main::mktmpdir {
   my $d = '/tmp/tmp_'.time().( int rand(2000000) );
   return undef and warn("$0, $d exists") if -d $d;
   mkdir $d or die("$0, cannot make $d, $!");
   return $d;
}






# BEGIN OPERATING SYSTEM AND WITCH

sub main::os_is_win {
   for(qw(dos os2 mswin32)){
      $^O=~/^$_/i or next;
      return 1;
   }
   return 0;
}

sub witch {
   my $bin = shift;
   require File::Which;
   my $binpath = File::Which::which($bin)
      or dye("Can't find $bin, is it installed?");
   return $binpath;
}



sub say { print STDERR (+shift)."\n" and return 1; }
sub dye { say("$0, ".(+shift)) and exit 1; }

*::witch = \&witch;
*::say   = \&say;
*::dye   = \&dye;

# END OPERATING SYSTEM AND WITCH






1;

__END__